Index
» Empathy Jukebox : Blob dc5d25 / Standalone_Components / TSelecterListbox / SelecterListBox.pas
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.