unit bitmapactionbutton;

interface

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

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


type
  TBitmapActionButton = class(TGraphicControl)
  private
  fbuttoncolor :  integer;
  fcolor : Tcolor;
  ftext : string;
  fdown : boolean;
  procedure autosize;
  procedure setcolor(_color : tcolor);
  procedure settext(txt : string);
  procedure setdown (check : boolean);
  { 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 setbuttoncolor(c : integer);


    { Public declarations }
  published
  property color : Tcolor read Fcolor write setcolor default clred;
  property font;
  property parentfont;
  property caption : string read ftext write settext;
  property down : boolean read fdown write setdown;
  property buttoncolor : integer read fbuttoncolor write setbuttoncolor;
  property OnClick;
  property OnMouseDown;
  property OnMouseUp;
  property visible;
        { Published declarations }
  end;

const ICONWIDTH = 32;

procedure Register;

implementation
{$R ICONS.RES}

procedure alphablendbitmapwithcolor(blend : tbitmap;blendcolor : tcolor;source : tbitmap;alpha : real);
var
x,y : integer;
rin,rout : pbytearray;
outval : integer;
br,bg,bb : integer;

function rangecheck(inp : integer) : byte;
begin
     if inp>255 then outval:=255;
     if inp<0 then outval:=0;
     result:=byte(inp);
end;

begin
source.width:=blend.width;
source.height:=blend.height;
source.pixelformat:=pf24bit;
br:=getrvalue(ColorToRGB(blendcolor));
bg:=getgvalue(ColorToRGB(blendcolor));
bb:=getbvalue(ColorToRGB(blendcolor));


with source do begin
       for y:=0 to source.height -1 do begin
         rin:=scanline[y];
         rout:=source.scanline[y];
         x:=0;
      // application.processmessages;
         while x< 3*width-1 do begin
      // application.processmessages;

         outval:=round((alpha*(rin[x]-br))+br);
         rout[x]:=rangecheck(outval);
      // application.processmessages;
         outval:=round((alpha*(rin[x+1]-bg))+bg);
         rout[x+1]:=rangecheck(outval);
      // application.processmessages;

         outval:=round((alpha*(rin[x+2]-bb))+bb);
         rout[x+2]:=rangecheck(outval);
         x:=x+3;
         end;
     end;
end;
end;


procedure TBitmapActionButton.autosize;
begin
canvas.font.name:=font.name;
canvas.font.size:=font.size;
if (canvas.textwidth(ftext)+ICONWIDTH+16)>=width then width:=(canvas.textwidth(caption)+ICONWIDTH+19);
if (canvas.textheight(ftext))>=height then height:=(canvas.textheight(ftext));
if height<ICONWIDTH then height:=iconWIDTH;
end;


procedure TBitmapActionButton.setbuttoncolor(c : integer);
begin
fbuttoncolor:=c;
invalidate;
end;



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

procedure TBitmapActionButton.settext(txt : string);
begin
ftext:=txt;
autosize;
invalidate;
end;

procedure TBitmapActionButton.setdown(check: boolean);
begin
fdown:=check;
invalidate;
end;

constructor TBitmapActionButton.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
     controlstyle:=controlstyle-[csOpaque];
     Parent := (AOwner AS TWinControl);
     fcolor:=clWindow;
     canvas.pen.style:=psSolid;
     height:=32;
     width:=50;
     fdown:=false;

end;


procedure TBitmapActionButton.Paint;
var
vicon : tbitmap;
textcentre : integer;
tr,dr : trect;
bt : string;
//vcanv : Tbitmap;
begin
inherited paint;
canvas.brush.style:=bssolid;


{vcanv:= Tbitmap.create;
vcanv.width:=width;
vcanv.height:=height;
vcanv.canvas.brush:=Canvas.brush;
vcanv.canvas.pen:=Canvas.pen;
vcanv.canvas.font:=canvas.font;
}



vicon:=tbitmap.create;


bt:='BLUE';
if fbuttoncolor=1 then bt:='GREEN';
if fbuttoncolor=2 then bt:='RED';
if fbuttoncolor=3 then bt:='PURPLE';
if fbuttoncolor=4 then bt:='YELLOW';


{tr.top:=0;
tr.left:=0;
tr.right:=width;
tr.bottom:=height;
vcanv.canvas.copyrect(tr,canvas,tr);
}



if fdown=true then begin
vicon.loadfromresourcename(hinstance,bt+'DOWN');
end else vicon.loadfromresourcename(hinstance,bt+'UP');

if fbuttoncolor>5 then begin
  alphablendbitmapwithcolor(vicon,fbuttoncolor,vicon,0.4);
end;


tr.Left:=0;
tr.Top:=0;
tr.Right:=width;
tr.Bottom:=height;

//canvas.fillrect(tr);
tr.Left:=0;
tr.Top:=0;
tr.Right:=vicon.width;
tr.Bottom:=vicon.height;

dr.Left:=2;
dr.Top:=2;
dr.Right:=vicon.width+2;
dr.Bottom:=vicon.height;


canvas.brush.style:=bsclear;
//canvas.brushcopy(dr,vicon,tr,vicon.Canvas.Pixels[1,1]);
canvas.brushcopy(dr,vicon,tr,rgb(255,255,255));

textcentre:=(height div 2) - (canvas.textheight(ftext) div 2);
canvas.font.style:=font.style;
canvas.font.name:=font.name;
canvas.font.size:=font.size;
canvas.font.color:=font.color;
canvas.pen.color:={viewgit}{/viewgit}00C6F7;
canvas.pen.width:=2;
canvas.brush.style:=bsClear;
canvas.Ellipse(2,2,tr.right+2,tr.bottom);

canvas.textout(vicon.width+16,textcentre,ftext);


vicon.free;


end;

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


procedure TBitmapActionButton.Resize;
begin
inherited resize;
canvas.Font:=font;
end;

procedure TBitmapActionButton.click;
begin
inherited click;
end;

procedure TBitmapActionButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
fdown:=false;
invalidate;
inherited;
end;

procedure TBitmapActionButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
fdown:=true;
invalidate;
inherited;
end;




end.