listbox - Creating my own ListControl, some problems in Delphi -

some time ago have decided create own listcontrol. mean under listcontrol - control similar standard tlistbox in delphi. know, 'reinventing wheel', want finish control. so, implemented not features in control tlistbox has, control allows:

1. add items;
2. select item;
3. navigate through items via keyboard (arrow keys down).

i plan implement scrollbar, topic.

but have problem: when summary height of items more control's height , last item selected , try increase control's height got 'blank space', want 'scroll' items down fill blank space.

at picture above can see control has lack of items draw them onto 'blank space'.

may explain problem not clear, next:

1. put standard tlistbox on form , set height equal 100 px;

2. put standard trackbar on form, set max value 100 , in event onchange write this:

   listbox1.height := listbox1.height + trackbar1.position; 

3. add 12 items @ listbox;

4. compile project , select last item in listbox, begin change height via trackbar. see, 'invisible top items' come top down 1 one.

that effect want add in control, have no idea why.

control's code

unit alistbox;  interface  uses   windows,   messages,   sysutils,   classes,   graphics,   controls,   forms,   stdctrls,   extctrls,   strutils,   dialogs,   math;  type   { main class }   talistbox       = class;     {>>>>>>>>>>>>>>>>>>>>>>>>>}   talistbox = class(tcustomcontrol)   private     { private declarations }   protected     { protected declarations }     fitembmp: tbitmap;      fenabled: boolean;     fselected: boolean;      fitems: tstringlist;     fitemheight: integer;     fcurrentitemindex: integer;     fmode: integer;     fglobaly: integer;     fscrolloffset: integer;     fdownscroll: integer;      procedure setitems(value: tstringlist);      procedure wmsize(var message: twmsize); message wm_size;     procedure wmgetdlgcode(var message: twmgetdlgcode); message wm_getdlgcode;      procedure mousedown(button: tmousebutton; shift: tshiftstate; x, y: integer); override;     procedure keydown(var key: word; shift: tshiftstate); override;      function getitemindex: integer;     function getvisibleitemscount: integer;     function getscrollitemindex: integer;      procedure paintitemstandard(bmpinout: tbitmap; amode, aindex: integer);     procedure paintcontrolstandard(acanvas: tcanvas; amode: integer);      procedure paint; override;    public     { public declarations }     constructor create(aowner: tcomponent); override;     destructor destroy; override;      procedure click; override;      property itemindex    : integer read fcurrentitemindex;    published     { published declarations }     property items     : tstringlist read fitems write fitems;      property onclick;   end;   {<<<<<<<<<<<<<<<<<<<<<<<<<}   implementation   { talistbox }   procedure register; begin   registercomponents('mycontrol', [talistbox]); end;  constructor talistbox.create(aowner: tcomponent); begin   inherited create(aowner);    { standard declarations }   controlstyle := controlstyle + [csopaque, cscapturemouse, csdoubleclicks];   width := 100;   height := 120;    doublebuffered := true;    { control's declarations }   fitembmp := tbitmap.create;    fenabled := true;   fselected := false;    fitems := tstringlist.create;    fitemheight := 20;   fcurrentitemindex := -1;   fscrolloffset := 0;   fdownscroll := 0;    fmode := 1; end;  destructor talistbox.destroy; begin   freeandnil(fitembmp);   freeandnil(fitems);    inherited destroy; end;  procedure talistbox.click; begin   if fenabled     inherited click   else     exit; end;  procedure talistbox.setitems(value: tstringlist); begin   invalidate; end;  procedure talistbox.wmsize(var message: twmsize); var   lscrollindex, lvisiblecount: integer; begin   inherited;   lscrollindex := fscrolloffset div fitemheight;   lvisiblecount := getvisibleitemscount;   if (fitems.count - lscrollindex) < lvisiblecount     fscrolloffset := fitemheight * max(0, fitems.count - getvisibleitemscount); end;  procedure talistbox.wmgetdlgcode(var message: twmgetdlgcode); begin   inherited;   message.result := dlgc_wantarrows; end;  procedure talistbox.mousedown(button: tmousebutton; shift: tshiftstate; x, y: integer); begin   if button = mbleft     begin       windows.setfocus(handle);        if ptinrect(rect(1, 1, width - 1, height - 1), point(x, y))         fglobaly := y - 2;        if getitemindex > fitems.count - 1         exit       else         begin           fselected := true;           fcurrentitemindex := getitemindex;            // prevent selecting next item if height low           if height >= fitemheight             if ptinrect(rect(1, height - fdownscroll - 1, width - 1, height - 1), point(x, y))               fscrolloffset := fscrolloffset + fitemheight;            invalidate;         end;     end;    inherited mousedown(button, shift, x, y); end;  procedure talistbox.keydown(var key: word; shift: tshiftstate); var   scrollindex: integer; begin   inherited keydown(key, shift);    if fenabled     begin       case key of         vk_up:           begin             if fcurrentitemindex = 0               exit             else               begin                 if (fcurrentitemindex + 1) > 0                   begin                     dec(fcurrentitemindex);                     scrollindex := fscrolloffset div fitemheight;                     if fcurrentitemindex < scrollindex                       fscrolloffset := fscrolloffset - fitemheight;                   end;               end;           end;         vk_down:           begin             if fcurrentitemindex = fitems.count - 1               exit             else               begin                 if (fcurrentitemindex + 1) < fitems.count                   begin                     inc(fcurrentitemindex);                     scrollindex := fscrolloffset div fitemheight;                     if (fcurrentitemindex - getvisibleitemscount + 1) > scrollindex                       fscrolloffset := fscrolloffset + fitemheight;                   end;               end;           end;       end;        invalidate;     end   else     exit; end;  function talistbox.getitemindex: integer; begin   result := (fglobaly + fscrolloffset) div fitemheight; end;  function talistbox.getvisibleitemscount: integer; begin   result := height div fitemheight; end;  function talistbox.getscrollitemindex: integer; begin   result := fscrolloffset div fitemheight; end;  procedure talistbox.paintitemstandard(bmpinout: tbitmap; amode, aindex: integer); var   text: string;   r: trect; begin   bmpinout.width := width - 2;   bmpinout.height := fitemheight;    case amode of     1:       begin         if fselected         begin           bmpinout.canvas.brush.color := clwebcrimson;           bmpinout.canvas.font.color := clwhite;         end         else         begin           bmpinout.canvas.brush.color := clwhite;           bmpinout.canvas.font.color := clblack;         end;         bmpinout.canvas.pen.color := clgray;       end;     4:       begin         bmpinout.canvas.brush.color := clsilver;         bmpinout.canvas.pen.color := clgray;         bmpinout.canvas.font.color := clblack;       end;   end;   bmpinout.canvas.fillrect(bmpinout.canvas.cliprect);    // paint item's text   if aindex = - 1     exit   else     bmpinout.canvas.textout(18, 2, fitems.strings[aindex]); end;  procedure talistbox.paintcontrolstandard(acanvas: tcanvas; amode: integer); var   i: integer;   oldselected: boolean;   tempbmp: tbitmap; begin   case amode of     1:       begin         acanvas.brush.color := clwhite;         acanvas.pen.color := clblack;       end;     4:       begin         acanvas.brush.color := clsilver;         acanvas.pen.color := clblack;       end;   end;   acanvas.rectangle(rect(0, 0, width, height));    // calculate downbutton size   fdownscroll := height - getvisibleitemscount * fitemheight - 1 {top border pixel} - 1 {bottom border pixel};    // create output bitmap   tempbmp := tbitmap.create;   tempbmp.width := width - 2;   tempbmp.height := height - 2;    // turn off selected flag   oldselected := fselected;   fselected := false;    i:=0 fitems.count - 1     begin       paintitemstandard(fitembmp, fmode, i);       tempbmp.canvas.draw(0, 0 + (fitemheight * i) - fscrolloffset, fitembmp);     end;    // output result   acanvas.draw(1, 1, tempbmp);    // restore selected flag   fselected := oldselected;   if fselected     begin       // paint selected item       paintitemstandard(fitembmp, fmode, fcurrentitemindex);       acanvas.draw(1, 1 + (fitemheight * fcurrentitemindex) - fscrolloffset, fitembmp);     end;    // free resources   freeandnil(tempbmp); end;  procedure talistbox.paint; begin   if fenabled     paintcontrolstandard(canvas, 1)   else     paintcontrolstandard(canvas, 4); end;   end. 

i hope can find here. thank attention!

p.s.
in source code added implementation of scrolling items changing control's size, written tom brunberg.

p.s.s.
user fantaghirocco formatting question ;)

following directions create standard tlistbox noted, said, number of visible items increased when increasing list box (regardless of item being selected).

but, decreasing size did not scroll items again, regardless of item being selected. understand ask same functionality, since refer standard tlistbox.

add uses clause , talistbox class declaration:

uses ... math;   ...    talistbox = class(tcustomcontrol)   private     procedure wmsize(var message: twmsize); message wm_size; 

and implementation

procedure talistbox.wmsize(var message: twmsize); var   lscrollindex, lvisiblecount: integer; begin   inherited;   lscrollindex := fscrolloffset div fitemheight;   lvisiblecount := getvisibleitemscount;   if (fitems.count - lscrollindex) < lvisiblecount     fscrolloffset := fitemheight * max(0, fitems.count - getvisibleitemscount); end; 

a side note: use following kind of expressions in many places, e.g.

  round(fscrolloffset div fitemheight); 

the div operator means integer division. returns integer, call round meaningless. read div , mod in documentation.