unit picturescroller;

interface
uses windows,messages,graphics,controls,classes,extctrls,sysutils,global;


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;

  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}




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 n>high(matrix) then break;
    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 n>high(matrix) then break;
    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.