delphi - Performance issues re-sizing large amount of components on form resize -

i feel failure far lies in search terms information on has pretty common. looking common solutions , best practices when performing resizes on several components while form resized.

i have form component based upon tscrollbox. scrollbox contains rows added dynamically @ run time. subcomponent. each 1 has image on left , memo on right. height set based upon width , aspect ratio of image. upon resize of scroll box loop sets width of rows triggering rows own internal resize. loop sets relative top position if heights have changed.

screen shot:

around 16 rows performs fine. goal closer 32 rows choppy , can peg core @ 100% usage.

i have tried:

• added check prevent new resize starting while previous has yet complete. answered if occured , sometimes.
• i tried preventing resizing more every 30 ms allow 30 frame per second drawing. mixed results.
• changed rows base component tpanel twincontrol. not sure if there performance penalty using panel old habit.
• with , without double buffering.

i allow row resizing occur during resize preview how large image in row. eliminates 1 obvious solution in applications acceptable loss.

right resize code internally row dynamic , based upon dimensions of each image. next thing plan try specify aspect ratio, max width/height based on largest image in collection. should reduce amount of math per row. seems issues more resize event , loop itself?

full unit code components:

unit rpbssview;  interface  uses   classes, controls, forms, extctrls, stdctrls, graphics, sysutils, rpbssrow, windows, messages;  type   tpbssview = class(tscrollbox)   private       public     constructor create(aowner: tcomponent); override;     destructor destroy; override;     procedure resizerows(sender: tobject);     procedure addrow(filename: string);     procedure fillrow(row: integer; imagestream: tmemorystream);   end;  var   pbssrow: array of tpbssrow;   resizingn: boolean;  procedure register;  implementation  procedure register; begin   registercomponents('standard', [tscrollbox]); end;  procedure tpbssview.addrow(filename: string); begin   setlength(pbssrow,(length(pbssrow) + 1));   pbssrow[length(pbssrow)-1] := tpbssrow.create(self);   pbssrow[length(pbssrow)-1]   begin     left := 2;     if (length(pbssrow)-1) = 0 top := 2 else top := ((pbssrow[length(pbssrow) - 2].top + pbssrow[length(pbssrow) - 2].height) + 2);     width := (inherited clientwidth - 4);     visible := true;     parent := self;     panelleft.caption := filename;   end; end;  procedure tpbssview.fillrow(row: integer; imagestream: tmemorystream); begin   pbssrow[row].loadimagefromstream(imagestream); end;  procedure tpbssview.resizerows(sender: tobject); var   i, x: integer; begin   if resizingn exit   else   begin       resizingn := true;       horzscrollbar.visible := false;       x := (inherited clientwidth - 4);       if length(pbssrow) > 0       := 0 length(pbssrow) - 1       begin         pbssrow[i].width := x; //set width         if not (i = 0)      //move next ones down.           begin             pbssrow[i].top := (pbssrow[(i - 1)].top + pbssrow[(i - 1)].height) + 2;           end;         application.processmessages;       end;     horzscrollbar.visible := true;     resizingn := false;   end; end;  constructor tpbssview.create(aowner: tcomponent); begin   inherited create(aowner);   onresize := resizerows;   doublebuffered := true;   vertscrollbar.tracking := true;   resizingn := false; end;  destructor tpbssview.destroy; begin   inherited; end;  end. 

row code:

unit rpbssrow;  interface  uses   classes, controls, forms, extctrls, stdctrls, graphics, pngimage, sysutils;  type   tpbssrow = class(twincontrol)   private     fimage: timage;     fpanel: tpanel;     fmemo: tmemo;     fpanelleft: tpanel;     fpanelright: tpanel;     fimagewidth: integer;     fimageheight: integer;   public     constructor create(aowner: tcomponent); override;     destructor destroy; override;     procedure mypanelresize(sender: tobject);     procedure leftpanelresize(sender: tobject);   published     procedure loadimagefromstream(imagestream: tmemorystream);     property image: timage read fimage;     property panel: tpanel read fpanel;     property panelleft: tpanel read fpanelleft;     property panelright: tpanel read fpanelright;   end;  procedure register;      implementation  procedure register; begin   registercomponents('standard', [twincontrol]); end;  procedure tpbssrow.mypanelresize(sender: tobject); begin   if (width - 466) <= fimagewidth fpanelleft.width := (width - 466) else fpanelleft.width := fimagewidth;   fpanelright.width := (width - fpanelleft.width); end;  procedure tpbssrow.leftpanelresize(sender: tobject); var   aspectratio: extended; begin   fpanelright.left := (fpanelleft.width);   //enforce info minimum height or set height   if fimageheight > 0  aspectratio := (fimageheight/fimagewidth) else   aspectratio := 0.4;   if (round(aspectratio * fpanelleft.width)) >= 212   begin     height := (round(aspectratio * fpanelleft.width));     fpanelleft.height := height;     fpanelright.height := height;   end   else   begin     height :=212;     fpanelleft.height := height;     fpanelright.height := height;   end;   if fimage.height >= fimageheight fimage.stretch := false else fimage.stretch := true;   if fimage.width >= fimagewidth fimage.stretch := false else fimage.stretch := true; end;  procedure tpbssrow.loadimagefromstream(imagestream: tmemorystream); var   p: tpngimage;   n: integer; begin   p := tpngimage.create;   imagestream.position := 0;   p.loadfromstream(imagestream);   fimage.picture.assign(p);   fimagewidth := p.width;   fimageheight := p.height; end;  constructor tpbssrow.create(aowner: tcomponent); begin   inherited create(aowner);     bevelinner := bvnone;     bevelouter := bvnone;     bevelkind :=  bknone;     color := clwhite;     onresize := mypanelresize;     doublebuffered := true;   //left panel image   fpanelleft := tpanel.create(self);   fpanelleft   begin     setsubcomponent(true);     align := alleft;     parent := self;     //setbounds(0,0,100,100);     parentbackground := false;     color := clblack;     font.color := clltgray;     constraints.minwidth := 300;     bevelinner := bvnone;     bevelouter := bvnone;     bevelkind :=  bknone;     borderstyle := bsnone;     onresize := leftpanelresize;   end;   //image left panel   fimage := timage.create(self);   fimage.setsubcomponent(true);   fimage.align := alclient;   fimage.parent := fpanelleft;   fimage.center := true;   fimage.stretch := true;   fimage.proportional := true;   //right panel info   fpanelright := tpanel.create(self);   fpanelright   begin     setsubcomponent(true);     parent := self;     padding.setbounds(2,5,5,2);     bevelinner := bvnone;     bevelouter := bvnone;     bevelkind :=  bknone;     borderstyle := bsnone;     color := clltgray;   end;    //create memo in right panels   fmemo := tmemo.create(self);   fmemo   begin     setsubcomponent(true);     parent := fpanelright;     align := alclient;     bevelouter := bvnone;     bevelinner := bvnone;     borderstyle := bsnone;     color := clltgray;   end;  end;  destructor tpbssrow.destroy; begin   inherited; end;  end. 

a few tips:

• twincontrol ís container, not need panel inside add controls
• you not need timage component view graphic, can tpaintbox, or in example control below, tcustomcontrol,
• since of other panels not recognizable (borders , bevels disabled), loose them altogether , place tmemo directly on row control,
• setsubcomponent design time usage. not need it. nor register procedures matter.
• put global rows array inside class definition, otherwise multiple tpbssview controls use same array!
• twincontrol tracks child controls, won't need array anyway, see example below,
• make use of align property save realigning manually,
• if memo control showing text, remove , paint text yourself.

try 1 starters:

unit pbssview;  interface  uses   windows, messages, classes, controls, sysutils, graphics, extctrls, stdctrls,   forms, pngimage;  type   tpbssrow = class(tcustomcontrol)   private     fgraphic: tpngimage;     fstrings: tstringlist;     function imageheight: integer; overload;     function imageheight(controlwidth: integer): integer; overload;     function imagewidth: integer; overload;     function imagewidth(controlwidth: integer): integer; overload;     procedure wmerasebkgnd(var message: twmerasebkgnd); message wm_erasebkgnd;     procedure wmwindowposchanging(var message: twmwindowposchanging);       message wm_windowposchanging;   protected     procedure paint; override;     procedure requestalign; override;   public     constructor create(aowner: tcomponent); override;     destructor destroy; override;     procedure loadimagefromstream(stream: tmemorystream);     property strings: tstringlist read fstrings;   end;    tpbssview = class(tscrollbox)   private     function getrow(index: integer): tpbssrow;     procedure wmentersizemove(var message: tmessage); message wm_entersizemove;     procedure wmerasebkgnd(var message: twmerasebkgnd); message wm_erasebkgnd;     procedure wmexitsizemove(var message: tmessage); message wm_exitsizemove;   protected     procedure paintwindow(dc: hdc); override;   public     constructor create(aowner: tcomponent); override;     procedure addrow(const filename: tfilename);     procedure fillrow(index: integer; imagestream: tmemorystream);     property rows[index: integer]: tpbssrow read getrow;   end;  implementation  { tpbssrow }  constructor tpbssrow.create(aowner: tcomponent); begin   inherited create(aowner);   width := 300;   height := 50;   fstrings := tstringlist.create; end;  destructor tpbssrow.destroy; begin   fstrings.free;   fgraphic.free;   inherited destroy; end;  function tpbssrow.imageheight: integer; begin   result := imageheight(width); end;  function tpbssrow.imageheight(controlwidth: integer): integer; begin   if (fgraphic <> nil) , not fgraphic.empty     result := round(imagewidth(controlwidth) * fgraphic.height / fgraphic.width)   else     result := height; end;  function tpbssrow.imagewidth: integer; begin   result := imagewidth(width); end;  function tpbssrow.imagewidth(controlwidth: integer): integer; begin   result := controlwidth div 2; end;  procedure tpbssrow.loadimagefromstream(stream: tmemorystream); begin   fgraphic.free;   fgraphic := tpngimage.create;   stream.position := 0;   fgraphic.loadfromstream(stream);   height := imageheight + padding.bottom; end;  procedure tpbssrow.paint; var   r: trect; begin   canvas.stretchdraw(rect(0, 0, imagewidth, imageheight), fgraphic);   setrect(r, imagewidth, 0, width, imageheight);   canvas.fillrect(r);   inc(r.left, 10);   drawtext(canvas.handle, fstrings.text, -1, r, dt_editcontrol or     dt_end_ellipsis or dt_nofullwidthcharbreak or dt_noprefix or dt_wordbreak);   canvas.fillrect(rect(0, imageheight, width, height)); end;  procedure tpbssrow.requestalign; begin   {eat inherited} end;  procedure tpbssrow.wmerasebkgnd(var message: twmerasebkgnd); begin   message.result := 1; end;  procedure tpbssrow.wmwindowposchanging(var message: twmwindowposchanging); begin   inherited;   if (fgraphic <> nil) , not fgraphic.empty     message.windowpos.cy := imageheight(message.windowpos.cx) + padding.bottom; end;  { tpbssview }  procedure tpbssview.addrow(const filename: tfilename); var   row: tpbssrow; begin   row := tpbssrow.create(self);   row.align := altop;   row.padding.bottom := 2;   row.parent := self; end;  constructor tpbssview.create(aowner: tcomponent); begin   inherited create(aowner);   vertscrollbar.tracking := true; end;  procedure tpbssview.fillrow(index: integer; imagestream: tmemorystream); begin   rows[index].loadimagefromstream(imagestream); end;  function tpbssview.getrow(index: integer): tpbssrow; begin   result := tpbssrow(controls[index]); end;  procedure tpbssview.paintwindow(dc: hdc); begin   {eat inherited} end;  procedure tpbssview.wmentersizemove(var message: tmessage); begin   if not aligndisabled     disablealign;   inherited; end;  procedure tpbssview.wmerasebkgnd(var message: twmerasebkgnd); var   dc: hdc; begin   dc := getdc(handle);   try     fillrect(dc, rect(0, vertscrollbar.range, width, height), brush.handle);       releasedc(handle, dc);   end;   message.result := 1; end;  procedure tpbssview.wmexitsizemove(var message: tmessage); begin   inherited;   if aligndisabled     enablealign; end;  end. 

if still performs badly, there multiple other enhancements possible.

update:

• flickering eliminated overriding/intercepting wm_erasebkgnd (and intercepting paintwindow versions < xe2),
• better performance making use of disablealign , enablealign.