7
7030
Unregistered / Unconfirmed
GUEST, unregistred user!
问题就是画布不能更新,当mouseenter时,底图不知如何擦除了
unit ibtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
,ExtCtrls,Menus,Buttons,StdCtrls;
type
TOnMouseOverEvent = procedure(Sender: TObject) of object;
TOnMouseOutEvent = procedure(Sender: TObject) of object;
TLayout=(blGlyphLeft,blGlyphBottom,blGlyphRight,blGlyphTop);
TNumGlyphs = 1..4;
TNumGlyphsHot = 1..4;
TSpacing = 1..5;
TMargin = -5..5;
TMarkGap = 1..5;
TPositionPopup = (puDown,puLeft,puRight);//菜单弹出的方向
TStyle = (stFlat,stDefault,stNone,stRaised,stFlatDot,//按钮外观
stRaisedDot,stFrameLowered,stFrameRaised);
TColorMarginDefault = (cmDefault,cmCustom);
ticustombutton = class(TGraphicControl)
private
MainRect,Secenje,Duplikat,Ispravni,Gde,CaptRect,MarkRect,GdeMark:Trect;
I,IG,Xpromtext,Ypromtext,Xveliki,Yveliki,Ymark,Xmark:integer;
DC: THandle;
BiDiFlags: Longint ;
FMarkGap:TMarkGap;
FSpacing:TSpacing;
FMargin:TMargin;
FStyle:TStyle;
FNumGlyphs:TNumGlyphs;
FNumGlyphsHot:TNumGlyphsHot;
FHintTwo:String;
FPositionPopup:TPositionPopup;
FPopupMenu: TPopupMenu;
FOnMouseOver: TOnMouseOverEvent;
FOnMouseOut: TOnMouseOutEvent;
FGlyph,FIspravniGlyph,FGlyphHot,FMonoBmp,Fmark:TBitmap;
FLayout:TLayout;
FMouseInPos,FHotTrack,FCancel,FDefault,FMarkMenu,FShowHandCursor,Focused,FShowFocused:boolean;
FColorMarginDefault:TColorMarginDefault;
Fx,FRavno,FRavno1,Fslovo:integer;
FBoja,FBojaHot,FHotTrackColor,FColorHighLight,FColorShadow,FColorHighLightPomocni,FColorShadowPomocni:TColor;
function GetHintTwo: string;
procedure DrawGlyph;
procedure DrawGlyphHot;
procedure PozicijaGlyph;
procedure DrawCaption;
procedure PozijaCaption;
procedure DrawMark;
procedure PozicijaMark;
procedure DrawFocus;
procedure DrawCaptionEnabled;
procedure SetShowHandCursor(AShowHandCursor:boolean);
procedure SetColorMarginDefault(value:TColorMarginDefault);
procedure SetColorPomocni(index: integer; value: TColor);
procedure SetHintTwo(AHintTwo: string);
procedure SetMarkGap(value:TMarkGap);
procedure SetDefault(Value: Boolean);
procedure SetMarkMenu(AMarkMenu: Boolean);
procedure SetPositionPopup(value:TPositionPopup);
procedure SetHotTrack(AHotTrack:Boolean);
procedure SetSpacing(value:TSpacing);
procedure SetMargin(value:TMargin);
procedure SetStyle(value:TStyle);
procedure SetNumGlyphs(value: TNumGlyphs);
procedure SetNumGlyphsHot(value: TNumGlyphsHot);
procedure SetGlyph(value: TBitmap);
procedure SetGlyphHot(value: TBitmap);
procedure SetHotTrackColor(AHotTrackColor: TColor);
procedure SetLayout(Value:TLayout);
procedure DrawDisabledBitmap(Canvas: TCanvas; x, y: Integer; bmp: TBitmap);
procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMMouseEnter(var AMsg: TMessage);message CM_MOUSEENTER;
procedure CMMouseLeave(var AMsg: TMessage);message CM_MOUSELEAVE;
procedure CmEnabledChanged(var Message: TWmNoParams); message CM_ENABLEDCHANGED;
procedure CmParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
procedure CmTextChanged(var Message: TWmNoParams); message CM_TEXTCHANGED;
procedure CmVisibleChanged(var Message: TWmNoParams); message CM_VISIBLECHANGED;
procedure CmParentFontChanged(var Message: TWMNoParams); message CM_FONTCHANGED;
procedure SetPopupMenu(value: TPopupMenu);
procedure CnCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDblClk (var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
protected
procedure Click;override;
procedure Paint;override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation);override;
property CursorHandCustom:boolean read FShowHandCursor write SetShowHandCursor default True;
property ColorMarginLeftTop: TColor
index 1 read FColorHighLightPomocni write SetColorPomocni default clBtnHighLight;
property ColorMarginRightBottom: TColor
index 2 read FColorShadowPomocni write SetColorPomocni default clBtnShadow;
property ColorMarginStyle:TColorMarginDefault
read FColorMarginDefault write SetColorMarginDefault default cmDefault;
property PopupMenuMark:boolean read FMarkMenu write SetMarkMenu default False;
property PopupMenuMarkGap:TMarkGap read FMarkGap write SetMarkGap default 5;
property PositionPopup: TPositionPopup read FPositionPopup write SetPositionPopup default puDown;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property HotTrackColor:TColor read FHotTrackColor write SetHotTrackColor default clBlue;
property HotTrack:Boolean read FHotTrack write SetHotTrack default True;
property Spacing:TSpacing read FSpacing write SetSpacing default 4;
property SpacingLayout:TMargin read FMargin write SetMargin default 3;
property OnMouseOver: TOnMouseOverEvent read FOnMouseOver write FOnMouseOver;
property OnMouseOut: TOnMouseOutEvent read FOnMouseOut write FOnMouseOut;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 2;
property NumGlyphsHot: TNumGlyphsHot read FNumGlyphsHot write SetNumGlyphsHot default 2;
property Glyph: TBitmap read FGlyph write SetGlyph;
property GlyphHot: TBitmap read FGlyphHot write SetGlyphHot;
property Layout: TLayout read FLayout write SetLayout default blGlyphLeft;
property ButtonStyle: TStyle read FStyle write SetStyle default stFlat;
property Cancel: Boolean read FCancel write FCancel default False;
property Default: Boolean read FDefault write SetDefault default False;
property HintSecondLine:string read GetHintTwo write SetHintTwo;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
Tibutton = class (ticustombutton)
published
property CursorHandCustom;
property ColorMarginLeftTop;
property ColorMarginRightBottom;
property ColorMarginStyle;
property PopupMenuMark;
property PopupMenuMarkGap;
property PositionPopup;
property PopupMenu;
property HotTrackColor;
property HotTrack;
property Spacing;
property SpacingLayout;
property OnMouseOver;
property OnMouseOut;
property NumGlyphs;
property NumGlyphsHot;
property Glyph;
property GlyphHot;
property Layout;
property ButtonStyle;
property Cancel;
property Default;
property HintSecondLine;
property Enabled;
property Caption;
property ParentFont;
property Font;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnStartDrag;
property ShowHint;
property ParentColor;
property Visible;
property Color;
property HelpContext;
property Align;
property OnContextPopup;
property Action;
property Anchors;
property Constraints;
property BiDiMode;
property ParentBiDiMode;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [Tibutton]);
end;
constructor ticustombutton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetBounds(0, 0, 75, 75);
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := clBtnHighLight;
FColorShadowPomocni := clBtnShadow;
FMouseInPos:=false;
FLayout:=blGlyphLeft;
Fx:=0;
FNumGlyphs :=2;
FNumGlyphsHot :=2;
FRavno:=0;
Fravno1:=1;
FStyle:=stnone;
Flayout:=blGlyphTop;
FSpacing:=4;
FMargin:=3;
Fslovo:=2;
FHotTrack:=True;
FHotTrackColor:=clBlue;
FPositionPopup:=puDown;
FMarkMenu:=False;
FMarkGap:=5;
FGlyph := TBitmap.Create;
FGlyphHot := TBitmap.Create;
FIspravniGlyph := TBitmap.Create;
FMonoBmp := TBitmap.Create;
FShowHandCursor :=True;
FShowFocused:=True;
FColorMarginDefault:=cmDefault;
end;
destructor ticustombutton.Destroy;
begin
FGlyph.Free;
FGlyphHot.Free;
FIspravniGlyph.Free;
FMonoBmp.free;
inherited Destroy;
end;
procedure ticustombutton.SetShowHandCursor(AShowHandCursor:boolean);
begin
FShowHandCursor:=AShowHandCursor;
end;
procedure ticustombutton.Click;
var q: TPoint;
Begin
if FPopupMenu = nil then exit;
if not enabled then exit;
Fslovo:=0;
IG:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:begin
inc(MainRect.left);
inc(MainRect.top);
dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_SUNKENOUTER,BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE);
end;
i:=1;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaisedrawFocus;
end;
DrawCaption;
///if FPopupMenu = nil then exit;
FPopupMenu.AutoPopup:= false;
q.X:= 0;
q.Y:= 0;
q:= ClientToScreen(q);
Case FPositionPopup of
puDown:begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X - 1, q.Y + Height);
end;
puRight:begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X+width+1, q.Y );
end;
puLeft:begin
FPopupMenu.Alignment:=paRight;
FPopupMenu.Popup(q.X-1, q.Y );
end;
end;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat,stNone,stFlatDot: Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,0);
stDefault,stFrameLowered,stFrameRaised: Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,1);
stRaised,stRaisedDot: Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,2);
end;
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:begin
inc(MainRect.left);
inc(MainRect.top);
dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
IG:=0;
DrawGlyph;
case FStyle of stDefault,stFrameLowered,stFrameRaised: DrawFocus;
end;
Fslovo:=1;
DrawCaption;
i:=0;
end;
procedure ticustombutton.SetMarkMenu(AMarkMenu: Boolean);
begin
FMarkMenu:=AMarkMenu;
Invalidate;
end;
procedure ticustombutton.SetMarkGap(value: TMarkGap);
begin
if value <> FMarkGap then
begin
FMarkGap := value;
Invalidate;
end;
end;
function ticustombutton.GetHintTwo: string;
begin
Result:=FHintTwo;
end;
procedure ticustombutton.SetHintTwo(AHintTwo:String);
begin
FHintTwo:=AHintTwo;
if csDesigning in ComponentState then
Exit;
if hint<>'' then
if FHintTwo<>'' then
hint:=hint+#13+FHintTwo else
hint:=hint;
end;
procedure ticustombutton.SetDefault(Value: Boolean);
begin
Fdefault:=value;
end;
procedure ticustombutton.DrawFocus;
begin
Case FStyle of stDefault,stFrameLowered,stFrameRaised:
begin
if FShowFocused then begin
if focused then
DrawFocusrect(Canvas.Handle,Rect(MainRect.left+3,MainRect.top+3,MainRect.Right-3,MainRect.bottom-3));
end ;
end;
end;
end;
procedure ticustombutton.CNCommand(var Message: TWMCommand);
begin
if Message.NotifyCode = BN_CLICKED then Click;
end;
procedure ticustombutton.SetPopupMenu(value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then
begin
Value.FreeNotification(Self);
Invalidate;
end;
end;
procedure ticustombutton.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FPopupMenu) then FPopupMenu := nil;
end;
procedure ticustombutton.SetHotTrack(AHotTrack:boolean);
begin
FHotTrack:=AHotTrack;
end;
procedure ticustombutton.SetHotTrackColor(AHotTrackColor:TColor);
begin
FHotTrackColor:=AHotTrackColor;
end;
procedure ticustombutton.SetSpacing(value:TSpacing);
begin
if value <> FSpacing then
begin
FSpacing := value;
Invalidate;
end;
end;
procedure ticustombutton.SetPositionPopup(value:TPositionPopup);
begin
if value <> FPositionPopup then
begin
FPositionPopup := value;
end;
end;
procedure ticustombutton.SetMargin(value:TMargin);
begin
if value <> FMargin then
begin
FMargin := value;
Invalidate;
end;
end;
procedure ticustombutton.PozicijaGlyph;
begin
with canvas do
begin
if (caption='') and (not FGlyph.empty) then
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
begin
if not FMarkMenu then
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG) else
Gde:= Rect(Xveliki+IG-5, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG-5, Yveliki+FispravniGlyph.Height+IG);
end;
end else
begin
case FLayout of
blGlyphLeft:
begin
Xveliki:=((MainRect.left+((MainRect.right-MainRect.left)- ((Ispravni.right-Ispravni.left)+(TextWidth(Caption))))div 2))-FMargin;
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphBottom:
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2)+ ((textheight(caption))div 2)+FMargin;
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphTop:
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2)- ((textheight(caption))div 2)-FMargin;
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphRight:
begin
Xveliki:=((MainRect.left+((MainRect.right-MainRect.left)- ((Ispravni.right-Ispravni.left)-(TextWidth(Caption))))div 2))+FMargin;
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
end;
end;
end;
end;
procedure ticustombutton.PozicijaMark;
begin
with canvas do
begin
if (not FGlyph.empty) then
Ymark:=(Gde.top+((Gde.bottom-Gde.top)- (MarkRect.bottom-MarkRect.top)) div 2);
Xmark:=(Gde.left+FispravniGlyph.Width)+FMarkGap;
GdeMark:=(Rect(Xmark,Ymark,(MarkRect.Right-MarkRect.Left)+Xmark,(MarkRect.bottom-MarkRect.top)+Ymark));
end;
end;
procedure ticustombutton.DrawMark;
var fmarkBoja:Tcolor;
begin
FMark := TBitmap.Create;
if Fglyph.Empty then Exit;
if not FMarkMenu then Exit;
if ((Flayout=blGlyphLeft) or (Flayout=blGlyphRight)) and (Caption>'') then Exit;
FMark.Handle := LoadBitmap(hInstance, 'Strela');
begin
if not enabled then
begin
MarkRect := Rect(0, 0, FMark.Width, FMark.Height);
Pozicijamark;
DrawDisabledBitmap(Canvas,GdeMark.left, GdeMark.top, FMark);
end
else
begin
FMarkboja:=FMark.Canvas.Pixels[0,FMark.Height-1];
MarkRect := Rect(0, 0, FMark.Width, FMark.Height);
Pozicijamark;
canvas.BrushCopy(GdeMark, FMark ,MarkRect, fMarkBoja);
Fmark.Free;
end;
end;
end;
procedure ticustombutton.DrawGlyph;
begin
if Fglyph.Empty then exit;
Secenje:=Rect(0,0,FGlyph.Width div FNumGlyphs,Fglyph.Height);
if (FNumGlyphs=2) and (not enabled) then
Secenje:=Rect(FGlyph.Width div FNumGlyphs,0,FGlyph.Width,Fglyph.Height);
Duplikat:=Rect(0,0,FGlyph.Width div FNumGlyphs,Fglyph.Height);
FIspravniGlyph.width:=FGlyph.Width div FNumGlyphs;
FIspravniGlyph.height:=FGlyph.height;
FispravniGlyph.Canvas.Copyrect(Duplikat,FGlyph.canvas,Secenje);
if (not enabled) and (FNumGlyphs<>2) then
begin
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
DrawDisabledBitmap(Canvas,gde.left, gde.top, FIspravniGlyph);
end else
begin
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
Fboja:=FispravniGlyph.Canvas.Pixels[0,FispravniGlyph.Height-1];
Canvas.BrushCopy(Gde,FispravniGlyph,Ispravni,FBoja);
end;
DrawMark;
end;
procedure ticustombutton.DrawDisabledBitmap(Canvas: TCanvas; x, y: Integer; bmp: TBitmap);
begin
FMonoBmp.Assign(bmp);
FMonobmp.Canvas.Brush.Color := clBlack;
FMonobmp.Monochrome := True;
Canvas.Brush.Color := clBtnHighlight;
SetTextColor(Canvas.Handle, clBlack);
SetBkColor(Canvas.Handle, clWhite);
BitBlt(Canvas.Handle, x+1, y+1, bmp.Width, bmp.Height,FMonobmp.Canvas.Handle, 0, 0, $00E20746);
Canvas.Brush.Color := clBtnShadow;
SetTextColor(Canvas.Handle, clBlack);
SetBkColor(Canvas.Handle, clWhite);
BitBlt(Canvas.Handle, x, y, bmp.Width, bmp.Height,FMonobmp.Canvas.Handle, 0, 0, $00E20746);
end;
procedure ticustombutton.DrawGlyphHot;
begin
if FglyphHot.Empty then exit;
Secenje:=Rect(0,0,FGlyphHot.Width div FNumGlyphsHot,FglyphHot.Height);
Duplikat:=Rect(0,0,FGlyphHot.Width div FNumGlyphsHot,FglyphHot.Height);
FIspravniGlyph.width:=FGlyphHot.Width div FNumGlyphsHot;
FIspravniGlyph.height:=FGlyphHot.height;
FispravniGlyph.Canvas.Copyrect(Duplikat,FGlyphHot.canvas,Secenje);
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
FbojaHot:=FispravniGlyph.Canvas.Pixels[0,FispravniGlyph.Height-1];
Canvas.BrushCopy(Gde,FispravniGlyph,Ispravni,FBojaHot);
DrawMark;
end;
procedure ticustombutton.pozijaCaption;
begin
with Canvas do
begin
if (caption<>'') and (FGlyph.empty) then
begin
xpromtext:=(MainRect.left+((MainRect.right-MainRect.left)-Textwidth(Caption)) div 2);
ypromtext:=(MainRect.top+((MainRect.bottom-MainRect.top)-TextHeight(Caption)) div 2);
CaptRect := Rect(Xpromtext+IG, Ypromtext+IG , Xpromtext+TextWidth(Caption)+IG, ypromtext+TextHeight(Caption)+IG);
end
else
begin
case FLayout of
blGlyphLeft:
begin
xpromtext:=gde.right+FSpacing;
ypromtext:=(gde.top+((gde.Bottom-gde.top)-textheight(caption)) div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphRight:
begin
xpromtext:= gde.left-textwidth(caption)-FSpacing;
ypromtext:=(gde.top+((gde.Bottom-gde.top)-textheight(caption)) div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphBottom:
begin
xpromtext:=gde.left-(Textwidth(Caption)div 2)+((gde.Right-gde.Left)div 2);
ypromtext:=gde.top-8-FSpacing-(TextHeight(Caption)div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphTop:
begin
xpromtext:=gde.left-(Textwidth(Caption)div 2)+((gde.Right-gde.Left)div 2);
ypromtext:=(gde.bottom+FSpacing);
CaptRect := Rect(Xpromtext, Ypromtext, Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
end;
end;
end;
end;
procedure ticustombutton.DrawCaption;
var
Farbica:TColor;
begin
with Canvas do
begin
Font.Assign(Self.Font);
farbica:=font.color;
if FHotTrack then
begin
if Fslovo=0 then font.color:=FHotTrackColor else font.color:=farbica;
end;
Brush.Style := bsClear;
pozijaCaption;
begin
if not Enabled then DrawCaptionEnabled;
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags ));
end;
end;
end;
procedure ticustombutton.DrawCaptionEnabled;
var ECaptRect:TRect;
begin
with canvas do
begin
Font := Self.Font;
brush.style:=bsClear;
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center ));
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags ));
font.Color :=clBtnHighlight;
ECaptRect:=Rect(CaptRect.Left+1,CaptRect.top+1,CaptRect.Right+1,CaptRect.Bottom+1);
DrawText(Handle, PChar(Caption), Length(Caption), ECaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags));
font.color :=clBtnShadow;
end;
end;
procedure ticustombutton.SetGlyph(value: TBitmap);
begin
if value <> FGlyph then
begin
FGlyph.Assign(value);
if not FGlyph.Empty then
begin
if Fglyph.width<Glyph.Height then
begin
FNumGlyphs:=1;
Invalidate;
end;
if FGlyph.Width div FGlyph.Height<2 then
begin
FNumGlyphs:=1;
Invalidate;
end;
if FGlyph.Width mod FGlyph.Height = 0 then
begin
FNumGlyphs := FGlyph.Width div FGlyph.Height;
if FNumGlyphs > 4 then FNumGlyphs := 1;
Invalidate
end;
end
else
Invalidate;
end;
end;
procedure ticustombutton.SetGlyphHot(value: TBitmap);
begin
if value <> FGlyphHot then
begin
FGlyphHot.Assign(value);
if not FGlyphHot.Empty then
begin
if FglyphHot.width<GlyphHot.Height then
begin
FNumGlyphsHot:=1;
Invalidate;
end;
if FGlyphHot.Width div FGlyphHot.Height<2 then
begin
FNumGlyphsHot:=1;
Invalidate;
end;
if FGlyphHot.Width mod FGlyphHot.Height = 0 then
begin
FNumGlyphsHot := FGlyphHot.Width div FGlyphHot.Height;
if FNumGlyphsHot > 4 then FNumGlyphsHot := 1;
Invalidate;
end;
end else
Invalidate;
end;
end;
procedure ticustombutton.SetColorMarginDefault(value:TColorMarginDefault);
begin
FColorMarginDefault := value;
if FColorMarginDefault=cmDefault then
begin
Case FStyle of
stFlat,stRaised,stFrameRaised,stFlatDot,stRaisedDot:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
stDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBlack;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := clBlack;
end;
stFrameLowered:
begin
FColorHighLight := clBtnShadow;
FColorShadow := clBtnHighLight;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
end;
end;
invalidate;
end;
procedure ticustombutton.SetColorPomocni(index: integer; value: TColor);
begin
case index of
1: if value <> FColorHighLightPomocni then
begin
FColorHighLightPomocni := value;
FColorHighLight :=FColorHighLightPomocni;
Case FStyle of
stRaisedDot,stFlat,stFrameRaised,stFlatDot,stRaised,stDefault:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorHighLightPomocni <> clBtnHighLight then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stFrameLowered:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorHighLightPomocni <> clBtnShadow then
FColorMarginDefault:=cmCustom;
end;
end;
end;
end;
Invalidate;
end;
2: if value <> FColorShadowPomocni then
begin
FColorShadowPomocni := value;
FColorShadow := FColorShadowPomocni;
Case FStyle of
stRaisedDot,stFlat,stFrameRaised,stFlatDot,stRaised:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBtnShadow then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stDefault:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBlack then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stFrameLowered:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBtnHighLight then
FColorMarginDefault:=cmCustom;
end;
end;
end;
end;
Invalidate;
end;
end;
end;
procedure ticustombutton.SetStyle(value: TStyle);
begin
begin
FStyle := value;
Case FStyle of
stFlat:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stNone:
begin
Fravno:=0;
Fravno1:=0;
end;
stRaised:
begin
Fravno:=2;
Fravno1:=2;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stDefault:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBlack;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := clBlack;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFrameRaised:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFrameLowered:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnShadow;
FColorShadow := clBtnHighLight;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFlatDot:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psDot;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stRaisedDot:
begin
Fravno:=2;
Fravno1:=2;
Canvas.pen.Style:=psDot;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
end;
Invalidate;
end;
end;
procedure ticustombutton.SetNumGlyphs(value: TNumGlyphs);
begin
if value <> FNumGlyphs then
begin
FNumGlyphs := value;
Invalidate;
end;
end;
procedure ticustombutton.SetNumGlyphsHot(value: TNumGlyphsHot);
begin
if value <> FNumGlyphsHot then
begin
FNumGlyphsHot := value;
Invalidate;
end;
end;
procedure ticustombutton.SetLayout(value: TLayout);
begin
if value <> FLayout then FLayout := value;
Invalidate;
end;
procedure ticustombutton.Paint;
begin
inherited Paint;
DC := Canvas.Handle;
if (FStyle=stFlat) or (FStyle=stFlatDot) then
begin
FRavno:=0;
if csDesigning in ComponentState then
FRavno:=1;
end;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,FRavno);
canvas.Brush.Style :=bsclear;//我加
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left);
inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
begin
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
end;
DrawGlyph;
case FStyle of
stDefault,stFrameLowered,stFrameRaised: DrawFocus;
end;
DrawCaption;
end;
procedure ticustombutton.CMMouseEnter(var AMsg: TMessage);
begin
if not Enabled then exit;
if Assigned(FOnMouseOver) then FOnMouseOver(Self);
FMouseInPos:=True;
IG:=0;
Fslovo:=0;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,Fravno1);//lk
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
i:=0;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
Fx:=0;
end;
procedure ticustombutton.CMMouseLeave(var AMsg: TMessage);
begin
if not Enabled then exit;
if Assigned(FOnMouseOut) then FOnMouseOut(Self);
FMouseInpos:=False;
IG:=0;
if FShowHandCursor then begin
Screen.Cursors[0] := crDefault;
Cursor := 0; end;
Fslovo:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,FRavno);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
DrawGlyph;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
{if TabStop then} DrawFocus;
end;
DrawCaption;
Fx:=1;
i:=0;
end;
procedure ticustombutton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Button<>mbleft then exit else begin
if not Enabled then exit;
if Fx=1 then exit;
end;
IG:=0;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
i:=0;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure ticustombutton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
q: TPoint;
Begin
if Button<>mbleft then exit else begin
if not enabled then exit;
Fslovo:=0;
IG:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_SUNKENOUTER,BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE);
end;
i:=1;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
if FPopupMenu = nil then exit;
FPopupMenu.AutoPopup:= false;
q.X:= 0;
q.Y:= 0;
q:= ClientToScreen(q);
Case FPositionPopup of
puDown:
begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X - 1, q.Y + Height);
end;
puRight:
begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X+width+1, q.Y );
end;
puLeft:
begin
FPopupMenu.Alignment:=paRight;
FPopupMenu.Popup(q.X-1, q.Y );
end;
end;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat,stNone,stFlatDot:
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,0);
stDefault,stFrameLowered,stFrameRaised:
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,1);
stRaised,stRaisedDot:
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,2);
end;
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
IG:=0;
DrawGlyph;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
Fslovo:=1;
DrawCaption;
i:=0;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure ticustombutton.WMLButtonDblClk (var Message: TWMLButtonDown);
begin
inherited;
Click;
end;
procedure ticustombutton.CmTextChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmVisibleChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmParentColorChanged(var Message: TWMNoParams);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CMColorChanged(var Message: TMessage);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CMSysColorChange(var Message: TMessage);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CmEnabledChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmParentFontChanged(var Message: TWMNoParams);
begin
inherited;
Canvas.Font.Assign(Self.Font);
Invalidate;
end;
end.
unit ibtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
,ExtCtrls,Menus,Buttons,StdCtrls;
type
TOnMouseOverEvent = procedure(Sender: TObject) of object;
TOnMouseOutEvent = procedure(Sender: TObject) of object;
TLayout=(blGlyphLeft,blGlyphBottom,blGlyphRight,blGlyphTop);
TNumGlyphs = 1..4;
TNumGlyphsHot = 1..4;
TSpacing = 1..5;
TMargin = -5..5;
TMarkGap = 1..5;
TPositionPopup = (puDown,puLeft,puRight);//菜单弹出的方向
TStyle = (stFlat,stDefault,stNone,stRaised,stFlatDot,//按钮外观
stRaisedDot,stFrameLowered,stFrameRaised);
TColorMarginDefault = (cmDefault,cmCustom);
ticustombutton = class(TGraphicControl)
private
MainRect,Secenje,Duplikat,Ispravni,Gde,CaptRect,MarkRect,GdeMark:Trect;
I,IG,Xpromtext,Ypromtext,Xveliki,Yveliki,Ymark,Xmark:integer;
DC: THandle;
BiDiFlags: Longint ;
FMarkGap:TMarkGap;
FSpacing:TSpacing;
FMargin:TMargin;
FStyle:TStyle;
FNumGlyphs:TNumGlyphs;
FNumGlyphsHot:TNumGlyphsHot;
FHintTwo:String;
FPositionPopup:TPositionPopup;
FPopupMenu: TPopupMenu;
FOnMouseOver: TOnMouseOverEvent;
FOnMouseOut: TOnMouseOutEvent;
FGlyph,FIspravniGlyph,FGlyphHot,FMonoBmp,Fmark:TBitmap;
FLayout:TLayout;
FMouseInPos,FHotTrack,FCancel,FDefault,FMarkMenu,FShowHandCursor,Focused,FShowFocused:boolean;
FColorMarginDefault:TColorMarginDefault;
Fx,FRavno,FRavno1,Fslovo:integer;
FBoja,FBojaHot,FHotTrackColor,FColorHighLight,FColorShadow,FColorHighLightPomocni,FColorShadowPomocni:TColor;
function GetHintTwo: string;
procedure DrawGlyph;
procedure DrawGlyphHot;
procedure PozicijaGlyph;
procedure DrawCaption;
procedure PozijaCaption;
procedure DrawMark;
procedure PozicijaMark;
procedure DrawFocus;
procedure DrawCaptionEnabled;
procedure SetShowHandCursor(AShowHandCursor:boolean);
procedure SetColorMarginDefault(value:TColorMarginDefault);
procedure SetColorPomocni(index: integer; value: TColor);
procedure SetHintTwo(AHintTwo: string);
procedure SetMarkGap(value:TMarkGap);
procedure SetDefault(Value: Boolean);
procedure SetMarkMenu(AMarkMenu: Boolean);
procedure SetPositionPopup(value:TPositionPopup);
procedure SetHotTrack(AHotTrack:Boolean);
procedure SetSpacing(value:TSpacing);
procedure SetMargin(value:TMargin);
procedure SetStyle(value:TStyle);
procedure SetNumGlyphs(value: TNumGlyphs);
procedure SetNumGlyphsHot(value: TNumGlyphsHot);
procedure SetGlyph(value: TBitmap);
procedure SetGlyphHot(value: TBitmap);
procedure SetHotTrackColor(AHotTrackColor: TColor);
procedure SetLayout(Value:TLayout);
procedure DrawDisabledBitmap(Canvas: TCanvas; x, y: Integer; bmp: TBitmap);
procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMMouseEnter(var AMsg: TMessage);message CM_MOUSEENTER;
procedure CMMouseLeave(var AMsg: TMessage);message CM_MOUSELEAVE;
procedure CmEnabledChanged(var Message: TWmNoParams); message CM_ENABLEDCHANGED;
procedure CmParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
procedure CmTextChanged(var Message: TWmNoParams); message CM_TEXTCHANGED;
procedure CmVisibleChanged(var Message: TWmNoParams); message CM_VISIBLECHANGED;
procedure CmParentFontChanged(var Message: TWMNoParams); message CM_FONTCHANGED;
procedure SetPopupMenu(value: TPopupMenu);
procedure CnCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDblClk (var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
protected
procedure Click;override;
procedure Paint;override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Notification(AComponent: TComponent; Operation: TOperation);override;
property CursorHandCustom:boolean read FShowHandCursor write SetShowHandCursor default True;
property ColorMarginLeftTop: TColor
index 1 read FColorHighLightPomocni write SetColorPomocni default clBtnHighLight;
property ColorMarginRightBottom: TColor
index 2 read FColorShadowPomocni write SetColorPomocni default clBtnShadow;
property ColorMarginStyle:TColorMarginDefault
read FColorMarginDefault write SetColorMarginDefault default cmDefault;
property PopupMenuMark:boolean read FMarkMenu write SetMarkMenu default False;
property PopupMenuMarkGap:TMarkGap read FMarkGap write SetMarkGap default 5;
property PositionPopup: TPositionPopup read FPositionPopup write SetPositionPopup default puDown;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property HotTrackColor:TColor read FHotTrackColor write SetHotTrackColor default clBlue;
property HotTrack:Boolean read FHotTrack write SetHotTrack default True;
property Spacing:TSpacing read FSpacing write SetSpacing default 4;
property SpacingLayout:TMargin read FMargin write SetMargin default 3;
property OnMouseOver: TOnMouseOverEvent read FOnMouseOver write FOnMouseOver;
property OnMouseOut: TOnMouseOutEvent read FOnMouseOut write FOnMouseOut;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 2;
property NumGlyphsHot: TNumGlyphsHot read FNumGlyphsHot write SetNumGlyphsHot default 2;
property Glyph: TBitmap read FGlyph write SetGlyph;
property GlyphHot: TBitmap read FGlyphHot write SetGlyphHot;
property Layout: TLayout read FLayout write SetLayout default blGlyphLeft;
property ButtonStyle: TStyle read FStyle write SetStyle default stFlat;
property Cancel: Boolean read FCancel write FCancel default False;
property Default: Boolean read FDefault write SetDefault default False;
property HintSecondLine:string read GetHintTwo write SetHintTwo;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
Tibutton = class (ticustombutton)
published
property CursorHandCustom;
property ColorMarginLeftTop;
property ColorMarginRightBottom;
property ColorMarginStyle;
property PopupMenuMark;
property PopupMenuMarkGap;
property PositionPopup;
property PopupMenu;
property HotTrackColor;
property HotTrack;
property Spacing;
property SpacingLayout;
property OnMouseOver;
property OnMouseOut;
property NumGlyphs;
property NumGlyphsHot;
property Glyph;
property GlyphHot;
property Layout;
property ButtonStyle;
property Cancel;
property Default;
property HintSecondLine;
property Enabled;
property Caption;
property ParentFont;
property Font;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnStartDrag;
property ShowHint;
property ParentColor;
property Visible;
property Color;
property HelpContext;
property Align;
property OnContextPopup;
property Action;
property Anchors;
property Constraints;
property BiDiMode;
property ParentBiDiMode;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [Tibutton]);
end;
constructor ticustombutton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetBounds(0, 0, 75, 75);
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := clBtnHighLight;
FColorShadowPomocni := clBtnShadow;
FMouseInPos:=false;
FLayout:=blGlyphLeft;
Fx:=0;
FNumGlyphs :=2;
FNumGlyphsHot :=2;
FRavno:=0;
Fravno1:=1;
FStyle:=stnone;
Flayout:=blGlyphTop;
FSpacing:=4;
FMargin:=3;
Fslovo:=2;
FHotTrack:=True;
FHotTrackColor:=clBlue;
FPositionPopup:=puDown;
FMarkMenu:=False;
FMarkGap:=5;
FGlyph := TBitmap.Create;
FGlyphHot := TBitmap.Create;
FIspravniGlyph := TBitmap.Create;
FMonoBmp := TBitmap.Create;
FShowHandCursor :=True;
FShowFocused:=True;
FColorMarginDefault:=cmDefault;
end;
destructor ticustombutton.Destroy;
begin
FGlyph.Free;
FGlyphHot.Free;
FIspravniGlyph.Free;
FMonoBmp.free;
inherited Destroy;
end;
procedure ticustombutton.SetShowHandCursor(AShowHandCursor:boolean);
begin
FShowHandCursor:=AShowHandCursor;
end;
procedure ticustombutton.Click;
var q: TPoint;
Begin
if FPopupMenu = nil then exit;
if not enabled then exit;
Fslovo:=0;
IG:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:begin
inc(MainRect.left);
inc(MainRect.top);
dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_SUNKENOUTER,BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE);
end;
i:=1;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaisedrawFocus;
end;
DrawCaption;
///if FPopupMenu = nil then exit;
FPopupMenu.AutoPopup:= false;
q.X:= 0;
q.Y:= 0;
q:= ClientToScreen(q);
Case FPositionPopup of
puDown:begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X - 1, q.Y + Height);
end;
puRight:begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X+width+1, q.Y );
end;
puLeft:begin
FPopupMenu.Alignment:=paRight;
FPopupMenu.Popup(q.X-1, q.Y );
end;
end;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat,stNone,stFlatDot: Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,0);
stDefault,stFrameLowered,stFrameRaised: Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,1);
stRaised,stRaisedDot: Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,2);
end;
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:begin
inc(MainRect.left);
inc(MainRect.top);
dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
IG:=0;
DrawGlyph;
case FStyle of stDefault,stFrameLowered,stFrameRaised: DrawFocus;
end;
Fslovo:=1;
DrawCaption;
i:=0;
end;
procedure ticustombutton.SetMarkMenu(AMarkMenu: Boolean);
begin
FMarkMenu:=AMarkMenu;
Invalidate;
end;
procedure ticustombutton.SetMarkGap(value: TMarkGap);
begin
if value <> FMarkGap then
begin
FMarkGap := value;
Invalidate;
end;
end;
function ticustombutton.GetHintTwo: string;
begin
Result:=FHintTwo;
end;
procedure ticustombutton.SetHintTwo(AHintTwo:String);
begin
FHintTwo:=AHintTwo;
if csDesigning in ComponentState then
Exit;
if hint<>'' then
if FHintTwo<>'' then
hint:=hint+#13+FHintTwo else
hint:=hint;
end;
procedure ticustombutton.SetDefault(Value: Boolean);
begin
Fdefault:=value;
end;
procedure ticustombutton.DrawFocus;
begin
Case FStyle of stDefault,stFrameLowered,stFrameRaised:
begin
if FShowFocused then begin
if focused then
DrawFocusrect(Canvas.Handle,Rect(MainRect.left+3,MainRect.top+3,MainRect.Right-3,MainRect.bottom-3));
end ;
end;
end;
end;
procedure ticustombutton.CNCommand(var Message: TWMCommand);
begin
if Message.NotifyCode = BN_CLICKED then Click;
end;
procedure ticustombutton.SetPopupMenu(value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then
begin
Value.FreeNotification(Self);
Invalidate;
end;
end;
procedure ticustombutton.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FPopupMenu) then FPopupMenu := nil;
end;
procedure ticustombutton.SetHotTrack(AHotTrack:boolean);
begin
FHotTrack:=AHotTrack;
end;
procedure ticustombutton.SetHotTrackColor(AHotTrackColor:TColor);
begin
FHotTrackColor:=AHotTrackColor;
end;
procedure ticustombutton.SetSpacing(value:TSpacing);
begin
if value <> FSpacing then
begin
FSpacing := value;
Invalidate;
end;
end;
procedure ticustombutton.SetPositionPopup(value:TPositionPopup);
begin
if value <> FPositionPopup then
begin
FPositionPopup := value;
end;
end;
procedure ticustombutton.SetMargin(value:TMargin);
begin
if value <> FMargin then
begin
FMargin := value;
Invalidate;
end;
end;
procedure ticustombutton.PozicijaGlyph;
begin
with canvas do
begin
if (caption='') and (not FGlyph.empty) then
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
begin
if not FMarkMenu then
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG) else
Gde:= Rect(Xveliki+IG-5, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG-5, Yveliki+FispravniGlyph.Height+IG);
end;
end else
begin
case FLayout of
blGlyphLeft:
begin
Xveliki:=((MainRect.left+((MainRect.right-MainRect.left)- ((Ispravni.right-Ispravni.left)+(TextWidth(Caption))))div 2))-FMargin;
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphBottom:
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2)+ ((textheight(caption))div 2)+FMargin;
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphTop:
begin
Xveliki:=(MainRect.left+((MainRect.right-MainRect.left)- (Ispravni.right-Ispravni.left)) div 2);
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2)- ((textheight(caption))div 2)-FMargin;
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
blGlyphRight:
begin
Xveliki:=((MainRect.left+((MainRect.right-MainRect.left)- ((Ispravni.right-Ispravni.left)-(TextWidth(Caption))))div 2))+FMargin;
Yveliki:=(MainRect.top+((MainRect.bottom-MainRect.top)- (Ispravni.bottom-Ispravni.top)) div 2);
Gde:= Rect(Xveliki+IG, Yveliki+IG, Xveliki+FispravniGlyph.Width+IG, Yveliki+FispravniGlyph.Height+IG);
end;
end;
end;
end;
end;
procedure ticustombutton.PozicijaMark;
begin
with canvas do
begin
if (not FGlyph.empty) then
Ymark:=(Gde.top+((Gde.bottom-Gde.top)- (MarkRect.bottom-MarkRect.top)) div 2);
Xmark:=(Gde.left+FispravniGlyph.Width)+FMarkGap;
GdeMark:=(Rect(Xmark,Ymark,(MarkRect.Right-MarkRect.Left)+Xmark,(MarkRect.bottom-MarkRect.top)+Ymark));
end;
end;
procedure ticustombutton.DrawMark;
var fmarkBoja:Tcolor;
begin
FMark := TBitmap.Create;
if Fglyph.Empty then Exit;
if not FMarkMenu then Exit;
if ((Flayout=blGlyphLeft) or (Flayout=blGlyphRight)) and (Caption>'') then Exit;
FMark.Handle := LoadBitmap(hInstance, 'Strela');
begin
if not enabled then
begin
MarkRect := Rect(0, 0, FMark.Width, FMark.Height);
Pozicijamark;
DrawDisabledBitmap(Canvas,GdeMark.left, GdeMark.top, FMark);
end
else
begin
FMarkboja:=FMark.Canvas.Pixels[0,FMark.Height-1];
MarkRect := Rect(0, 0, FMark.Width, FMark.Height);
Pozicijamark;
canvas.BrushCopy(GdeMark, FMark ,MarkRect, fMarkBoja);
Fmark.Free;
end;
end;
end;
procedure ticustombutton.DrawGlyph;
begin
if Fglyph.Empty then exit;
Secenje:=Rect(0,0,FGlyph.Width div FNumGlyphs,Fglyph.Height);
if (FNumGlyphs=2) and (not enabled) then
Secenje:=Rect(FGlyph.Width div FNumGlyphs,0,FGlyph.Width,Fglyph.Height);
Duplikat:=Rect(0,0,FGlyph.Width div FNumGlyphs,Fglyph.Height);
FIspravniGlyph.width:=FGlyph.Width div FNumGlyphs;
FIspravniGlyph.height:=FGlyph.height;
FispravniGlyph.Canvas.Copyrect(Duplikat,FGlyph.canvas,Secenje);
if (not enabled) and (FNumGlyphs<>2) then
begin
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
DrawDisabledBitmap(Canvas,gde.left, gde.top, FIspravniGlyph);
end else
begin
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
Fboja:=FispravniGlyph.Canvas.Pixels[0,FispravniGlyph.Height-1];
Canvas.BrushCopy(Gde,FispravniGlyph,Ispravni,FBoja);
end;
DrawMark;
end;
procedure ticustombutton.DrawDisabledBitmap(Canvas: TCanvas; x, y: Integer; bmp: TBitmap);
begin
FMonoBmp.Assign(bmp);
FMonobmp.Canvas.Brush.Color := clBlack;
FMonobmp.Monochrome := True;
Canvas.Brush.Color := clBtnHighlight;
SetTextColor(Canvas.Handle, clBlack);
SetBkColor(Canvas.Handle, clWhite);
BitBlt(Canvas.Handle, x+1, y+1, bmp.Width, bmp.Height,FMonobmp.Canvas.Handle, 0, 0, $00E20746);
Canvas.Brush.Color := clBtnShadow;
SetTextColor(Canvas.Handle, clBlack);
SetBkColor(Canvas.Handle, clWhite);
BitBlt(Canvas.Handle, x, y, bmp.Width, bmp.Height,FMonobmp.Canvas.Handle, 0, 0, $00E20746);
end;
procedure ticustombutton.DrawGlyphHot;
begin
if FglyphHot.Empty then exit;
Secenje:=Rect(0,0,FGlyphHot.Width div FNumGlyphsHot,FglyphHot.Height);
Duplikat:=Rect(0,0,FGlyphHot.Width div FNumGlyphsHot,FglyphHot.Height);
FIspravniGlyph.width:=FGlyphHot.Width div FNumGlyphsHot;
FIspravniGlyph.height:=FGlyphHot.height;
FispravniGlyph.Canvas.Copyrect(Duplikat,FGlyphHot.canvas,Secenje);
Ispravni:=Rect(0,0,FIspravniGlyph.width,FIspravniGlyph.height);
PozicijaGlyph;
FbojaHot:=FispravniGlyph.Canvas.Pixels[0,FispravniGlyph.Height-1];
Canvas.BrushCopy(Gde,FispravniGlyph,Ispravni,FBojaHot);
DrawMark;
end;
procedure ticustombutton.pozijaCaption;
begin
with Canvas do
begin
if (caption<>'') and (FGlyph.empty) then
begin
xpromtext:=(MainRect.left+((MainRect.right-MainRect.left)-Textwidth(Caption)) div 2);
ypromtext:=(MainRect.top+((MainRect.bottom-MainRect.top)-TextHeight(Caption)) div 2);
CaptRect := Rect(Xpromtext+IG, Ypromtext+IG , Xpromtext+TextWidth(Caption)+IG, ypromtext+TextHeight(Caption)+IG);
end
else
begin
case FLayout of
blGlyphLeft:
begin
xpromtext:=gde.right+FSpacing;
ypromtext:=(gde.top+((gde.Bottom-gde.top)-textheight(caption)) div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphRight:
begin
xpromtext:= gde.left-textwidth(caption)-FSpacing;
ypromtext:=(gde.top+((gde.Bottom-gde.top)-textheight(caption)) div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphBottom:
begin
xpromtext:=gde.left-(Textwidth(Caption)div 2)+((gde.Right-gde.Left)div 2);
ypromtext:=gde.top-8-FSpacing-(TextHeight(Caption)div 2);
CaptRect := Rect(Xpromtext, Ypromtext , Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
blGlyphTop:
begin
xpromtext:=gde.left-(Textwidth(Caption)div 2)+((gde.Right-gde.Left)div 2);
ypromtext:=(gde.bottom+FSpacing);
CaptRect := Rect(Xpromtext, Ypromtext, Xpromtext+TextWidth(Caption), ypromtext+TextHeight(Caption));
end;
end;
end;
end;
end;
procedure ticustombutton.DrawCaption;
var
Farbica:TColor;
begin
with Canvas do
begin
Font.Assign(Self.Font);
farbica:=font.color;
if FHotTrack then
begin
if Fslovo=0 then font.color:=FHotTrackColor else font.color:=farbica;
end;
Brush.Style := bsClear;
pozijaCaption;
begin
if not Enabled then DrawCaptionEnabled;
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags ));
end;
end;
end;
procedure ticustombutton.DrawCaptionEnabled;
var ECaptRect:TRect;
begin
with canvas do
begin
Font := Self.Font;
brush.style:=bsClear;
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center ));
DrawText(Handle, PChar(Caption), Length(Caption), CaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags ));
font.Color :=clBtnHighlight;
ECaptRect:=Rect(CaptRect.Left+1,CaptRect.top+1,CaptRect.Right+1,CaptRect.Bottom+1);
DrawText(Handle, PChar(Caption), Length(Caption), ECaptRect, (DT_EXPANDTABS or DT_center or BiDiFlags));
font.color :=clBtnShadow;
end;
end;
procedure ticustombutton.SetGlyph(value: TBitmap);
begin
if value <> FGlyph then
begin
FGlyph.Assign(value);
if not FGlyph.Empty then
begin
if Fglyph.width<Glyph.Height then
begin
FNumGlyphs:=1;
Invalidate;
end;
if FGlyph.Width div FGlyph.Height<2 then
begin
FNumGlyphs:=1;
Invalidate;
end;
if FGlyph.Width mod FGlyph.Height = 0 then
begin
FNumGlyphs := FGlyph.Width div FGlyph.Height;
if FNumGlyphs > 4 then FNumGlyphs := 1;
Invalidate
end;
end
else
Invalidate;
end;
end;
procedure ticustombutton.SetGlyphHot(value: TBitmap);
begin
if value <> FGlyphHot then
begin
FGlyphHot.Assign(value);
if not FGlyphHot.Empty then
begin
if FglyphHot.width<GlyphHot.Height then
begin
FNumGlyphsHot:=1;
Invalidate;
end;
if FGlyphHot.Width div FGlyphHot.Height<2 then
begin
FNumGlyphsHot:=1;
Invalidate;
end;
if FGlyphHot.Width mod FGlyphHot.Height = 0 then
begin
FNumGlyphsHot := FGlyphHot.Width div FGlyphHot.Height;
if FNumGlyphsHot > 4 then FNumGlyphsHot := 1;
Invalidate;
end;
end else
Invalidate;
end;
end;
procedure ticustombutton.SetColorMarginDefault(value:TColorMarginDefault);
begin
FColorMarginDefault := value;
if FColorMarginDefault=cmDefault then
begin
Case FStyle of
stFlat,stRaised,stFrameRaised,stFlatDot,stRaisedDot:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
stDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBlack;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := clBlack;
end;
stFrameLowered:
begin
FColorHighLight := clBtnShadow;
FColorShadow := clBtnHighLight;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
end;
end;
invalidate;
end;
procedure ticustombutton.SetColorPomocni(index: integer; value: TColor);
begin
case index of
1: if value <> FColorHighLightPomocni then
begin
FColorHighLightPomocni := value;
FColorHighLight :=FColorHighLightPomocni;
Case FStyle of
stRaisedDot,stFlat,stFrameRaised,stFlatDot,stRaised,stDefault:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorHighLightPomocni <> clBtnHighLight then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stFrameLowered:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorHighLightPomocni <> clBtnShadow then
FColorMarginDefault:=cmCustom;
end;
end;
end;
end;
Invalidate;
end;
2: if value <> FColorShadowPomocni then
begin
FColorShadowPomocni := value;
FColorShadow := FColorShadowPomocni;
Case FStyle of
stRaisedDot,stFlat,stFrameRaised,stFlatDot,stRaised:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBtnShadow then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stDefault:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBlack then
FColorMarginDefault:=cmCustom;
end;
end;
end;
stFrameLowered:
begin
Case FColorMarginDefault of cmDefault:
begin
if FColorShadowPomocni <> clBtnHighLight then
FColorMarginDefault:=cmCustom;
end;
end;
end;
end;
Invalidate;
end;
end;
end;
procedure ticustombutton.SetStyle(value: TStyle);
begin
begin
FStyle := value;
Case FStyle of
stFlat:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stNone:
begin
Fravno:=0;
Fravno1:=0;
end;
stRaised:
begin
Fravno:=2;
Fravno1:=2;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stDefault:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBlack;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := clBlack;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFrameRaised:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFrameLowered:
begin
ParentColor:=False;
Color:=clBtnface;
Fravno:=1;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnShadow;
FColorShadow := clBtnHighLight;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stFlatDot:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psDot;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
stRaisedDot:
begin
Fravno:=2;
Fravno1:=2;
Canvas.pen.Style:=psDot;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
end;
Invalidate;
end;
end;
procedure ticustombutton.SetNumGlyphs(value: TNumGlyphs);
begin
if value <> FNumGlyphs then
begin
FNumGlyphs := value;
Invalidate;
end;
end;
procedure ticustombutton.SetNumGlyphsHot(value: TNumGlyphsHot);
begin
if value <> FNumGlyphsHot then
begin
FNumGlyphsHot := value;
Invalidate;
end;
end;
procedure ticustombutton.SetLayout(value: TLayout);
begin
if value <> FLayout then FLayout := value;
Invalidate;
end;
procedure ticustombutton.Paint;
begin
inherited Paint;
DC := Canvas.Handle;
if (FStyle=stFlat) or (FStyle=stFlatDot) then
begin
FRavno:=0;
if csDesigning in ComponentState then
FRavno:=1;
end;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,FRavno);
canvas.Brush.Style :=bsclear;//我加
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left);
inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
begin
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
end;
DrawGlyph;
case FStyle of
stDefault,stFrameLowered,stFrameRaised: DrawFocus;
end;
DrawCaption;
end;
procedure ticustombutton.CMMouseEnter(var AMsg: TMessage);
begin
if not Enabled then exit;
if Assigned(FOnMouseOver) then FOnMouseOver(Self);
FMouseInPos:=True;
IG:=0;
Fslovo:=0;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat:
begin
Fravno:=0;
Fravno1:=1;
Canvas.pen.Style:=psSolid;
Case FColorMarginDefault of
cmDefault:
begin
FColorHighLight := clBtnHighLight;
FColorShadow := clBtnShadow;
FColorHighLightPomocni := FColorHighLight;
FColorShadowPomocni := FColorShadow;
end;
cmCustom:
begin
FColorHighLight := FColorHighLightPomocni;
FColorShadow := FColorShadowPomocni;
end;
end;
end;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,Fravno1);//lk
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
i:=0;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
Fx:=0;
end;
procedure ticustombutton.CMMouseLeave(var AMsg: TMessage);
begin
if not Enabled then exit;
if Assigned(FOnMouseOut) then FOnMouseOut(Self);
FMouseInpos:=False;
IG:=0;
if FShowHandCursor then begin
Screen.Cursors[0] := crDefault;
Cursor := 0; end;
Fslovo:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,FRavno);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
DrawGlyph;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
{if TabStop then} DrawFocus;
end;
DrawCaption;
Fx:=1;
i:=0;
end;
procedure ticustombutton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Button<>mbleft then exit else begin
if not Enabled then exit;
if Fx=1 then exit;
end;
IG:=0;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorHighLight,FColorShadow,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right); dec(MainRect.bottom);
end;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
i:=0;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure ticustombutton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
q: TPoint;
Begin
if Button<>mbleft then exit else begin
if not enabled then exit;
Fslovo:=0;
IG:=1;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,Fravno1);
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_SUNKENOUTER,BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE);
end;
i:=1;
if (FGlyphHot.empty)then DrawGlyph;
if (not FGlyphHot.empty)and (not FGlyph.empty) then
begin
if not enabled then
DrawGlyph else DrawGlyphHot;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
DrawCaption;
if FPopupMenu = nil then exit;
FPopupMenu.AutoPopup:= false;
q.X:= 0;
q.Y:= 0;
q:= ClientToScreen(q);
Case FPositionPopup of
puDown:
begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X - 1, q.Y + Height);
end;
puRight:
begin
FPopupMenu.Alignment:=paLeft;
FPopupMenu.Popup(q.X+width+1, q.Y );
end;
puLeft:
begin
FPopupMenu.Alignment:=paRight;
FPopupMenu.Popup(q.X-1, q.Y );
end;
end;
DC := Canvas.Handle;
MainRect:=clientRect;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
Canvas.brush.color:=clBtnFace;
stFlat,stNone,stRaised,stFlatDot,stRaisedDot:
Canvas.brush.color:=color;
end;
Case FStyle of
stFlat,stNone,stFlatDot:
Frame3d(Canvas, MainRect, FColorShadow,FColorHighLight,0);
stDefault,stFrameLowered,stFrameRaised:
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,1);
stRaised,stRaisedDot:
Frame3d(Canvas, MainRect,FColorHighLight ,FColorShadow,2);
end;
canvas.Brush.Style :=bsclear;
Canvas.FillRect(MainRect);
case FStyle of
stFrameRaised:
begin
inc(MainRect.left); inc(MainRect.top);dec(MainRect.right);
dec(MainRect.bottom);
end;
end;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawEdge(DC, MainRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_TOPLEFT or BF_MIDDLE );
end;
IG:=0;
DrawGlyph;
case FStyle of
stDefault,stFrameLowered,stFrameRaised:
DrawFocus;
end;
Fslovo:=1;
DrawCaption;
i:=0;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure ticustombutton.WMLButtonDblClk (var Message: TWMLButtonDown);
begin
inherited;
Click;
end;
procedure ticustombutton.CmTextChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmVisibleChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmParentColorChanged(var Message: TWMNoParams);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CMColorChanged(var Message: TMessage);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CMSysColorChange(var Message: TMessage);
begin
inherited;
case FStyle of stDefault,stFrameLowered,stFrameRaised: Color :=clBtnFace; end;
if ParentColor then
Invalidate;
end;
procedure ticustombutton.CmEnabledChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;
procedure ticustombutton.CmParentFontChanged(var Message: TWMNoParams);
begin
inherited;
Canvas.Font.Assign(Self.Font);
Invalidate;
end;
end.