unit DcControls;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, CommCtrl, ImgList;
type
THotButton =
class(TGraphicControl)
private
FGlyphList: TImageList;
FImageList: TImageList;
FImageIndex: Integer;
FMouseInControl: Boolean;
FMouseClick: Boolean;
procedure SetImageList(Value: TImageList);
procedure SetImageIndex(Value: Integer);
procedure SetGlyphList;
procedure WMLButtonDown(
var Message: TWMLButtonDown);
message WM_LBUTTONDOWN;
procedure WMLButtonUp(
var Message: TWMLButtonUp);
message WM_LBUTTONUP;
procedure CMMouseEnter(
var Message: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(
var Message: TMessage);
message CM_MOUSELEAVE;
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
property ImageList: TImageList
read FImageList
write SetImageList;
property ImageIndex: Integer
read FImageIndex
write SetImageIndex;
property OnClick;
end;
implementation
constructor THotButton.Create(AOwner: TComponent);
begin
inherited;
FGlyphList:= TImageList.Create(self);
FImageList:=nil;
FImageIndex:=-1;
FMouseInControl:=False;
FMouseClick:=False;
end;
destructor THotButton.Destroy;
begin
FGlyphList.Free;
inherited;
end;
procedure THotButton.SetGlyphList;
var sbm, dbm: TBitmap;
i: Integer;
begin
sbm:=TBitmap.Create;
FImageList.GetBitmap(FImageIndex,sbm);
if sbm.Width
mod sbm.Height=0
then begin
dbm:=TBitmap.Create;
dbm.SetSize(sbm.Width
div 3,sbm.Height);
for i:=0
to 2
do begin
dbm.Canvas.CopyRect(Rect(0,0,dbm.Width,dbm.Height),sbm.Canvas,Rect(i*dbm.Width,0,i*dbm.Width+dbm.Width,dbm.Height));
FGlyphList.Width:=dbm.Width;
FGlyphList.Height:=dbm.Height;
FGlyphList.Add(dbm,
nil);
end;
end;
sbm.Free;
dbm.Free;
end;
//Es gibt 3 mögliche Stati für einen HotButton
procedure THotButton.SetImageList(Value: TImageList);
begin
FImageList:=Value;
if (FImageList<>
nil)
and (FImageIndex<>-1)
then begin
SetGlyphList;
Height:=FGlyphList.Height;
Width:=FGlyphList.Width;
Repaint;
end;
end;
procedure THotButton.SetImageIndex(Value: Integer);
begin
FImageIndex:=Value;
if (FImageList<>
nil)
and (FImageIndex<>-1)
then begin
SetGlyphList;
Height:=FGlyphList.Height;
Width:=FGlyphList.Width;
Repaint;
end;
end;
procedure THotButton.WMLButtonDown(
var Message: TWMMouse);
begin
inherited;
FMouseClick:=True;
Repaint;
end;
procedure THotButton.WMLButtonUp(
var Message: TWMMouse);
begin
inherited;
FMouseClick:=False;
Repaint;
end;
procedure THotButton.CMMouseEnter(
var Message: TMessage);
begin
inherited;
FMouseInControl:=True;
Repaint;
end;
procedure THotButton.CMMouseLeave(
var Message: TMessage);
begin
inherited;
FMouseInControl:=False;
Repaint;
end;
procedure THotButton.Paint;
begin
if FGlyphList.Count=3
then
if not FMouseInControl
then begin
ImageList_DrawEx(FGlyphList.Handle, 0, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
end
else
if not FMouseClick
then begin
ImageList_DrawEx(FGlyphList.Handle, 1, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
end
else begin
ImageList_DrawEx(FGlyphList.Handle, 2, Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
end;
end;
end.