Type
TExButtonState = (obshover, obspressed, obsnormal);
TExampleButton = class(TButton)
private
Fstate: TExButtonState;
FCanvas : TCanvas;
Fresim,FBGDisable,FBGHover,FBGNormal,FBGPress:TBGRABitmap;
procedure WMEraseBkGnd(var Message:TWMEraseBkGnd);
protected
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X: integer; Y: integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X: integer; Y: integer); override;
procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
procedure Paint; virtual;
procedure PaintWindow(DC: HDC); override;
property Canvas: TCanvas read FCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
procedure TExampleButton.MouseEnter;
begin
if (csDesigning in ComponentState) then exit;
if (Enabled=false) or (Fstate = obshover) then Exit;
inherited MouseEnter;
Fstate := obshover;
Invalidate;
end;
procedure TExampleButton.MouseLeave;
begin
if (csDesigning in ComponentState) then
exit;
if (Enabled=false) or (Fstate = obsnormal) then
Exit;
inherited MouseLeave;
Fstate := obsnormal;
Invalidate;
end;
procedure TExampleButton.MouseDown(Button:TMouseButton;Shift:TShiftState;X:
integer;Y:integer);
begin
if (csDesigning in ComponentState) then
exit;
if (Enabled=false) or (Fstate = obspressed) then
Exit;
inherited MouseDown(Button, Shift, X, Y);
if Button = mbLeft then
begin
Fstate := obspressed;
Invalidate;
end;
end;
procedure TExampleButton.MouseUp(Button:TMouseButton;Shift:TShiftState;X:integer;
Y:integer);
begin
inherited MouseUp(Button, Shift, X, Y);
Fstate := obsnormal;
Invalidate;
end;
procedure TExampleButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
Message.Result := - 1;
end;
constructor TExampleButton.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
self.Width := 100;
self.Height := 30;
Fstate := obsNormal;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
FResim := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight);
FBGDisable := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight);
FBGHover := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight);
FBGNormal := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight);
FBGPress := TBGRABitmap.Create(self.ClientWidth,self.ClientHeight);
FBGDisable.LoadFromFile('disable.png');
FBGHover.LoadFromFile('Hover.png');
FBGNormal.LoadFromFile('Normal.png');
FBGPress.LoadFromFile('press.png');
end;
destructor TExampleButton.Destroy;
begin
FreeAndNil(Fcanvas);
FreeAndNil(FBGDisable);
FreeAndNil(FBGHover);
FreeAndNil(FBGNormal);
FreeAndNil(FBGPress);
FreeAndNil(Fresim);
inherited Destroy;
end;
procedure TExampleButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
Message.Result := - 1;
end;
procedure TExampleButton .WMPaint(var Msg:TLMPaint);
begin
ControlState := ControlState+[csCustomPaint];
inherited;
ControlState := ControlState-[csCustomPaint];
end;
procedure TExampleButton.Paint;
var
rc:TRect;
x, y: integer;
hdc1, SpanRgn: hdc;
WindowRgn: HRGN;
p: PBGRAPixel;
begin
if not Assigned(fresim) then exit;
if fresim.Width<0 then exit;
if not Visible then exit;
fresim.SetSize(0,0);
fresim.SetSize(clientWidth,clientHeight);
fresim.Fill(BGRAPixelTransparent);
if Enabled = True then
begin
case Fstate of
obsNormal : begin fresim.PutImage(0,0,FBGNormal,dmDrawWithTransparency); self.font.Color:=FNormalC.Fontcolor end;
obshover : begin fresim.PutImage(0,0,FBGHover,dmDrawWithTransparency); self.font.Color:=FHoverC.Fontcolor end;
obspressed : begin fresim.PutImage(0,0,FBGPress,dmDrawWithTransparency); self.font.Color:=FPressC.Fontcolor end;
else
begin fresim.PutImage(0,0,FBGNormal,dmDrawWithTransparency); self.font.Color:=FNormalC.Fontcolor end;
end;
end else
begin
fresim.PutImage(0,0,FBGDisable,dmDrawWithTransparency); self.font.Color:=FDisableC.Fontcolor;
end;
if fresim.Width>0 then
begin
/// if crop to image
{ WindowRgn := CreateRectRgn(0, 0, fresim.Width, fresim.Height);
for Y := 0 to fresim.Height - 1 do
begin
p := fresim.Scanline[Y];
for X := fresim.Width - 1 downto 0 do
begin
if p^.Alpha < 20 then//<255 then
begin
p^ := BGRAPixelTransparent;
SpanRgn := CreateRectRgn(x, y, x + 1, y + 1);
CombineRgn(WindowRgn, WindowRgn, SpanRgn, RGN_DIFF);
DeleteObject(SpanRgn);
end;
Inc(p);
end;
end;
fresim.InvalidateBitmap;
SetWindowRgn(self.Handle, WindowRgn, True);
hdc1 := GetDC(self.Handle);
ReleaseDC(self.Handle, hdc1);
DeleteObject(WindowRgn);
DeleteObject(hdc1);
} // Crop to image
rc:=ClientRect;
fresim.Canvas.Brush.Style:=bsClear;
DrawText(fresim.Canvas.Handle,Pchar(Caption),Length(Caption),rc,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
fresim.Draw(fCanvas,0,0);
end;
end;
procedure TExampleButton.PaintWindow(DC:HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;
Recent
