unit SelecterListBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, extctrls;

type tmatrix = record
x1,y1,x2,y2 : integer;
item : integer;
end;

const DEFAULTFONT='Garamond';



type
  TSelecterListBox = class(TCustomControl)
  private
  fselected : array of boolean;
  fitems : tstringlist;
  fcount : integer;
  fitemindex : integer;
  fcolor : Tcolor;
  ffont : tfont;
  flinespacing : single;
  fmargin : integer;
  fnumbercolor : tcolor;
  fshownumbers : boolean;
  topmost : integer;
  displayitems : integer;
  itemheight : integer;
  topborder : integer;
  fdrawmode : boolean;
  repeattimer : ttimer;
  xx,yy : integer;


  matrix : array of tmatrix;
  marked : integer;
  procedure repeattimertimer(sender : tobject);
  procedure setcolor(_color : tcolor);
  procedure setfont(_font : tfont);
  procedure setlinespacing(_value : single);
  function cliptextout(buffer : Tbitmap;x,y : integer;st : string;no : integer;selected : boolean) : Tsize;
  procedure itemschange(sender : tobject);
  { Private declarations }
  protected
    { Protected declarations }
  public
  constructor Create(AOwner : TComponent); override;
  procedure Paint; override;
  procedure Resize; override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override;
  procedure Click; override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure StopFlicker(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  function IsSelected(n : integer) : boolean;
  procedure selectall;
  procedure selectnone;

    { Public declarations }
  published
  property color : Tcolor read Fcolor write setcolor default clred;
  property items : tstringlist read fitems;// write setitems;
  property itemindex : integer read fitemindex;
  property font : tfont read ffont write setfont;
  property linespacing : single read flinespacing write setlinespacing;
  property margin : integer read fmargin write fmargin;
  property showlabels : boolean read fshownumbers write fshownumbers;
  property drawmode : boolean read fdrawmode write fdrawmode;
  property numbercolor : tcolor read fnumbercolor write fnumbercolor;
  property OnClick;
  property count : integer read fcount;
  procedure clear;
     { Published declarations }
  end;


procedure Register;

const
TIMERDEFAULT=250;


implementation
{$R ICONS.RES}


procedure TSelecterListBox.selectall;
var
n : integer;
begin
for n:=0 to fcount do fselected[n]:=true;
repaint;
end;

procedure TSelecterListBox.selectnone;
var
n : integer;
begin
for n:=0 to fcount do fselected[n]:=false;
repaint;
end;

procedure TSelecterListBox.itemschange(sender : tobject);
begin
fcount:=fitems.count;
setlength(fselected,fcount+1);
if fcount>0 then fselected[fcount-1]:=false;
//repaint;
end;

function TSelecterListBox.cliptextout(buffer: TBitmap;x,y : integer;st : string;no : integer;selected : boolean) : Tsize;
var
ns : string;
ls : tsize;
begin
ls.cx:=0;
with buffer do begin
if fshownumbers=true then begin
   ns:=format('%.3d',[no]);
   ls:=canvas.textextent(ns);
   if selected=true then canvas.font.color:=ffont.color else canvas.font.color:=clgray;
   //canvas.rectangle(x,y,ls.cx,ls.cy);
   ls.cx:=ls.cx+(width div 20);
   canvas.textout(x,y,ns);
   canvas.brush.color:=fcolor;
end;
if selected=true then canvas.font.color:=ffont.color else canvas.font.color:=clgray;
canvas.textout(x+ls.cx,y,st);
result:=canvas.textextent(st);
result.cx:=result.cx+ls.cx;
end;
end;

procedure TSelecterListBox.clear;
begin
topmost :=0;
fitems.clear;
fitemindex:=-1;
//repaint;
end;

procedure TSelecterListBox.setlinespacing(_value : single);
begin
if _value<1 then _value:=1;
flinespacing:=_value;
resize;
end;

procedure TSelecterListBox.setfont(_font : tfont);
begin
ffont.name:=_font.name;
ffont.size:=_font.size;
ffont.style:=_font.style;
resize;

end;


procedure TSelecterListBox.setcolor(_color : tcolor);
begin
Fcolor:=_color;
end;

constructor TSelecterListBox.Create(AOwner : TComponent);
begin
     inherited;
     fcolor:=clWindow;
     fitems:=tstringlist.create;
     fitems.OnChange:=itemschange;
     fitems.add(name);
     ffont:=tfont.create;
     ffont.name:=DEFAULTFONT;
     ffont.size:=12;
     flinespacing:=1;
     marked:=-3;
     topmost:=0;
     Parent := (AOwner AS TWinControl);
     canvas.pen.style:=psSolid;
     canvas.brush.style:=bsSolid;
     fshownumbers:=true;
     drawmode :=true;
     fitemindex:=-1;
     repeattimer:=ttimer.create(self);
     repeattimer.interval:=TIMERDEFAULT;
     repeattimer.ontimer:=repeattimertimer;
     repeattimer.enabled:=false;
end;


procedure TSelecterListBox.Paint;
var
n : integer;
y : integer;
ext : Tsize;
bmp : tbitmap;
max : integer;
showtop,showbottom : boolean;
vcanv : Tbitmap;
tr,dr : trect;
begin

vcanv:= Tbitmap.create;
vcanv.width:=width;
vcanv.height:=height;
vcanv.canvas.brush:=Canvas.brush;
vcanv.canvas.pen:=Canvas.pen;
vcanv.canvas.font.name:=font.name;
vcanv.canvas.font.size:=font.size;
vcanv.canvas.font.style:=font.style;



with vcanv do begin

setlength(matrix,0);
if topmost=0 then showtop:=false else showtop:=true;
showbottom:=true;

canvas.Brush.color:=fcolor;
canvas.pen.color:=fcolor;
if drawmode=true then  canvas.Rectangle(0,0,width,height);

setlength(matrix,fitems.count+2);

y:=topborder;
max:=(topmost+displayitems)-1;

if max>=fitems.count-1 then begin
   max:=fitems.count-1;
   showbottom:=false;
end;

for n:=topmost to (max) do begin
     if marked=n then canvas.font.color:=clHighlight else canvas.font.color:=ffont.color;
     if drawmode=true then  ext:=cliptextout(vcanv,fmargin,y,fitems[n],n+1,fselected[n]);
     matrix[n].x1:=fmargin;
     matrix[n].y1:=y;
     matrix[n].x2:=matrix[n].x1+ext.cx;
     matrix[n].y2:=matrix[n].y1+ext.cy;
     matrix[n].item:=n;
     y:=y+itemheight;
end;

if showtop=true then begin
   bmp:=tbitmap.create;
   if marked=-1 then bmp.LoadFromResourceName(hinstance,'SELECTERUPPRESSED') else bmp.LoadFromResourceName(hinstance,'SELECTERUPNORMAL');
   matrix[fitems.count].x1:=(width div 2)-(bmp.width div 2)+fmargin;
   matrix[fitems.count].y1:=1;
   matrix[fitems.count].x2:=matrix[fitems.count].x1+bmp.width+fmargin;
   matrix[fitems.count].y2:=matrix[fitems.count].y1+bmp.height;
   matrix[fitems.count].item:=-1;
   dr.left:=matrix[fitems.count].x1;
   dr.top:=matrix[fitems.count].y1;
   dr.right:=bmp.width+dr.left;
   dr.bottom:=bmp.height+dr.Top;
   tr.top:=0;
   tr.left:=0;
   tr.right:=bmp.width;
   tr.Bottom:=bmp.height;
   canvas.BrushCopy(dr,bmp,tr,RGB(255,255,255));
      canvas.font.size:=7;
   canvas.font.name:=DEFAULTFONT;
   canvas.font.color:=clgray;
   canvas.textout(width div 2 - canvas.textwidth('More') div 2,tr.top+(tr.bottom)+2,'More');

   bmp.free;
end;

if showbottom=true then begin
   bmp:=tbitmap.create;
   if marked=-2 then bmp.LoadFromResourceName(hinstance,'SELECTERDOWNPRESSED') else bmp.LoadFromResourceName(hinstance,'SELECTERDOWNNORMAL');
   matrix[fitems.count+1].x1:=(width div 2)-(bmp.width div 2);
   matrix[fitems.count+1].y1:=height-bmp.height-1;
   matrix[fitems.count+1].x2:=matrix[fitems.count+1].x1+bmp.width;
   matrix[fitems.count+1].y2:=matrix[fitems.count+1].y1+bmp.height;
   matrix[fitems.count+1].item:=-2;
   dr.left:=matrix[fitems.count+1].x1;
   dr.top:=matrix[fitems.count+1].y1;
   dr.right:=bmp.width+dr.left;
   dr.bottom:=bmp.height+dr.Top;
   tr.top:=0;
   tr.left:=0;
   tr.right:=bmp.width;
   tr.Bottom:=bmp.height;
   canvas.BrushCopy(dr,bmp,tr,RGB(255,255,255));
      canvas.font.size:=7;
   canvas.font.name:=DEFAULTFONT;
   canvas.font.color:=clgray;
   canvas.textout(width div 2 - canvas.textwidth('More') div 2,dr.top-canvas.textheight('More'),'More');

   bmp.free;
end;



end;
if drawmode=true then canvas.draw(0,0,vcanv);
vcanv.free;

end;

procedure Register;
begin
  RegisterComponents('LibrarySmith', [TSelecterListBox]);
end;


procedure TSelecterListBox.Resize;
begin

canvas.Font.size:=ffont.size;
canvas.Font.name:=ffont.name;
canvas.Font.style:=ffont.style;
itemheight:=round(canvas.textheight('AAA')*flinespacing);
topborder:=itemheight;
displayitems:=round((height-(topborder*2))/ (itemheight));
end;

procedure TSelecterListBox.click;
begin
//inherited click;
end;

procedure TSelecterListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
n : integer;

begin
repeattimer.enabled:=false;
repeattimer.interval:=TIMERDEFAULT;
marked:=-3;
repaint;

exit;
//fitemindex:=-1;

//inherited MouseUp(Button,Shift,X,Y);
for n:=topmost to fitems.count+2 do begin
    if (x>=matrix[n].x1) And
       (x<=matrix[n].x2) And
       (y>=matrix[n].y1) And
       (y<=matrix[n].y2) then begin
       end;

end;

end;

procedure TSelecterListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
n : integer;
begin
fitemindex:=-1;
repeattimer.enabled:=true;
//inherited MouseDown(Button,Shift,X,Y);
for n:=topmost to fitems.count+2 do begin
    if (x>=matrix[n].x1) And
       (x<=matrix[n].x2) And
       (y>=matrix[n].y1) And
       (y<=matrix[n].y2) then begin
                               marked:=matrix[n].item;
                               fitemindex:=matrix[n].item;
                               if matrix[n].item>-1 then if fselected[matrix[n].item]=false then fselected[matrix[n].item]:=true else fselected[matrix[n].item]:=false;
                               if matrix[n].item=-2 then inc(topmost);
                               if matrix[n].item=-1 then dec(topmost);
                               inherited click;
                               repaint;
                               exit;
                              end;

end;
end;

procedure TSelecterListBox.StopFlicker(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;


function TSelecterListBox.IsSelected(n : integer) : boolean;
begin
if n>fcount then begin
   result:=false;
   exit;
   end;
result:=fselected[n];
end;

procedure TSelecterListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
xx:=x;
yy:=y;
end;


procedure TSelecterListBox.repeattimertimer(sender : tobject);
begin
if marked<0 then mousedown(tmousebutton(0),[],xx,yy);
if repeattimer.interval>40 then repeattimer.interval:=repeattimer.interval-10;

end;

end.