📄 newabelsoft.pas
字号:
unit NewabelSoft;
interface
uses
Messages, Windows, SysUtils, CommCtrl, Classes, Controls, Forms,
Menus, Graphics, StdCtrls, RichEdit, ToolWin, dbctrls, Db,
Buttons,Extctrls,ShellAPI, ComCtrls,variants; //GetDate,
const
WM_TRAYNOTIFY = WM_USER + 1100;
WM_RESETTOOLTIP = WM_USER + 1101;
NIIF_NONE = $00000000;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIF_INFO = $00000010;
var
WM_TASKBARCREATED: Cardinal;
type
TDirection=(adLeftRight,adLeftToRight,adRightToLeft,adTopBottom,adTopToBottom,adBottomToTop);
TArrow = class(TGraphicControl)
private
{ Private declarations }
FDirection:TDirection;
FColor:TColor;
FShadowThick:Integer;
procedure SetDirection(Value:TDirection);
procedure SetColor(Value:TColor);
procedure SetShadowThick(Value:Integer);
protected
{ Protected declarations }
procedure WMSize(var Message:TWmSize);message WM_SIZE;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent ); override;
destructor Destroy;override;
published
property Direction:TDirection read FDirection write SetDirection;
property Color:TColor read FColor write SetColor;
property ShadowThick:Integer read FShadowThick write SetShadowThick default 2;
end;
TMouseEnter = procedure(Sender: TObject) of object;
TMouseLeave = procedure(Sender: TObject) of object;
TTextLayout =(tlLeft, tlRight, tlTop, tlBottom,tlCenter);
TTextStyle =(tsNone,tsRaised,tsLowered);
TImageBtn = class(TGraphicControl)
private
FFlat:Boolean;
FFocused:Boolean;
FDownOffSet:integer;
FPushDown:Boolean;
FPicture:TPicture;
FMouseOnPic:TPicture;
FPushDownPic:TPicture;
FFocusePic:TPicture;
FEnter:boolean;
FColor:TColor;
FFocuseColor:TColor;
FMouseOnColor:TColor;
FPushDownColor:TColor;
FTransparentColor:TColor;
FLabelWidth:Integer;
FLabelHeight:Integer;
FLabelTop:Integer;
FLabelLeft:Integer;
FImageWidth:Integer;
FImageHeight:Integer;
FImageTop:Integer;
FImageLeft:Integer;
FUseBorder:Boolean;
FTextLayout:TTextLayout;
FTextStyle:TTextStyle;
FSpacing: Integer;
FLeftOffSet:integer;
FTopOffSet:integer;
FTransparent: Boolean;
FEnabled:Boolean;
FOnMouseEnter:TMouseEnter;
FOnMouseLeave:TMouseLeave;
procedure SetPicture( Value : TPicture );
procedure SetMouseOnPic( Value : TPicture );
procedure SetPushDownPic(Value : TPicture );
procedure SetFocusePic(Value : TPicture );
procedure SetCaption(var Message:TMessage);message CM_TEXTCHANGED;
procedure SetFont(var Message:TMessage);message CM_FONTCHANGED;
procedure SetEnabled(var Message:TMessage);messaGe CM_ENABLEDCHANGED;
procedure SetColor(Value:TColor);
procedure SetFocuseColor(Value:TColor);
procedure SetMouseOnColor(Value:TColor);
procedure SetPushDownColor(Value:TColor);
procedure SetTransparentColor(Value:TColor);
procedure SetFocused(Value:Boolean);
procedure SetUseBorder(Value:Boolean);
procedure SetTextLayout(Value:TTextLayout);
procedure SetTextStyle(Value:TTextStyle);
procedure SetSpacing(Value:Integer);
procedure SetLeftOffSet(Value:Integer);
procedure SetTopOffSet(Value:Integer);
procedure SetTransparent(Value:Boolean);
procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:integer);override;
procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:integer);override;
procedure SetFlat(Value:Boolean);
protected
procedure WMMouseEnter( var Msg : TWMMouse ); message CM_MOUSEENTER;
procedure WMMouseLeave( var Msg : TWMMouse ); message CM_MOUSELEAVE;
procedure WMSize(var Message:TWmSize);message WM_SIZE;
public
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
published
property Action;
property AutoSize;
property Flat:Boolean read FFlat write SetFlat;
property Font;
property FocuseColor:TColor read FFocuseColor write SetFocuseColor;
property Color:TColor read FColor write SetColor;
property MouseOnColor:TColor read FMouseOnColor write SetMouseOnColor;
property PushDownColor:TColor read FPushDownColor write SetPushDownColor;
property Caption;
property Enabled;
property PopupMenu;
property Picture:TPicture read FPicture write SetPicture;
property MouseOnPic:TPicture read FMouseOnPic write SetMouseOnPic;
property PushDownPic:TPicture read FPushDownPic write SetPushDownPic;
property FocusePic:TPicture read FFocusePic write SetFocusePic;
property Focused:Boolean read FFocused write SetFocused;
property DownOffSet:integer read FDownOffSet write FDownOffSet;
property TextLayout:TTextLayout read FTextLayout write SetTextLayout;
property TextStyle:TTextStyle read FTextStyle write SetTextStyle;
property UseBorder:Boolean read FUseBorder write SetUseBorder;
property Spacing:integer read FSpacing write SetSpacing;
property LeftOffSet:integer read FLeftOffSet write SetLeftOffSet;
property TopOffSet:integer read FTopOffSet write SetTopOffSet;
property Transparent:Boolean read FTransparent write SetTransparent;
property TransparentColor:TColor read FTransparentColor write SetTransparentColor;
property Tag;
property OnClick;
property ParentFont;
property parentShowHint;
property Hint;
property ShowHint;
property Visible;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter:TMouseEnter read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:TMouseLeave read FOnMouseLeave write FOnMouseLeave;
end;
TDateEdit = class(TComboBox)
private
procedure OnBtnClick(Sender:TObject);
procedure OnEditKeyPress(Sender: TObject; var Key: Char);
procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ShowHint;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnExit;
property OnChange;
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
property OnDropDown;
end;
TDBDateEdit = class(TComboBox)
private
FDataLink:TFieldDataLink;
FDate:TDateTime;
function GetDataField: string;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
procedure OnBtnClick(Sender:TObject);
procedure OnEditKeyPress(Sender: TObject; var Key: Char);
procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Datasource : TDataSource read GetDatasource write SetDatasource;
property DataField: string read GetDataField write SetDataField;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ShowHint;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnExit;
property OnChange;
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
end;
TIDChangeEvent = procedure(Sender: TObject) of object;
TSelectKeyID = class(TComboBox)
private
FKeyType:integer;
FIntKeyID:integer;
FStrKeyID:string;
FShowSelect:string;
FOnIDChange:TIDChangeEvent;
procedure SetShowSelect(Value:string);
procedure OnShowSelect(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure SetIntKeyID(Value:integer);
procedure SetStrKeyID(Value:string);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property IntKeyID:integer read FIntKeyID write SetIntKeyID;
property StrKeyID:string read FStrKeyID write SetStrKeyID;
property KeyType:integer read FKeyType write FKeyType;
property ShowSelect:string read FShowSelect write SetShowSelect;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ShowHint;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnExit;
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
property OnDropDown;
property OnIDChange: TIDChangeEvent read FOnIDChange write FOnIDChange;
end;
TKeyIDCombo = class(TComboBox)
private
FKeyType:integer;
FIntKeyID:integer;
FStrKeyID:string;
protected
public
KeyIDList:TStringList;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetIntKeyID(Value:integer);
procedure SetStrKeyID(Value:string);
function ReadIntKeyID(var Value:integer):Boolean;
function ReadStrKeyID(var Value:string):Boolean;
published
property KeyType:integer read FKeyType write FKeyType;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ShowHint;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnExit;
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
property OnDropDown;
end;
TNotifyIconDataEx = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array[0..127] of AnsiChar; // 0..63 of WideChar in stead?
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array[0..255] of AnsiChar;
uTimeout: UINT; // union with uVersion: UINT;
szInfoTitle: array[0..63] of AnsiChar;
dwInfoFlags: DWORD;
end;
TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
TBalloonHintTimeOut = 10..60; // Windows defines 10-60 secs. as min-max
TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
TTrayIcon = class(TComponent)
private
FEnabled: Boolean;
FIcon: TIcon;
FIconVisible: Boolean;
FHint: String;
FShowHint: Boolean;
FPopupMenu: TPopupMenu;
FLeftPopup: Boolean;
FOnClick,
FOnDblClick: TNotifyEvent;
FOnCycle: TCycleEvent;
FOnMouseDown,
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FStartMinimized: Boolean;
FMinimizeToTray: Boolean;
FClickStart: Boolean;
CycleTimer: TTimer; // For icon cycling
FIconIndex: Integer; // Current index in imagelist
FDesignPreview: Boolean;
SettingPreview: Boolean; // Internal status flag
SettingMDIForm: Boolean; // Internal status flag
FIconList: TImageList;
FCycleIcons: Boolean;
FCycleInterval: Cardinal;
OldAppProc, NewAppProc: Pointer; // Procedure variables
OldWndProc, NewWndProc: Pointer; // Procedure variables
FWindowHandle: HWND; // Window handle (not general handle)
procedure SetDesignPreview(Value: Boolean);
procedure SetCycleIcons(Value: Boolean);
procedure SetCycleInterval(Value: Cardinal);
procedure TimerCycle(Sender: TObject);
procedure HandleIconMessage(var Msg: TMessage);
function InitIcon: Boolean;
procedure SetIcon(Value: TIcon);
procedure SetIconVisible(Value: Boolean);
procedure SetIconList(Value: TImageList);
procedure SetIconIndex(Value: Integer);
procedure SetHint(Value: String);
procedure SetShowHint(Value: Boolean);
procedure PopupAtCursor;
// Hook methods
procedure HookApp;
procedure UnhookApp;
procedure HookAppProc(var Msg: TMessage);
procedure HookForm;
procedure UnhookForm;
procedure HookFormProc(var Msg: TMessage);
protected
IconData: TNotifyIconDataEx; // Data of the tray icon wnd.
procedure Loaded; override;
function LoadDefaultIcon: Boolean; virtual;
function ShowIcon: Boolean; virtual;
function HideIcon: Boolean; virtual;
function ModifyIcon: Boolean; virtual;
procedure Click; dynamic;
procedure DblClick; dynamic;
procedure CycleIcon; dynamic;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); dynamic;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); dynamic;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
procedure DoMinimizeToTray; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
{$IFDEF DFS_CPPB_3_UP}
property Handle: HWND read IconData.hWnd;
{$ELSE}
property Handle: HWND read IconData.Wnd;
{$ENDIF}
property WindowHandle: HWND read FWindowHandle;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Refresh: Boolean;
function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;TimeoutSecs: TBalloonHintTimeOut): Boolean;
function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;MaskColor: TColor): Boolean;
//----- SPECIAL: methods that only apply when owner is a form -----
procedure ShowMainForm;
procedure HideMainForm;
//----- END SPECIAL -----
published
// Properties:
property DesignPreview: Boolean read FDesignPreview write SetDesignPreview default False;
property IconList: TImageList read FIconList write SetIconList;
property CycleIcons: Boolean read FCycleIcons write SetCycleIcons default False;
property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval;
property Enabled: Boolean read FEnabled write FEnabled default True;
property Hint: String read FHint write SetHint;
property ShowHint: Boolean read FShowHint write SetShowHint default True;
property Icon: TIcon read FIcon write SetIcon stored True;
property IconVisible: Boolean read FIconVisible write SetIconVisible default True;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
//----- SPECIAL: properties that only apply when owner is a form -----
property StartMinimized: Boolean read FStartMinimized write FStartMinimized default False; // Main form minimized on app. start-up?
property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray default False; // Minimize main form to tray when minimizing?
//----- END SPECIAL -----
// Events:
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
end;
type
TBorder = (boNone, boSingle, boRaised, boLowered);
TBlink = (blNone, blBlink, blHiLo);
TDyLabel = class(TLabel)
private
FTimer : TTimer;
FHiColor, { used when "Blink" is blHiLo }
FLoColor, { used when "Blink" is blHiLo }
FFontColor : TColor; { save old font color }
FCtl3D : boolean; { use 3D effects when true }
FDeep : byte; { Shadow deep }
FBorder : TBorder;
FInterval : integer; { Blink interval in miliseconds }
FBlink : TBlink;
FShadowColor : TColor;
procedure SetDeep(Value: byte);
procedure SetInterval(Value: integer);
procedure SetBlink(Value: TBlink);
procedure SetShadowColor(Value: TColor);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -