📄 fthbtns.pas
字号:
{*******************************************************}
{ }
{ 4th GUI Library for Delphi }
{ Buttons Unit }
{ }
{ Copyright (c) 1996,2001 Sergey S. Tkachenko }
{ e-mail: tkachenko@360.com.ua }
{ Web: www.4thfebruary.f2s.com }
{ }
{*******************************************************}
unit FthBtns;
{$I FTHVER.INC}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
ExtCtrls;
type
TFourthStandardButtonSeparatorStyle = (ssVertLines, ssRectangle);
TFourthStandardButtonOptions = class(TPersistent)
private
FAlignment: TAlignment;
FBackgroundColor: TColor;
FDisabledFont: TFont;
FDrawLeftLine: Boolean;
FDrawRightLine: Boolean;
FFont: TFont;
FHotTrackCursor: TCursor;
FHotTrackFont: TFont;
FLevel1LightColor: TColor;
FLevel1ShadowColor: TColor;
FLevel2LightColor: TColor;
FLevel2ShadowColor: TColor;
FLevel3Color: TColor;
FOnChange: TNotifyEvent;
FSeparatorStyle: TFourthStandardButtonSeparatorStyle;
FTransparent: Boolean;
FVertLineColor: TColor;
procedure SetAlignment(Value: TAlignment);
procedure SetBackgroundColor(Value: TColor);
procedure SetDisabledFont(Value: TFont);
procedure SetDrawLeftLine(Value: Boolean);
procedure SetDrawRightLine(Value: Boolean);
procedure SetFont(Value: TFont);
procedure SetHotTrackCursor(Value: TCursor);
procedure SetHotTrackFont(Value: TFont);
procedure SetLevel1LightColor(Value: TColor);
procedure SetLevel1ShadowColor(Value: TColor);
procedure SetLevel2LightColor(Value: TColor);
procedure SetLevel2ShadowColor(Value: TColor);
procedure SetLevel3Color(Value: TColor);
procedure SetSeparatorStyle(Value: TFourthStandardButtonSeparatorStyle);
procedure SetTransparent(Value: Boolean);
procedure SetVertLineColor(Value: TColor);
protected
property OnChange: TNotifyEvent read FOnChange write FOnChange;
procedure FontChanged(Sender: TObject);
public
constructor Create;
published
property Alignment: TAlignment read FAlignment write SetAlignment;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
property DrawLeftLine: Boolean read FDrawLeftLine write SetDrawLeftLine;
property DrawRightLine: Boolean read FDrawRightLine write SetDrawRightLine;
property Font: TFont read FFont write SetFont;
property HotTrackCursor: TCursor read FHotTrackCursor write SetHotTrackCursor;
property HotTrackFont: TFont read FHotTrackFont write SetHotTrackFont;
property Level1LightColor: TColor read FLevel1LightColor write SetLevel1LightColor;
property Level1ShadowColor: TColor read FLevel1ShadowColor write SetLevel1ShadowColor;
property Level2LightColor: TColor read FLevel2LightColor write SetLevel2LightColor;
property Level2ShadowColor: TColor read FLevel2ShadowColor write SetLevel2ShadowColor;
property Level3Color: TColor read FLevel3Color write SetLevel3Color;
property SeparatorStyle: TFourthStandardButtonSeparatorStyle read FSeparatorStyle write SetSeparatorStyle;
property Transparent: Boolean read FTransparent write SetTransparent;
property VertLineColor: TColor read FVertLineColor write SetVertLineColor;
end;
TFourthStandardButtonState = (bsUp, bsDisabled, bsDown);
TFourthStandardButton = class(TCustomControl)
private
FCaption: TCaption;
FDragging: Boolean;
FDropMenu: TPopupMenu;
FModalResult: TModalResult;
FMouseInControl: Boolean;
FOldCursor: TCursor;
FOptions: TFourthStandardButtonOptions;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
procedure SetCaption(Value: TCaption);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
FState: TFourthStandardButtonState;
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure OptionsChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure Click; override;
published
{$IFDEF FCL_D4}
property Action;
{$ENDIF}
property Align;
{$IFDEF FCL_D4}
property Anchors;
{$ENDIF}
property Caption: TCaption read FCaption write SetCaption;
property Cursor;
property DragCursor;
{$IFDEF FCL_D4}
property DragKind;
{$ENDIF}
property DragMode;
property DropDownMenu: TPopupMenu read FDropMenu write FDropMenu;
property Enabled;
property Height;
property Left;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property Options: TFourthStandardButtonOptions read FOptions write FOptions;
property ParentShowHint;
property Name;
property ShowHint;
property Top;
property Tag;
property Visible;
property Width;
{$IFDEF FCL_D4}
property OnCanResize;
{$ENDIF}
property OnClick;
{$IFDEF FCL_D4}
property OnConstrainedResize;
{$ENDIF}
{$IFDEF FCL_D5}
property OnContextPopup;
{$ENDIF}
property OnDblClick;
property OnDragDrop;
property OnDragOver;
{$IFDEF FCL_D4}
property OnEndDock;
{$ENDIF}
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseMove;
property OnMouseUp;
{$IFDEF FCL_D4}
property OnResize;
property OnStartDock;
{$ENDIF}
property OnStartDrag;
end;
implementation
{ TFourthStandardButtonOptions }
constructor TFourthStandardButtonOptions.Create;
begin
FAlignment := taCenter;
FBackgroundColor := cl3DDkShadow;
FDisabledFont := TFont.Create;
FDisabledFont.Color := clBtnShadow;
FDisabledFont.OnChange := FontChanged;
FFont := TFont.Create;
FFont.Color := clBtnHighlight;
FFont.OnChange := FontChanged;
FHotTrackCursor := crDefault;
FHotTrackFont := TFont.Create;
FHotTrackFont.Color := clBtnText;
FHotTrackFont.OnChange := FontChanged;
FLevel1LightColor := cl3DLight;
FLevel1ShadowColor := cl3DDkShadow;
FLevel2LightColor := clBtnHighlight;
FLevel2ShadowColor := clBtnShadow;
FLevel3Color := clBtnFace;
FDrawLeftLine := True;
FDrawRightLine := True;
FSeparatorStyle := ssVertLines;
FTransparent := False;
FVertLineColor := clBtnFace;
end;
procedure TFourthStandardButtonOptions.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetBackgroundColor(Value: TColor);
begin
if FBackgroundColor <> Value then
begin
FBackgroundColor := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetDisabledFont(Value: TFont);
begin
if FDisabledFont <> Value then
begin
FDisabledFont.Assign(Value);
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetDrawLeftLine(Value: Boolean);
begin
if FDrawLeftLine <> Value then
begin
FDrawLeftLine := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetDrawRightLine(Value: Boolean);
begin
if FDrawRightLine <> Value then
begin
FDrawRightLine := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetFont(Value: TFont);
begin
if FFont <> Value then
begin
FFont.Assign(Value);
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetHotTrackCursor(Value: TCursor);
begin
if FHotTrackCursor <> Value then
begin
FHotTrackCursor := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetHotTrackFont(Value: TFont);
begin
if FHotTrackFont <> Value then
begin
FHotTrackFont.Assign(Value);
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetLevel1LightColor(Value: TColor);
begin
if FLevel1LightColor <> Value then
begin
FLevel1LightColor := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetLevel1ShadowColor(Value: TColor);
begin
if FLevel1ShadowColor <> Value then
begin
FLevel1ShadowColor := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetLevel2LightColor(Value: TColor);
begin
if FLevel2LightColor <> Value then
begin
FLevel2LightColor := Value;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TFourthStandardButtonOptions.SetLevel2ShadowColor(Value: TColor);
begin
if FLevel2ShadowColor <> Value then
begin
FLevel2ShadowColor := Value;
if Assigned(FOnChange) then FOnChange(Self);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -