Mega Code Archive
EasyToolBarButtons
<![CDATA[
Title: EasyToolBarButtons
Question: This article contains the unit EasyToolBarButtons. This unit contains the buttons used by the SymantecMenu and the OfficeToolBar.
NOTE!
You need the other posts to be able to compile this components.
You must disable the Compiled Resources (*.dcr) to compile this components. I'll send the dcr's to the admins and tell them to attach them.
Answer:
Unit EasyToolBarButtons;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus;
Type
TEasyToolBarButton = Class(TGraphicControl)
Private
{ Private declarations }
fImages : TImageList;
fImageIndex : Integer;
GotMouse : Boolean;
fAlignment : TAlignment;
fBitmap : TBitmap;
fDown : Boolean;
PopupLastShown : TDateTime;
fShowingPopupMenu : Boolean;
Function CanUseBitmap : Boolean;
Procedure VerifyMousePosition;
Procedure SetBitmap(NewBitmap: TBitmap);
Procedure SetImages(NewImages: TImageList);
Procedure SetImageIndex(NewIndex: Integer);
Function _GetPopupMenu: TPopupMenu;
Procedure _SetPopupMenu(NewPopupMenu: TPopupMenu);
Procedure SetAlignment(NewAlignment: TAlignment);
Procedure SetDown(NewDown: Boolean);
Protected
{ Protected declarations }
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Procedure Resize; override;
Procedure CMEnabledChanged(var msg: TMessage); message CM_ENABLEDCHANGED;
Procedure CMShowHintChanged(var msg: TMessage); message CM_SHOWHINTCHANGED;
Procedure CMTextChanged(var msg: TMessage); message CM_TEXTCHANGED;
Procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
Procedure CMChanged(var Message: TMessage); message CM_CHANGED;
Public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure UpdateSize;
Procedure AdjustSize; override;
Procedure Paint; override;
Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
Procedure Click; override;
Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
Published
{ Published declarations }
Property Bitmap: TBitmap read fBitmap write SetBitmap;
Property Images: TImageList read fImages write SetImages;
Property ImageIndex: Integer read fImageIndex write SetImageIndex;
Property Caption;
Property Alignment: TAlignment read fAlignment write SetAlignment;
Property PopupMenu: TPopupMenu read _GetPopupMenu write _SetPopupMenu;
Property AutoSize;
Property Enabled;
Property ShowHint;
Property Visible;
Property Align;
Property Anchors;
Property Down: Boolean read fDown write SetDown;
Property OnMouseDown;
Property OnClick;
Property OnMouseUp;
End;
Procedure Register;
Implementation
Uses EasySymantecMenu, EasyToolBar, EasyGraphicsFunctions;
{$R *.dcr}
Procedure Register;
Begin
RegisterComponents('EasyWare - Visual', [TEasyToolBarButton]);
End;
Const
mncDarkBlue = TColor($6A240A);
mncButtonFocus = TColor($D2BDB6);
MinButtonSize = 24;
Constructor TEasyToolBarButton.Create(AOwner: TComponent);
Begin
Inherited;
ControlStyle := ControlStyle + [{csOpaque, }csFixedWidth, csFixedHeight];
ControlStyle := ControlStyle - [csSetCaption];
fImages := NIL;
fImageIndex := 0;
GotMouse := False;
fAlignment := taCenter;
AutoSize := False;
Caption := '';
fDown := False;
fBitmap := TBitmap.Create;
Width := 24;
Height := 24;
fShowingPopupMenu := False;
PopupLastShown := 0;
End;
Destructor TEasyToolBarButton.Destroy;
Begin
IF (Assigned(fBitmap)) Then fBitmap.Free;
IF (Parent is TEasySymantecMenu) Then (Parent as TEasySymantecMenu).RepositionButtons;
Inherited;
End;
Procedure TEasyToolBarButton.Notification(AComponent: TComponent; Operation: TOperation);
Begin
Inherited Notification(AComponent, Operation);
IF (AComponent = Images) and (Operation = opRemove) Then Images := NIL;
End;
Procedure TEasyToolBarButton.SetBitmap(NewBitmap: TBitmap);
Begin
fBitmap.Assign(NewBitmap);
Resize;
Invalidate;
End;
Procedure TEasyToolBarButton.SetImages(NewImages: TImageList);
Begin
fImages := NewImages;
Resize;
Invalidate;
End;
Procedure TEasyToolBarButton.SetImageIndex(NewIndex: Integer);
Begin
IF (NewIndex fImageIndex) Then
Begin
fImageIndex := NewIndex;
Invalidate;
End;
End;
Function TEasyToolBarButton._GetPopupMenu: TPopupMenu;
Begin
Result := Inherited PopupMenu;
End;
Procedure TEasyToolBarButton._SetPopupMenu(NewPopupMenu: TPopupMenu);
Begin
Inherited PopupMenu := NewPopupMenu;
UpdateSize;
Invalidate;
End;
Procedure TEasyToolBarButton.SetAlignment(NewAlignment: TAlignment);
Begin
IF (fAlignment NewAlignment) Then
Begin
fAlignment := NewAlignment;
Invalidate;
End;
End;
Procedure TEasyToolBarButton.SetDown(NewDown: Boolean);
Begin
IF (fDown NewDown) Then
Begin
fDown := NewDown;
Invalidate;
End;
End;
Procedure TEasyToolBarButton.CMMouseEnter(var msg: TMessage);
Begin
GotMouse := True;
IF (Enabled) Then Repaint;
End;
Procedure TEasyToolBarButton.CMMouseLeave(var msg: TMessage);
Begin
GotMouse := False;
IF (Enabled) Then Repaint;
End;
Procedure TEasyToolBarButton.CMChanged(var Message: TMessage);
Begin
Inherited;
UpdateSize;
Invalidate;
End;
Procedure TEasyToolBarButton.CMEnabledChanged(var msg: TMessage);
Begin
Inherited;
Invalidate;
End;
Procedure TEasyToolBarButton.CMShowHintChanged(var msg: TMessage);
Begin
Inherited;
Invalidate;
End;
Procedure TEasyToolBarButton.CMTextChanged(var msg: TMessage);
Begin
Inherited;
UpdateSize;
Invalidate;
End;
Procedure TEasyToolBarButton.UpdateSize;
Var
ImgList : TImageList;
W, H : Integer;
TW, CH : Integer;
Begin
ImgList := NIL;
IF (Parent is TEasySymantecMenu) Then ImgList := (Parent as TEasySymantecMenu).Images;
IF (Parent is TEasyToolBar) Then ImgList := (Parent as TEasyToolBar).Images;
IF (not Assigned(ImgList)) Then ImgList := Images;
IF (CanUseBitmap) Then
Begin
W := fBitmap.Width;
H := fBitmap.Height;
End
Else
IF (Assigned(ImgList)) Then
Begin
W := ImgList.Width;
H := ImgList.Height;
End
Else
Begin
W := 16;
H := 16;
End;
Canvas.Font.Assign( Font );
IF (Parent is TEasySymantecMenu) Then
Begin
IF (Align alNone) Then Exit;
IF (Parent is TEasySymantecMenu) Then
Begin
W := W + 4;
H := H + 4;
IF (W IF (H End
Else
Begin
W := W + Canvas.TextWidth(Caption) + 4;
End;
Width := W;
Height := H;
End
Else
IF (AutoSize) and (Align alClient) Then
Begin
TW := W + 4;
IF (Caption '') Then W := TW + Canvas.TextWidth(Caption) + 8
Else W := TW + 4;
IF (Assigned(PopupMenu)) Then W := W + 13;
H := 4 + H + 4;
CH := Canvas.TextHeight(Caption) + 4;
IF (CH H) Then H := Ch;
IF (Align alTop) and (Align alBottom) Then Width := W;
IF (Align alLeft) and (Align alRight) Then Height := H;
End;
End;
Procedure TEasyToolBarButton.AdjustSize;
Begin
Inherited;
UpdateSize;
End;
Procedure TEasyToolBarButton.Resize;
Begin
UpdateSize;
IF (Parent is TEasySymantecMenu) Then (Parent as TEasySymantecMenu).RepositionButtons;
End;
Function TEasyToolBarButton.CanUseBitmap : Boolean;
Begin
Result := False;
IF (Assigned(fBitmap)) Then
Begin
IF (not fBitmap.Empty) Then Result := True;
End;
End;
Procedure TEasyToolBarButton.VerifyMousePosition;
Var
P : TPoint;
Inside : Boolean;
Begin
P := ScreenToClient(Mouse.CursorPos);
Inside := PtInRect(ClientRect, P);
IF (GotMouse) Then
Begin
IF (not Inside) Then
Begin
GotMouse := False;
IF (Enabled) Then Repaint;
End;
End
Else
Begin
IF (Inside) Then
Begin
GotMouse := True;
IF (Enabled) Then Repaint;
End;
End;
End;
Procedure TEasyToolBarButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
P : TPoint;
Begin
Inherited MouseDown(Button, Shift, X, Y);
IF (Assigned(PopupMenu)) and (Button = mbLeft) Then
Begin
IF (X = ClientWidth-13) Then
Begin
IF (Now PopupLastShown+(1/24/60/60/4)) or (PopupLastShown = 0) Then
Begin
fShowingPopupMenu := True;
Invalidate;
VerifyMousePosition;
P := ClientToScreen(Point(0, ClientHeight-1));
IF (Button = mbRight) Then PopupMenu.TrackButton := tbRightButton
Else PopupMenu.TrackButton := tbLeftButton;
PopupMenu.Popup(P.x, P.y);
VerifyMousePosition;
PopupLastShown := Now;
fShowingPopupMenu := False;
Invalidate;
End;
End;
End;
ReleaseCapture;
End;
Procedure TEasyToolBarButton.Click;
Var
P : TPoint;
X : Integer;
Begin
P := ScreenToClient(Mouse.CursorPos);
X := P.X;
IF (Assigned(PopupMenu)) Then
Begin
IF (X = ClientWidth-13) Then
Begin
IF (Now Begin
Exit;
End;
End;
End;
Inherited Click;
End;
Procedure TEasyToolBarButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
Inherited MouseUp(Button, Shift, X, Y);
VerifyMousePosition;
End;
Procedure TEasyToolBarButton.Paint;
Var
ImgList : TImageList;
X, Y : Integer;
Bmp : TBitmap;
CW : Integer;
TW : Integer;
SC, EC : TColor;
Begin
// Inherited;
ImgList := NIL;
IF (Parent is TEasySymantecMenu) Then ImgList := (Parent as TEasySymantecMenu).Images;
IF (Parent is TEasyToolBar) Then ImgList := (Parent as TEasyToolBar).Images;
IF (not Assigned(ImgList)) Then ImgList := Images;
Canvas.Font.Assign( Font );
IF (GotMouse or fDown) and (Enabled) Then
Begin
IF (Caption '') or (CanUseBitmap) or ((Assigned(ImgList)) and (fImageIndex = 0)) Then
Begin
IF (Parent is TEasyToolBar) Then
Begin
IF (GotMouse) and (fDown) Then
Begin
SC := RGB(254, 145, 78);
EC := RGB(255, 211, 142);
End
Else
IF (GotMouse) Then
Begin
SC := RGB(255, 244, 204);
EC := RGB(255, 208, 145);
End
Else
// IF (fDown) Then
Begin
SC := RGB(255, 213, 140);
EC := RGB(255, 173, 85);
End;
IF (not fShowingPopupMenu) Then
Begin
// Draw an orange faded bar...
DrawFadedBar(
Canvas,
Rect(1, 1, ClientWidth-1, ClientHeight-2),
False,
SC,
EC
);
// ***
End;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := mncDarkBlue;
Canvas.Rectangle(ClientRect);
End
Else
// IF (Parent is TEasySymantecMenu) Then
Begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := mncButtonFocus;
Canvas.Pen.Color := mncDarkBlue;
Canvas.Rectangle(ClientRect);
End;
End;
End;
CW := ClientWidth;
IF (Assigned(PopupMenu)) Then CW := CW - 13;
X := 0;
IF (CanUseBitmap) or ((Assigned(ImgList)) and (fImageIndex = 0)) Then
Begin
IF (CanUseBitmap) Then
Begin
Bmp := TBitmap.Create;
Bmp.Assign(fBitmap);
End
Else
Begin
Bmp := GetBitmap(ImgList, fImageIndex, Enabled, GotMouse);
End;
IF (Parent is TEasySymantecMenu) Then
Begin
// We don't draw any caption, so don't make any space for it...
X := (CW div 2) - (Bmp.Width div 2) + 1;
Y := (ClientHeight div 2) - (Bmp.Height div 2) + 1;
End
Else
Begin
TW := Bmp.Width;
IF (Caption '') Then TW := TW + Canvas.TextWidth(Caption) + 4;
Case Alignment of
taLeftJustify : X := 2;
taCenter : X := (CW div 2) - (TW div 2) + 1;
taRightJustify : X := CW - TW;
End;
Y := (ClientHeight div 2) - (Bmp.Height div 2) + 1;
End;
IF (X
IF (GotMouse) and (not (Parent is TEasyToolBar)) Then
Begin
Dec(X, 2);
Dec(Y, 2);
End;
Canvas.Draw(X, Y, Bmp);
Inc(X, Bmp.Width+4);
Bmp.Free;
End
Else
Begin
IF (csDesigning in ComponentState) Then
Begin
Canvas.DrawFocusRect(ClientRect);
End;
TW := 0;
IF (Caption '') Then TW := Canvas.TextWidth(Caption);
Case Alignment of
taLeftJustify : X := 4;
taCenter : X := (CW div 2) - (TW div 2) + 1;
taRightJustify : X := CW - TW;
End;
End;
IF (not (Parent is TEasySymantecMenu)) Then
Begin
IF (Caption '') Then
Begin
Y := (ClientHeight div 2) - (Canvas.TextHeight(Caption) div 2) - 1;
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := clBlack;
Canvas.TextRect(Rect(1, 1, CW-2, ClientHeight-2), X, Y, Caption);
Canvas.Brush.Style := bsSolid;
End;
IF (Assigned(PopupMenu)) Then
Begin
Y := (ClientHeight div 2) - 1;
X := ClientWidth - 9;
Canvas.Pen.Color := clBlack;
Canvas.MoveTo(X, Y);
Canvas.LineTo(X+5, Y);
// ***
Canvas.MoveTo(X+1, Y+1);
Canvas.LineTo(X+4, Y+1);
// ***
Canvas.MoveTo(X+2, Y+2);
Canvas.LineTo(X+3, Y+2);
IF (GotMouse) or (fDown) Then
Begin
IF (not fShowingPopupMenu) then
Begin
Canvas.Pen.Color := mncDarkBlue;
Canvas.MoveTo(X-3, 0);
Canvas.LineTo(X-3, ClientHeight);
End;
End;
End;
End;
End;
End.
]]>