Index
» Empathy Jukebox : Blob f6aec9 / Standalone_Components / TPictureScroller component / picturescroller.pas
unit picturescroller; interface uses windows,messages,graphics,controls,classes,extctrls,sysutils; const MORECOLOUR = clGray; const DEFAULTFONT='Garamond'; type picrecord = record picture : tbitmap; album : integer; end; type tpicturelist = record items : array of picrecord; end; type tmatrix = record x1,y1,x2,y2 : integer; item : integer; end; type TPictureScroller = class(TGraphicControl) private matrix : array of tmatrix; ftopmost : integer; fcolor : Tcolor; facross : integer; fcount : integer; fitemindex : integer; repeattimer : ttimer; { Private declarations } xx,yy : integer; isdown : boolean; marked : integer; fremote : boolean; remotex,remotey : integer; visrows,viscols : integer; remoteselection : tmatrix; fscalescrolls : real; fscrollwidths : integer; fmoretext : string; fmorebackgroundcolor: tcolor; vcanv : tbitmap; procedure setcolor(_color : tcolor); procedure setacross(acr : integer); procedure repeattimertimer(sender : tobject); function getpic : tbitmap; function finditem (x : integer) : integer; procedure StopFlicker(var msg : TWMEraseBkGnd); message WM_ERASEBKGND; // procedure scaleicon(var bmp : tbitmap); protected { Protected declarations } public pl : tpicturelist; constructor Create(AOwner : TComponent); override; destructor Destroy; override; procedure Paint; override; procedure Resize; override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override; procedure add(bmp : tbitmap;alb : integer); procedure delete(i : integer); procedure replace(i : integer;bmp : tbitmap;alb : integer); procedure clear; procedure Click; override; procedure Makeitemvisible(i : integer); procedure Makealbumvisible(i : integer); { Public declarations } property Picture : tbitmap read getpic; procedure Moveup; procedure Movedown; procedure Moveleft; procedure Moveright; function lookupalbum(a : integer) : integer; published { Published declarations } property color : Tcolor read Fcolor write setcolor default clred; property across : integer read Facross write setacross default 4; property itemindex : integer read fitemindex; property OnClick; property topmost : integer read ftopmost; property remote : boolean read fremote write fremote; property scrollwidths : integer read fscrollwidths write fscrollwidths; property moretext : string read fmoretext write fmoretext; property morebackgroundcolor : tcolor read fmorebackgroundcolor write fmorebackgroundcolor; procedure remoteclick; end; const TIMERINTERVAL=250; procedure Register; implementation {$R ICONS.RES} function TPictureScroller.lookupalbum(a : integer) : integer; var n : integer; begin result:=-1; for n:=0 to fcount-1 do begin if a=pl.items[n].album then begin result:=n; break; end; end; end; procedure TPictureScroller.remoteclick; begin MouseDown(mbLeft,[],remoteselection.x1+1,remoteselection.y1+1); end; function TPictureScroller.finditem(x : integer) : integer; var n : integer; begin result:=-99; for n:=0 to fcount+2 do begin if x=matrix[n].item then begin result:=n; break; end; end; end; procedure TPictureScroller.Moveup; var i : integer; begin if remotey>0 then dec(remotey) else begin i:=finditem(-2); if i<>-99 then begin MouseDown(mbLeft,[],matrix[i].x1+1,matrix[i].y1+1); end; end; //repaint; end; procedure TPictureScroller.Movedown; var i : integer; begin if remotey<visrows then inc(remotey) else begin i:=finditem(-1); if i<>-99 then begin MouseDown(mbLeft,[],matrix[i].x1+1,matrix[i].y1+1); end else inc(visrows); end; if topmost+((remotey*facross)+remotex-1)>fcount-2 then begin; dec(remotey); end; //repaint; end; procedure TPictureScroller.Moveleft; begin if remotex>0 then dec(remotex); //repaint; end; procedure TPictureScroller.Moveright; begin if remotex<viscols-1 then inc(remotex); if topmost+((remotey*facross)+remotex-1)>fcount-2 then begin; dec(remotex); end; //repaint; end; {procedure TPictureScroller.createparams(Var params : TCreateParams); begin inherited createparams(params); params.ExStyle:=params.ExStyle or WS_EX_TRANSPARENT; end; } procedure TPictureScroller.StopFlicker(var msg : TWMEraseBkGnd); begin //SetBkMode(msg.DC,TRANSPARENT); msg.result:=1; end; procedure TPictureScroller.Makealbumvisible(i : integer); var n : integer; begin for n:=0 to fcount-1 do begin if i=pl.items[n].album then begin makeitemvisible(n); break; end; end; end; procedure TPictureScroller.Makeitemvisible(i : integer); begin {if i>fcount-1 then exit; x:=0; y:=0; for n:=0 to i do begin if n=i then break; inc(x); if x=facross then begin; x:=0;inc(y);end; end; } ftopmost:=i div across * across; paint; //fitemindex:=-1; //mouseup(mbleft,[],0,0); end; procedure TPictureScroller.replace(i : integer;bmp : tbitmap;alb : integer); var picturewidth : integer; tr : trect; begin if (i<0) or (i>fcount) then exit; picturewidth:=width div facross; tr.left:=0; tr.top:=0; tr.bottom:=picturewidth; tr.right:=picturewidth; pl.items[i].picture.canvas.stretchdraw(tr,bmp); pl.items[i].album:=alb; end; procedure TPictureScroller.delete(i : integer); var n : integer; begin for n:=i to fcount-2 do begin pl.items[n].picture.assign(pl.items[n+1].picture); end; dec(fcount); setlength(pl.items,fcount); repaint; end; procedure TPictureScroller.add(bmp : tbitmap;alb : integer); var picturewidth : integer; spacing : integer; tr : trect; begin picturewidth:=round((width div facross)); spacing:=picturewidth div 10; picturewidth:=picturewidth - spacing; setlength(pl.items,fcount+1); pl.items[fcount].picture:=tbitmap.create; pl.items[fcount].picture.HandleType:=bmDIB; pl.items[fcount].picture.SetSize(picturewidth,picturewidth); pl.items[fcount].picture.PixelFormat:= pf16bit; tr.left:=0; tr.top:=0; tr.bottom:=picturewidth; tr.right:=picturewidth; pl.items[fcount].picture.canvas.stretchdraw(tr,bmp); pl.items[fcount].picture.Dormant; pl.items[fcount].picture.FreeImage; pl.items[fcount].album:=alb; inc(fcount); //paint; end; procedure TPictureScroller.clear; var n : integer; begin if fcount=0 then exit; for n:=0 to fcount do pl.items[n].picture.free; fcount:=0; setlength(pl.items,fcount); end; function TPictureScroller.getpic : tbitmap; begin result:=tbitmap.create; if assigned(pl.items[fitemindex].picture) then result.assign(pl.items[fitemindex].picture); end; procedure TPictureScroller.setcolor(_color : tcolor); begin Fcolor:=_color; end; procedure TPictureScroller.setacross(acr : integer); begin Facross:=acr; end; constructor TPictureScroller.Create(AOwner : TComponent); begin inherited create(aowner); Parent := (AOwner AS TWinControl); vcanv:= Tbitmap.create; height:=200; width:=200; fmoretext:='More'; facross:=4; //doublebuffered:=true; ftopmost:=0; repeattimer:=ttimer.create(self); repeattimer.interval:=TIMERINTERVAL; repeattimer.ontimer:=repeattimertimer; repeattimer.enabled:=false; controlstyle:=controlstyle - [csOpaque]; scrollwidths:=18; fmorebackgroundcolor:=rgb($FD,$F7,$B5); end; destructor TPictureScroller.Destroy; var n : integer; begin for n:=0 to fcount-1 do pl.items[n].picture.free; inherited destroy; vcanv.free; end; {procedure TPictureScroller.scaleicon(var bmp : tbitmap); var obmp : tbitmap; tr : trect; begin obmp:=tbitmap.create; fscalescrolls:=fscrollwidths / bmp.width; obmp.width:=round(bmp.width*fscalescrolls); obmp.height:=round(bmp.height*fscalescrolls); tr.top:=0; tr.left:=0; tr.Right:=obmp.width; tr.Bottom:=obmp.height; obmp.Canvas.StretchDraw(tr,bmp); bmp.assign(obmp); obmp.free; end; } procedure TPictureScroller.Paint; const scrollerheight = 18; var n,z : integer; picturewidth,spacing : integer; x,y : integer; tr,dr : trect; o : tbitmap; ht : integer; piccount : integer; hoffset : integer; begin inherited; vcanv.canvas.brush:=Canvas.brush; vcanv.canvas.pen:=Canvas.pen; vcanv.canvas.font:=canvas.font; tr.top:=0; tr.left:=0; tr.right:=width; tr.bottom:=height; vcanv.canvas.copyrect(tr,canvas,tr); viscols:=facross; visrows:=0; with vcanv do begin canvas.brush.style:=bsclear; o:=tbitmap.create; if (facross=0) or (fcount=0) then begin o.free; exit; end; //canvas.brush.color:=fcolor; //canvas.Rectangle(0,0,width,height); setlength(matrix,fcount+3); picturewidth:=width div facross; spacing:=picturewidth div 10; ht:=(((height-scrollerheight*2) div picturewidth)*(picturewidth))+(scrollerheight*2); hoffset:=(height div 2) - (ht div 2)-spacing; ht:=ht+hoffset; picturewidth:=picturewidth - spacing; if ftopmost<>0 then begin if marked=-2 then o.LoadFromResourceName(hinstance,'PUPPRESSED') else o.LoadFromResourceName(hinstance,'PUPNORMAL'); //scaleicon(o); ///o.LoadFromResourceName(hinstance,'PUPNORMAL'); dr.Left:=0; dr.top:=0; dr.right:=o.width; dr.Bottom:=o.height; canvas.font.size:=round(7*fscalescrolls); canvas.font.name:=DEFAULTFONT; canvas.font.color:=MORECOLOUR; tr.top:=hoffset-spacing; tr.Bottom:=o.height+canvas.TextHeight(moretext)+tr.top; tr.left:=((width div 2) - (canvas.textwidth(moretext) div 2))-3; tr.right:=tr.left + (canvas.textwidth(moretext))+6; canvas.Pen.style:=psClear; canvas.Brush.color:=fmorebackgroundcolor; canvas.pen.Color:=clblack; canvas.Pen.style:=psSolid; canvas.rectangle(tr); matrix[0].x1:=tr.left; matrix[0].x2:=tr.right; matrix[0].y1:=tr.top; matrix[0].y2:=tr.bottom; matrix[0].item:=-2; tr.left:=(width div 2) - (o.width div 2); tr.right:=tr.left+o.width; tr.Top:=tr.Top+1; tr.Bottom:=o.height+tr.top; canvas.brush.style:=bsclear; canvas.BrushCopy(tr,o,dr,RGB(255,255,255)); canvas.textout((width div 2) - (canvas.textwidth(moretext) div 2),(tr.bottom),moretext); end else matrix[0].item:=-3; y:=hoffset+scrollerheight+spacing; x:=spacing div 2; //y:=(scrollerheight*3) div 2; piccount:=0; for n:=1 to fcount-(ftopmost) do begin tr.top:=y; tr.bottom:=y+picturewidth; tr.left:=x; tr.right:=x+picturewidth; matrix[n].x1:=tr.left; matrix[n].x2:=tr.right; matrix[n].y1:=tr.top; matrix[n].y2:=tr.bottom; matrix[n].item:=ftopmost+(n-1); canvas.stretchdraw(tr,pl.items[ftopmost+(n-1)].picture); pl.items[ftopmost+(n-1)].picture.Dormant; pl.items[ftopmost+(n-1)].picture.FreeImage; if fremote=true then begin canvas.pen.width:=10; canvas.pen.color:=clred; if n=((remotey*facross)+remotex) then begin canvas.Rectangle(tr.left,tr.top,tr.Right,tr.Bottom); remoteselection:=matrix[n+1]; end; end; inc(piccount); x:=x+picturewidth+spacing; if x>width then begin y:=y+picturewidth+(spacing); x:=spacing div 2; if y+picturewidth>ht then begin break; end; inc(visrows); end; end; if ((ftopmost+(piccount-2)) = fcount-2) then begin matrix[n+1].item:=-3 end else begin o.free; o:=tbitmap.create; //o.LoadFromResourceName(hinstance,'PDOWNNORMAL'); if marked=-1 then o.LoadFromResourceName(hinstance,'PDOWNPRESSED') else o.LoadFromResourceName(hinstance,'PDOWNNORMAL'); // scaleicon(o); {tr.top:=y+spacing; tr.left:=(width div 2) - (o.width div 2); tr.right:=tr.left+o.width; tr.Bottom:=tr.top+o.height; dr.Left:=0; dr.top:=0; dr.right:=o.width; dr.Bottom:=o.height; canvas.BrushCopy(tr,o,dr,RGB(255,255,255)); canvas.font.size:=round(7*fscalescrolls); canvas.font.name:=DEFAULTFONT; canvas.font.color:=MORECOLOUR; canvas.textout(width div 2 - canvas.textwidth(moretext) div 2,tr.top-canvas.textheight(moretext),moretext); canvas.Pen.color:=MORECOLOUR; tr.bottom:=tr.bottom+1+canvas.textheight(moretext); //canvas.rectangle(tr); } dr.Left:=0; dr.top:=0; dr.right:=o.width; dr.Bottom:=o.height; canvas.font.size:=round(7*fscalescrolls); canvas.font.name:=DEFAULTFONT; canvas.font.color:=MORECOLOUR; tr.top:=y; tr.Bottom:=o.height+canvas.TextHeight(moretext)+tr.top; tr.left:=((width div 2) - (canvas.textwidth(moretext) div 2))-3; tr.right:=tr.left + (canvas.textwidth(moretext))+6; canvas.pen.Color:=clblack; canvas.Pen.style:=psSolid; canvas.Brush.color:=fmorebackgroundcolor; canvas.rectangle(tr); canvas.textout((width div 2)-(canvas.textwidth(moretext) div 2),tr.top+1,moretext); matrix[n+1].x1:=tr.left; matrix[n+1].x2:=tr.right; matrix[n+1].y1:=tr.top; matrix[n+1].y2:=tr.bottom; matrix[n+1].item:=-1; tr.left:=(width div 2) - (o.width div 2); tr.right:=tr.left+o.width; tr.Top:=tr.Bottom-(o.height+1); tr.Bottom:=o.height+tr.top; canvas.brush.style:=bssolid; canvas.BrushCopy(tr,o,dr,RGB(255,255,255)); end; z:=n; for n:=z+1 to fcount do begin matrix[n+1].item:=-3; end; end; dr.top:=0; dr.Left:=0; dr.Right:=width; dr.Bottom:=height; canvas.CopyRect(dr,vcanv.Canvas,dr); //canvas.BrushCopy(dr,vcanv,dr,0); //canvas.draw(0,0,vcanv); o.free; end; procedure TPictureScroller.Resize; begin vcanv.width:=width; vcanv.height:=height; paint; end; procedure TPictureScroller.MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); var n : integer; begin marked:=-3; isdown:=false; repeattimer.enabled:=false; repeattimer.interval:=TIMERINTERVAL; //fitemindex:=-1; //inherited MouseDown(Button,Shift,X,Y); if fcount=0 then begin inherited click; exit; end; for n:=0 to fcount+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>-1 then inherited click; // repaint; exit; end; end; end; procedure TPictureScroller.MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); var n : integer; begin isdown:=true; repeattimer.enabled:=true; //fitemindex:=-1; //inherited MouseDown(Button,Shift,X,Y); if fcount=0 then begin inherited click; exit; end; for n:=0 to fcount+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=-1 then ftopmost:=ftopmost+across; if matrix[n].item=-2 then ftopmost:=ftopmost-across; repaint; exit; end; end; end; procedure TpictureScroller.click; begin end; procedure Register; begin RegisterComponents('LibrarySmith', [TPictureScroller]); end; procedure TPictureScroller.MouseMove(Shift: TShiftState; X, Y: Integer); begin xx:=x; yy:=y; //if isdown=true then mouseup(tmousebutton(0),shift,x,y); end; procedure TPictureScroller.repeattimertimer(sender : tobject); begin mousedown(tmousebutton(0),[],xx,yy); //sendmessage(self.handle,WM_LBUTTONDOWN,xx,yy); if repeattimer.interval>20 then repeattimer.interval:=repeattimer.interval-10; end; end.