You've already forked lazarus-ccr
TRxSpeedButton and TRxClock
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@353 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
@ -27,6 +27,7 @@
|
|||||||
+ In RxDBGrid create editor for field with type ftDate, ftDateTime - based on TRxDateEdit
|
+ In RxDBGrid create editor for field with type ftDate, ftDateTime - based on TRxDateEdit
|
||||||
(see Demos/RxDBGrid)
|
(see Demos/RxDBGrid)
|
||||||
- minor fix in filter combobox in RxDBGrid for GTK and GTK2
|
- minor fix in filter combobox in RxDBGrid for GTK and GTK2
|
||||||
|
+ TRxSpeedButton and TRxClock
|
||||||
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
||||||
+ In RxDBgrid - after close dataset list of SelectedRows is cleared
|
+ In RxDBgrid - after close dataset list of SelectedRows is cleared
|
||||||
+ fix resaizing find form for RxDbGrd
|
+ fix resaizing find form for RxDbGrd
|
||||||
|
|||||||
@ -32,6 +32,7 @@
|
|||||||
+ � RxDBGrid ���������� �������� ��� ����� ���� ftDate, ftDateTime �� ������� TRxDateEdit
|
+ � RxDBGrid ���������� �������� ��� ����� ���� ftDate, ftDateTime �� ������� TRxDateEdit
|
||||||
(��. Demos/RxDBGrid)
|
(��. Demos/RxDBGrid)
|
||||||
+ ��������� ���������� � RxDBGrid ��� GTK � GTK2
|
+ ��������� ���������� � RxDBGrid ��� GTK � GTK2
|
||||||
|
+ ���������� ���������� TRxSpeedButton � TRxClock
|
||||||
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
||||||
+ � RxDBGrid ����� �������� ������ ������ ������ ���������� ����� (SelectedRows)
|
+ � RxDBGrid ����� �������� ������ ������ ������ ���������� ����� (SelectedRows)
|
||||||
���������
|
���������
|
||||||
|
|||||||
BIN
components/rx/images/TRxClock.bmp
Normal file
BIN
components/rx/images/TRxClock.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 406 B |
BIN
components/rx/images/TRxSpeedButton.bmp
Normal file
BIN
components/rx/images/TRxSpeedButton.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 406 B |
@ -1,2 +1,2 @@
|
|||||||
del rx.lrs
|
del rx.lrs
|
||||||
C:\lazarus\tools\lazres.exe rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.bmp
|
C:\lazarus\tools\lazres.exe rx.lrs TDBDateEdit.xpm TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm trxxpmanifest.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.bmp TRxClock.bmp TRxSpeedButton.bmp
|
||||||
|
|||||||
@ -173,6 +173,7 @@ type
|
|||||||
procedure AutoSizeForm;
|
procedure AutoSizeForm;
|
||||||
property Date:TDateTime read GetDate write SetDate;
|
property Date:TDateTime read GetDate write SetDate;
|
||||||
property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
|
property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
|
||||||
|
property Calendar: TCustomRxCalendar read FCalendar;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TSelectDateDlg }
|
{ TSelectDateDlg }
|
||||||
@ -286,11 +287,11 @@ end;
|
|||||||
{ TRxTimerSpeedButton }
|
{ TRxTimerSpeedButton }
|
||||||
|
|
||||||
type
|
type
|
||||||
TRxTimerSpeedButton = class(TSpeedButton)
|
TRxTimerSpeedButton = class(TRxSpeedButton)
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
published
|
||||||
// property AllowTimer default True;
|
property AllowTimer default True;
|
||||||
// property Style default bsWin31;
|
// property Style default bsWin31;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -298,7 +299,7 @@ constructor TRxTimerSpeedButton.Create(AOwner: TComponent);
|
|||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
// Style := bsWin31;
|
// Style := bsWin31;
|
||||||
// AllowTimer := True;
|
AllowTimer := True;
|
||||||
ControlStyle := ControlStyle + [csReplicatable];
|
ControlStyle := ControlStyle + [csReplicatable];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|||||||
@ -5,6 +5,8 @@
|
|||||||
{$DEFINE HASVARIANT}
|
{$DEFINE HASVARIANT}
|
||||||
{.$DEFINE ENABLE_Child_Defs}
|
{.$DEFINE ENABLE_Child_Defs}
|
||||||
{$DEFINE NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID}
|
{$DEFINE NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID}
|
||||||
{$DEFINE RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT}
|
{.$DEFINE RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT}
|
||||||
{.$DEFINE USED_BiDi}
|
{.$DEFINE USED_BiDi}
|
||||||
{$DEFINE DEFAULT_POPUP_CALENDAR}
|
{$DEFINE DEFAULT_POPUP_CALENDAR}
|
||||||
|
|
||||||
|
{.$DEFINE FIX_BUG_FieldNo}
|
||||||
|
|||||||
@ -315,3 +315,36 @@ LazarusResources.Add('TRxDateEdit','BMP',[
|
|||||||
+#15#255#255#255#255#248#248#136#135#143'37'#15#255#255#255#255#248#255#255
|
+#15#255#255#255#255#248#248#136#135#143'37'#15#255#255#255#255#248#255#255
|
||||||
+#255#143'37'#0#0#0#0#0#0#0#0#0#15'37wwwwwwwwww3333333333333'
|
+#255#143'37'#0#0#0#0#0#0#0#0#0#15'37wwwwwwwwww3333333333333'
|
||||||
]);
|
]);
|
||||||
|
LazarusResources.Add('TRxClock','BMP',[
|
||||||
|
'BM'#150#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#4#0#0#0#0#0' '
|
||||||
|
+#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
|
||||||
|
+#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'3333333'
|
||||||
|
+'3333333333333333333'#0'333330'#3'3333'#0#3'0'#0#0'3'#0#3'33330'#0#8#136#136
|
||||||
|
+#0#0'333333'#8#136#128#136#136#3'333330'#136#136#128#136#136#128'33333'#8#136
|
||||||
|
+#8#136#136#8#136#3'3333'#8#136#136#136#136#136#136#3'3330'#136#8#136#136#128
|
||||||
|
+#136#8#128'3330'#136#136#136#136#8#136#136#128'3330'#128#8#136#128#136#136#0
|
||||||
|
+#128'3330'#136#136#136#128#136#136#136#128'3330'#136#8#136#128#136#136#8#128
|
||||||
|
+'3333'#8#136#136#128#136#136#136#3'3333'#8#136#8#136#136#8#136#3'3330'#0#136
|
||||||
|
+#136#128#136#136#128#0'333'#9#153#8#136#128#136#136#9#153#3'33'#9#153#0#8#136
|
||||||
|
+#136#0#9#153#3'330'#153#3'0'#0#0'3'#9#144'3333'#0'333330'#3'3333333333333333'
|
||||||
|
+'3333333333333333333333'
|
||||||
|
]);
|
||||||
|
LazarusResources.Add('TRxSpeedButton','BMP',[
|
||||||
|
'BM'#150#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#4#0#0#0#0#0' '
|
||||||
|
+#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
|
||||||
|
+#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
|
||||||
|
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'3333333'
|
||||||
|
+'333333'#0#0#0#0#0#0#0#0#0#0'37wwwwwwwwww'#3'7'#248#136#136#136#136#136#136
|
||||||
|
+#136#136#135#3'7'#248#128#8#136#136#136#136#136#136#135#3'7'#248#7'p'#8#136
|
||||||
|
+#136#136#136#136#135#3'7'#248#8#247'p'#204#204#199#136#136#135#3'7'#248''
|
||||||
|
+#143'w'#12#204#204#200#136#135#3'7'#248#135#247#247'p'#196#196#199#136#135#3
|
||||||
|
+'7'#248#136'w'#0#0'L'#136#135#3'7'#248#136#199#247#247#135'p'#196#136#135#3
|
||||||
|
+'7'#248#136'L'#248'x'#25#132#136#135#3'7'#248#136#196#199#248#241#153#159
|
||||||
|
+#136#135#3'7'#248#136'DG'#255#31#249#152#136#135#3'7'#248#136'DG'#241#185#187
|
||||||
|
+#159#136#135#3'7'#248#136'tGy'#155#153#185#248#135#3'7'#248#136#132'DH'#153
|
||||||
|
+#153#185#136#135#3'7'#248#136#136'tDHI'#153#248#135#3'7'#248#136#136#136#136
|
||||||
|
+#136#137#159#136#135#3'7'#248#136#136#136#136#136#153#248#136#135#3'7'#248
|
||||||
|
+#136#136#136#136#136#136#136#136#135#3'7'#255#255#255#255#255#255#255#255#255
|
||||||
|
+#247#3'3wwwwwwwwww3333333333333'
|
||||||
|
]);
|
||||||
|
|||||||
951
components/rx/rxclock.pas
Normal file
951
components/rx/rxclock.pas
Normal file
@ -0,0 +1,951 @@
|
|||||||
|
{*******************************************************}
|
||||||
|
{ }
|
||||||
|
{ Delphi VCL Extensions (RX) }
|
||||||
|
{ }
|
||||||
|
{ Copyright (c) 1995, 1996 AO ROSNO }
|
||||||
|
{ Copyright (c) 1997, 1998 Master-Bank }
|
||||||
|
{ }
|
||||||
|
{*******************************************************}
|
||||||
|
|
||||||
|
unit rxclock;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$I rx.inc}
|
||||||
|
|
||||||
|
uses LCLType, LMessages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
|
||||||
|
ExtCtrls, Menus, messages;
|
||||||
|
|
||||||
|
type
|
||||||
|
TShowClock = (scDigital, scAnalog);
|
||||||
|
TPaintMode = (pmPaintAll, pmHandPaint);
|
||||||
|
|
||||||
|
TRxClockTime = packed record
|
||||||
|
Hour, Minute, Second: Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TRxGetTimeEvent = procedure (Sender: TObject; var ATime: TDateTime) of object;
|
||||||
|
|
||||||
|
{ TRxClock }
|
||||||
|
|
||||||
|
TRxClock = class(TCustomPanel)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FTimer: TTimer;
|
||||||
|
FAutoSize: Boolean;
|
||||||
|
FShowMode: TShowClock;
|
||||||
|
FTwelveHour: Boolean;
|
||||||
|
FLeadingZero: Boolean;
|
||||||
|
FShowSeconds: Boolean;
|
||||||
|
FAlarm: TDateTime;
|
||||||
|
FAlarmEnabled: Boolean;
|
||||||
|
FHooked: Boolean;
|
||||||
|
FDotsColor: TColor;
|
||||||
|
FAlarmWait: Boolean;
|
||||||
|
FDisplayTime: TRxClockTime;
|
||||||
|
FClockRect: TRect;
|
||||||
|
FClockRadius: Longint;
|
||||||
|
FClockCenter: TPoint;
|
||||||
|
FOnGetTime: TRxGetTimeEvent;
|
||||||
|
FOnAlarm: TNotifyEvent;
|
||||||
|
procedure TimerExpired(Sender: TObject);
|
||||||
|
procedure GetTime(var T: TRxClockTime);
|
||||||
|
function IsAlarmTime(ATime: TDateTime): Boolean;
|
||||||
|
procedure SetShowMode(Value: TShowClock);
|
||||||
|
function GetAlarmElement(Index: Integer): Byte;
|
||||||
|
procedure SetAlarmElement(Index: Integer; Value: Byte);
|
||||||
|
procedure SetDotsColor(Value: TColor);
|
||||||
|
procedure SetTwelveHour(Value: Boolean);
|
||||||
|
procedure SetLeadingZero(Value: Boolean);
|
||||||
|
procedure SetShowSeconds(Value: Boolean);
|
||||||
|
procedure PaintAnalogClock(PaintMode: TPaintMode);
|
||||||
|
procedure Paint3DFrame(var Rect: TRect);
|
||||||
|
procedure DrawAnalogFace;
|
||||||
|
procedure CircleClock(MaxWidth, MaxHeight: Integer);
|
||||||
|
procedure DrawSecondHand(Pos: Integer);
|
||||||
|
procedure DrawFatHand(Pos: Integer; HourHand: Boolean);
|
||||||
|
procedure PaintTimeStr(var Rect: TRect; FullTime: Boolean);
|
||||||
|
procedure ResizeFont(const Rect: TRect);
|
||||||
|
procedure ResetAlarm;
|
||||||
|
procedure CheckAlarm;
|
||||||
|
function FormatSettingsChange(var Message: TLMessage): Boolean;
|
||||||
|
procedure CMCtl3DChanged(var Message: TLMessage); message CM_CTL3DCHANGED;
|
||||||
|
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
|
||||||
|
procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
|
||||||
|
procedure WMTimeChange(var Message: TLMessage); message WM_TIMECHANGE;
|
||||||
|
protected
|
||||||
|
{ Protected declarations }
|
||||||
|
procedure SetAutoSize(const Value: Boolean); virtual;
|
||||||
|
procedure Alarm; dynamic;
|
||||||
|
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
|
||||||
|
procedure CreateWnd; override;
|
||||||
|
// procedure DestroyWindowHandle; override;
|
||||||
|
procedure Loaded; override;
|
||||||
|
procedure Paint; override;
|
||||||
|
function GetSystemTime: TDateTime; virtual;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure SetAlarmTime(AlarmTime: TDateTime);
|
||||||
|
procedure UpdateClock;
|
||||||
|
published
|
||||||
|
{ Published declarations }
|
||||||
|
property AlarmEnabled: Boolean read FAlarmEnabled write FAlarmEnabled default False;
|
||||||
|
property AlarmHour: Byte Index 1 read GetAlarmElement write SetAlarmElement default 0;
|
||||||
|
property AlarmMinute: Byte Index 2 read GetAlarmElement write SetAlarmElement default 0;
|
||||||
|
property AlarmSecond: Byte Index 3 read GetAlarmElement write SetAlarmElement default 0;
|
||||||
|
property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
|
||||||
|
property BevelInner default bvLowered;
|
||||||
|
property BevelOuter default bvRaised;
|
||||||
|
property DotsColor: TColor read FDotsColor write SetDotsColor default clTeal;
|
||||||
|
property ShowMode: TShowClock read FShowMode write SetShowMode default scDigital;
|
||||||
|
property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default True;
|
||||||
|
property TwelveHour: Boolean read FTwelveHour write SetTwelveHour default False;
|
||||||
|
property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default True;
|
||||||
|
property Align;
|
||||||
|
property BevelWidth;
|
||||||
|
property BorderWidth;
|
||||||
|
property BorderStyle;
|
||||||
|
{$IFDEF RX_D4}
|
||||||
|
property Anchors;
|
||||||
|
property Constraints;
|
||||||
|
property UseDockManager default True;
|
||||||
|
property DockSite;
|
||||||
|
property DragKind;
|
||||||
|
property FullRepaint;
|
||||||
|
{$ENDIF}
|
||||||
|
property Color;
|
||||||
|
property Ctl3D;
|
||||||
|
property Cursor;
|
||||||
|
property DragMode;
|
||||||
|
property DragCursor;
|
||||||
|
property Enabled;
|
||||||
|
property Font;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentCtl3D;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property Visible;
|
||||||
|
property OnAlarm: TNotifyEvent read FOnAlarm write FOnAlarm;
|
||||||
|
property OnGetTime: TRxGetTimeEvent read FOnGetTime write FOnGetTime;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnResize;
|
||||||
|
property OnContextPopup;
|
||||||
|
property OnStartDrag;
|
||||||
|
// property OnCanResize;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDockDrop;
|
||||||
|
property OnDockOver;
|
||||||
|
property OnEndDock;
|
||||||
|
// property OnGetSiteInfo;
|
||||||
|
// property OnStartDock;
|
||||||
|
// property OnUnDock;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses VCLUtils, RTLConsts{, LConsts}, LCLIntf;
|
||||||
|
|
||||||
|
const
|
||||||
|
Registered: Boolean = False;
|
||||||
|
|
||||||
|
type
|
||||||
|
PPointArray = ^TPointArray;
|
||||||
|
TPointArray = array [0..60 * 2 - 1] of TSmallPoint;
|
||||||
|
|
||||||
|
const
|
||||||
|
ClockData: array[0..60 * 4 - 1] of Byte = (
|
||||||
|
$00, $00, $C1, $E0, $44, $03, $EC, $E0, $7F, $06, $6F, $E1,
|
||||||
|
$A8, $09, $48, $E2, $B5, $0C, $74, $E3, $9F, $0F, $F0, $E4,
|
||||||
|
$5E, $12, $B8, $E6, $E9, $14, $C7, $E8, $39, $17, $17, $EB,
|
||||||
|
$48, $19, $A2, $ED, $10, $1B, $60, $F0, $8C, $1C, $4B, $F3,
|
||||||
|
$B8, $1D, $58, $F6, $91, $1E, $81, $F9, $14, $1F, $BC, $FC,
|
||||||
|
$40, $1F, $00, $00, $14, $1F, $44, $03, $91, $1E, $7F, $06,
|
||||||
|
$B8, $1D, $A8, $09, $8C, $1C, $B5, $0C, $10, $1B, $A0, $0F,
|
||||||
|
$48, $19, $5E, $12, $39, $17, $E9, $14, $E9, $14, $39, $17,
|
||||||
|
$5E, $12, $48, $19, $9F, $0F, $10, $1B, $B5, $0C, $8C, $1C,
|
||||||
|
$A8, $09, $B8, $1D, $7F, $06, $91, $1E, $44, $03, $14, $1F,
|
||||||
|
$00, $00, $3F, $1F, $BC, $FC, $14, $1F, $81, $F9, $91, $1E,
|
||||||
|
$58, $F6, $B8, $1D, $4B, $F3, $8C, $1C, $60, $F0, $10, $1B,
|
||||||
|
$A2, $ED, $48, $19, $17, $EB, $39, $17, $C7, $E8, $E9, $14,
|
||||||
|
$B8, $E6, $5E, $12, $F0, $E4, $9F, $0F, $74, $E3, $B5, $0C,
|
||||||
|
$48, $E2, $A8, $09, $6F, $E1, $7F, $06, $EC, $E0, $44, $03,
|
||||||
|
$C1, $E0, $00, $00, $EC, $E0, $BC, $FC, $6F, $E1, $81, $F9,
|
||||||
|
$48, $E2, $58, $F6, $74, $E3, $4B, $F3, $F0, $E4, $60, $F0,
|
||||||
|
$B8, $E6, $A2, $ED, $C7, $E8, $17, $EB, $17, $EB, $C7, $E8,
|
||||||
|
$A2, $ED, $B8, $E6, $61, $F0, $F0, $E4, $4B, $F3, $74, $E3,
|
||||||
|
$58, $F6, $48, $E2, $81, $F9, $6F, $E1, $BC, $FC, $EC, $E0);
|
||||||
|
|
||||||
|
const
|
||||||
|
AlarmSecDelay = 60; { seconds for try alarm event after alarm time occured }
|
||||||
|
MaxDotWidth = 25; { maximum Hour-marking dot width }
|
||||||
|
MinDotWidth = 2; { minimum Hour-marking dot width }
|
||||||
|
MinDotHeight = 1; { minimum Hour-marking dot height }
|
||||||
|
|
||||||
|
{ distance from the center of the clock to... }
|
||||||
|
HourSide = 7; { ...either side of the Hour hand }
|
||||||
|
MinuteSide = 5; { ...either side of the Minute hand }
|
||||||
|
HourTip = 60; { ...the tip of the Hour hand }
|
||||||
|
MinuteTip = 80; { ...the tip of the Minute hand }
|
||||||
|
SecondTip = 80; { ...the tip of the Second hand }
|
||||||
|
HourTail = 15; { ...the tail of the Hour hand }
|
||||||
|
MinuteTail = 20; { ...the tail of the Minute hand }
|
||||||
|
|
||||||
|
{ conversion factors }
|
||||||
|
CirTabScale = 8000; { circle table values scale down value }
|
||||||
|
MmPerDm = 100; { millimeters per decimeter }
|
||||||
|
|
||||||
|
{ number of hand positions on... }
|
||||||
|
HandPositions = 60; { ...entire clock }
|
||||||
|
SideShift = (HandPositions div 4); { ...90 degrees of clock }
|
||||||
|
TailShift = (HandPositions div 2); { ...180 degrees of clock }
|
||||||
|
|
||||||
|
var
|
||||||
|
CircleTab: PPointArray;
|
||||||
|
HRes: Integer; { width of the display (in pixels) }
|
||||||
|
VRes: Integer; { height of the display (in raster lines) }
|
||||||
|
AspectH: Longint; { number of pixels per decimeter on the display }
|
||||||
|
AspectV: Longint; { number of raster lines per decimeter on the display }
|
||||||
|
|
||||||
|
{ Exception routine }
|
||||||
|
|
||||||
|
procedure InvalidTime(Hour, Min, Sec: Word);
|
||||||
|
var
|
||||||
|
sTime: string[50];
|
||||||
|
begin
|
||||||
|
sTime := IntToStr(Hour) + TimeSeparator + IntToStr(Min) +
|
||||||
|
TimeSeparator + IntToStr(Sec);
|
||||||
|
raise EConvertError.CreateFmt(SInvalidTime, [sTime]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function VertEquiv(l: Integer): Integer;
|
||||||
|
begin
|
||||||
|
VertEquiv := Longint(l) * AspectV div AspectH;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HorzEquiv(l: Integer): Integer;
|
||||||
|
begin
|
||||||
|
HorzEquiv := Longint(l) * AspectH div AspectV;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LightColor(Color: TColor): TColor;
|
||||||
|
var
|
||||||
|
L: Longint;
|
||||||
|
C: array[1..3] of Byte;
|
||||||
|
I: Byte;
|
||||||
|
begin
|
||||||
|
L := ColorToRGB(Color);
|
||||||
|
C[1] := GetRValue(L);
|
||||||
|
C[2] := GetGValue(L);
|
||||||
|
C[3] := GetBValue(L);
|
||||||
|
for I := 1 to 3 do
|
||||||
|
begin
|
||||||
|
if C[I] = $FF then
|
||||||
|
begin
|
||||||
|
Result := clBtnHighlight;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if C[I] <> 0 then
|
||||||
|
if C[I] = $C0 then C[I] := $FF
|
||||||
|
else C[I] := C[I] + $7F;
|
||||||
|
end;
|
||||||
|
Result := TColor(RGB(C[1], C[2], C[3]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ClockInit;
|
||||||
|
var
|
||||||
|
Pos: Integer; { hand position Index into the circle table }
|
||||||
|
vSize: Integer; { height of the display in millimeters }
|
||||||
|
hSize: Integer; { width of the display in millimeters }
|
||||||
|
DC: HDC;
|
||||||
|
begin
|
||||||
|
DC := GetDC(0);
|
||||||
|
try
|
||||||
|
VRes := GetDeviceCaps(DC, VERTRES);
|
||||||
|
HRes := GetDeviceCaps(DC, HORZRES);
|
||||||
|
vSize := GetDeviceCaps(DC, VERTSIZE);
|
||||||
|
hSize := GetDeviceCaps(DC, HORZSIZE);
|
||||||
|
finally
|
||||||
|
ReleaseDC(0, DC);
|
||||||
|
end;
|
||||||
|
AspectV := (Longint(VRes) * MmPerDm) div Longint(vSize);
|
||||||
|
AspectH := (Longint(HRes) * MmPerDm) div Longint(hSize);
|
||||||
|
CircleTab := PPointArray(@ClockData);
|
||||||
|
for Pos := 0 to HandPositions - 1 do
|
||||||
|
CircleTab^[Pos].Y := VertEquiv(CircleTab^[Pos].Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HourHandPos(T: TRxClockTime): Integer;
|
||||||
|
begin
|
||||||
|
Result := (T.Hour * 5) + (T.Minute div 12);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Digital clock font routine }
|
||||||
|
|
||||||
|
procedure SetNewFontSize(Canvas: TCanvas; const Text: string;
|
||||||
|
MaxH, MaxW: Integer);
|
||||||
|
const
|
||||||
|
fHeight = 1000;
|
||||||
|
var
|
||||||
|
Font: TFont;
|
||||||
|
NewH: Integer;
|
||||||
|
begin
|
||||||
|
Font := Canvas.Font;
|
||||||
|
{ empiric calculate character height by cell height }
|
||||||
|
MaxH := MulDiv(MaxH, 4, 5);
|
||||||
|
{ with Font do
|
||||||
|
begin}
|
||||||
|
Font.Height := -fHeight;
|
||||||
|
NewH := MulDiv(fHeight, MaxW, Canvas.TextWidth(Text));
|
||||||
|
if NewH > MaxH then NewH := MaxH;
|
||||||
|
Font.Height := -NewH;
|
||||||
|
// end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRxClock }
|
||||||
|
|
||||||
|
constructor TRxClock.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
if not Registered then begin
|
||||||
|
ClockInit;
|
||||||
|
Registered := True;
|
||||||
|
end;
|
||||||
|
Caption := TimeToStr(Time);
|
||||||
|
ControlStyle := ControlStyle - [csSetCaption] - [csReplicatable];
|
||||||
|
BevelInner := bvLowered;
|
||||||
|
BevelOuter := bvRaised;
|
||||||
|
FTimer := TTimer.Create(Self);
|
||||||
|
FTimer.Interval := 450; { every second }
|
||||||
|
FTimer.OnTimer := @TimerExpired;
|
||||||
|
FDotsColor := clTeal;
|
||||||
|
FShowSeconds := True;
|
||||||
|
FLeadingZero := True;
|
||||||
|
GetTime(FDisplayTime);
|
||||||
|
if FDisplayTime.Hour >= 12 then Dec(FDisplayTime.Hour, 12);
|
||||||
|
FAlarmWait := True;
|
||||||
|
FAlarm := EncodeTime(0, 0, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TRxClock.Destroy;
|
||||||
|
begin
|
||||||
|
if FHooked then
|
||||||
|
begin
|
||||||
|
// Application.UnhookMainWindow(FormatSettingsChange);
|
||||||
|
FHooked := False;
|
||||||
|
end;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.Loaded;
|
||||||
|
begin
|
||||||
|
inherited Loaded;
|
||||||
|
ResetAlarm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.CreateWnd;
|
||||||
|
begin
|
||||||
|
inherited CreateWnd;
|
||||||
|
if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
|
||||||
|
begin
|
||||||
|
// Application.HookMainWindow(FormatSettingsChange);
|
||||||
|
FHooked := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{procedure TRxClock.DestroyWindowHandle;
|
||||||
|
begin
|
||||||
|
if FHooked then begin
|
||||||
|
Application.UnhookMainWindow(FormatSettingsChange);
|
||||||
|
FHooked := False;
|
||||||
|
end;
|
||||||
|
inherited DestroyWindowHandle;
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
procedure TRxClock.CMCtl3DChanged(var Message: TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if ShowMode = scAnalog then Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.CMTextChanged(var Message: TMessage);
|
||||||
|
begin
|
||||||
|
{ Skip this message, no repaint }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.CMFontChanged(var Message: TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
Invalidate;
|
||||||
|
if AutoSize then Realign;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.WMTimeChange(var Message: TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
Invalidate;
|
||||||
|
CheckAlarm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRxClock.FormatSettingsChange(var Message: TMessage): Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
case Message.Msg of
|
||||||
|
WM_WININICHANGE:
|
||||||
|
begin
|
||||||
|
Invalidate;
|
||||||
|
if AutoSize then Realign;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRxClock.GetSystemTime: TDateTime;
|
||||||
|
begin
|
||||||
|
Result := SysUtils.Time;
|
||||||
|
if Assigned(FOnGetTime) then FOnGetTime(Self, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.GetTime(var T: TRxClockTime);
|
||||||
|
var
|
||||||
|
MSec: Word;
|
||||||
|
begin
|
||||||
|
with T do
|
||||||
|
DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.UpdateClock;
|
||||||
|
begin
|
||||||
|
Invalidate;
|
||||||
|
if AutoSize then Realign;
|
||||||
|
Update;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.ResetAlarm;
|
||||||
|
begin
|
||||||
|
FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRxClock.IsAlarmTime(ATime: TDateTime): Boolean;
|
||||||
|
var
|
||||||
|
Hour, Min, Sec, MSec: Word;
|
||||||
|
AHour, AMin, ASec: Word;
|
||||||
|
begin
|
||||||
|
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||||
|
DecodeTime(ATime, AHour, AMin, ASec, MSec);
|
||||||
|
Result := {FAlarmWait and} (Hour = AHour) and (Min = AMin) and
|
||||||
|
(ASec >= Sec) and (ASec <= Sec + AlarmSecDelay);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.ResizeFont(const Rect: TRect);
|
||||||
|
var
|
||||||
|
H, W: Integer;
|
||||||
|
DC: HDC;
|
||||||
|
TimeStr: string;
|
||||||
|
begin
|
||||||
|
H := Rect.Bottom - Rect.Top - 4;
|
||||||
|
W := (Rect.Right - Rect.Left - 30);
|
||||||
|
if (H <= 0) or (W <= 0) then Exit;
|
||||||
|
DC := GetDC(0);
|
||||||
|
try
|
||||||
|
Canvas.Handle := DC;
|
||||||
|
Canvas.Font := Font;
|
||||||
|
TimeStr := '88888';
|
||||||
|
if FShowSeconds then TimeStr := TimeStr + '888';
|
||||||
|
if FTwelveHour then begin
|
||||||
|
if Canvas.TextWidth(TimeAMString) > Canvas.TextWidth(TimePMString) then
|
||||||
|
TimeStr := TimeStr + ' ' + TimeAMString
|
||||||
|
else TimeStr := TimeStr + ' ' + TimePMString;
|
||||||
|
end;
|
||||||
|
SetNewFontSize(Canvas, TimeStr, H, W);
|
||||||
|
Font := Canvas.Font;
|
||||||
|
finally
|
||||||
|
Canvas.Handle := 0;
|
||||||
|
ReleaseDC(0, DC);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.AlignControls(AControl: TControl; var Rect: TRect);
|
||||||
|
{$IFDEF RX_D4}
|
||||||
|
var
|
||||||
|
InflateWidth: Integer;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited AlignControls(AControl, Rect);
|
||||||
|
FClockRect := Rect;
|
||||||
|
{$IFDEF RX_D4}
|
||||||
|
InflateWidth := BorderWidth + 1;
|
||||||
|
if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||||
|
if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||||
|
InflateRect(FClockRect, -InflateWidth, -InflateWidth);
|
||||||
|
{$ENDIF}
|
||||||
|
with FClockRect do CircleClock(Right - Left, Bottom - Top);
|
||||||
|
if AutoSize then ResizeFont(Rect);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.Alarm;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnAlarm) then FOnAlarm(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetAutoSize(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
if (Value <> FAutoSize) then
|
||||||
|
begin
|
||||||
|
FAutoSize := Value;
|
||||||
|
if FAutoSize then
|
||||||
|
begin
|
||||||
|
Invalidate;
|
||||||
|
Realign;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetTwelveHour(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FTwelveHour <> Value then begin
|
||||||
|
FTwelveHour := Value;
|
||||||
|
Invalidate;
|
||||||
|
if AutoSize then Realign;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetLeadingZero(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FLeadingZero <> Value then begin
|
||||||
|
FLeadingZero := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetShowSeconds(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FShowSeconds <> Value then begin
|
||||||
|
{if FShowSeconds and (ShowMode = scAnalog) then
|
||||||
|
DrawSecondHand(FDisplayTime.Second);}
|
||||||
|
FShowSeconds := Value;
|
||||||
|
Invalidate;
|
||||||
|
if AutoSize then Realign;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetDotsColor(Value: TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FDotsColor then begin
|
||||||
|
FDotsColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetShowMode(Value: TShowClock);
|
||||||
|
begin
|
||||||
|
if FShowMode <> Value then begin
|
||||||
|
FShowMode := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRxClock.GetAlarmElement(Index: Integer): Byte;
|
||||||
|
var
|
||||||
|
Hour, Min, Sec, MSec: Word;
|
||||||
|
begin
|
||||||
|
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||||
|
case Index of
|
||||||
|
1: Result := Hour;
|
||||||
|
2: Result := Min;
|
||||||
|
3: Result := Sec;
|
||||||
|
else Result := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetAlarmElement(Index: Integer; Value: Byte);
|
||||||
|
var
|
||||||
|
Hour, Min, Sec, MSec: Word;
|
||||||
|
begin
|
||||||
|
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||||
|
case Index of
|
||||||
|
1: Hour := Value;
|
||||||
|
2: Min := Value;
|
||||||
|
3: Sec := Value;
|
||||||
|
else Exit;
|
||||||
|
end;
|
||||||
|
if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
|
||||||
|
FAlarm := EncodeTime(Hour, Min, Sec, 0);
|
||||||
|
ResetAlarm;
|
||||||
|
end
|
||||||
|
else InvalidTime(Hour, Min, Sec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.SetAlarmTime(AlarmTime: TDateTime);
|
||||||
|
var
|
||||||
|
Hour, Min, Sec, MSec: Word;
|
||||||
|
begin
|
||||||
|
DecodeTime(FAlarm, Hour, Min, Sec, MSec);
|
||||||
|
if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
|
||||||
|
FAlarm := Frac(AlarmTime);
|
||||||
|
ResetAlarm;
|
||||||
|
end
|
||||||
|
else InvalidTime(Hour, Min, Sec);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.TimerExpired(Sender: TObject);
|
||||||
|
var
|
||||||
|
DC: HDC;
|
||||||
|
Rect: TRect;
|
||||||
|
InflateWidth: Integer;
|
||||||
|
begin
|
||||||
|
DC := GetDC(Handle);
|
||||||
|
try
|
||||||
|
Canvas.Handle := DC;
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
Canvas.Font := Font;
|
||||||
|
Canvas.Pen.Color := Font.Color;
|
||||||
|
if FShowMode = scAnalog then PaintAnalogClock(pmHandPaint)
|
||||||
|
else begin
|
||||||
|
Rect := GetClientRect;
|
||||||
|
InflateWidth := BorderWidth;
|
||||||
|
if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||||
|
if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
|
||||||
|
InflateRect(Rect, -InflateWidth, -InflateWidth);
|
||||||
|
PaintTimeStr(Rect, False);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Canvas.Handle := 0;
|
||||||
|
ReleaseDC(Handle, DC);
|
||||||
|
end;
|
||||||
|
CheckAlarm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.CheckAlarm;
|
||||||
|
begin
|
||||||
|
if FAlarmEnabled and IsAlarmTime(GetSystemTime) then begin
|
||||||
|
if FAlarmWait then begin
|
||||||
|
FAlarmWait := False;
|
||||||
|
Alarm;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else ResetAlarm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.DrawAnalogFace;
|
||||||
|
var
|
||||||
|
Pos, DotHeight, DotWidth: Integer;
|
||||||
|
DotCenter: TPoint;
|
||||||
|
R: TRect;
|
||||||
|
SaveBrush, SavePen: TColor;
|
||||||
|
MinDots: Boolean;
|
||||||
|
begin
|
||||||
|
DotWidth := (MaxDotWidth * Longint(FClockRect.Right - FClockRect.Left)) div HRes;
|
||||||
|
DotHeight := VertEquiv(DotWidth);
|
||||||
|
if DotHeight < MinDotHeight then DotHeight := MinDotHeight;
|
||||||
|
if DotWidth < MinDotWidth then DotWidth := MinDotWidth;
|
||||||
|
DotCenter.X := DotWidth div 2;
|
||||||
|
DotCenter.Y := DotHeight div 2;
|
||||||
|
InflateRect(FClockRect, -DotCenter.Y, -DotCenter.X);
|
||||||
|
FClockRadius := ((FClockRect.Right - FClockRect.Left) div 2);
|
||||||
|
FClockCenter.X := FClockRect.Left + FClockRadius;
|
||||||
|
FClockCenter.Y := FClockRect.Top + ((FClockRect.Bottom - FClockRect.Top) div 2);
|
||||||
|
InflateRect(FClockRect, DotCenter.Y, DotCenter.X);
|
||||||
|
SaveBrush := Canvas.Brush.Color;
|
||||||
|
SavePen := Canvas.Pen.Color;
|
||||||
|
try
|
||||||
|
Canvas.Brush.Color := Canvas.Pen.Color;
|
||||||
|
MinDots := ((DotWidth > MinDotWidth) and (DotHeight > MinDotHeight));
|
||||||
|
for Pos := 0 to HandPositions - 1 do begin
|
||||||
|
R.Top := (CircleTab^[Pos].Y * FClockRadius) div CirTabScale + FClockCenter.Y;
|
||||||
|
R.Left := (CircleTab^[Pos].X * FClockRadius) div CirTabScale + FClockCenter.X;
|
||||||
|
if (Pos mod 5) <> 0 then begin
|
||||||
|
if MinDots then begin
|
||||||
|
if Ctl3D then begin
|
||||||
|
Canvas.Brush.Color := clBtnShadow;
|
||||||
|
OffsetRect(R, -1, -1);
|
||||||
|
R.Right := R.Left + 2;
|
||||||
|
R.Bottom := R.Top + 2;
|
||||||
|
Canvas.FillRect(R);
|
||||||
|
Canvas.Brush.Color := clBtnHighlight;
|
||||||
|
OffsetRect(R, 1, 1);
|
||||||
|
Canvas.FillRect(R);
|
||||||
|
Canvas.Brush.Color := Self.Color;
|
||||||
|
end;
|
||||||
|
R.Right := R.Left + 1;
|
||||||
|
R.Bottom := R.Top + 1;
|
||||||
|
Canvas.FillRect(R);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
R.Right := R.Left + DotWidth;
|
||||||
|
R.Bottom := R.Top + DotHeight;
|
||||||
|
OffsetRect(R, -DotCenter.X, -DotCenter.Y);
|
||||||
|
if Ctl3D and MinDots then
|
||||||
|
with Canvas do
|
||||||
|
begin
|
||||||
|
Brush.Color := FDotsColor;
|
||||||
|
Brush.Style := bsSolid;
|
||||||
|
FillRect(R);
|
||||||
|
RxFrame3D(Canvas, R, LightColor(FDotsColor), clWindowFrame, 1);
|
||||||
|
end;
|
||||||
|
Canvas.Brush.Color := Canvas.Pen.Color;
|
||||||
|
if not (Ctl3D and MinDots) then Canvas.FillRect(R);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Canvas.Brush.Color := SaveBrush;
|
||||||
|
Canvas.Pen.Color := SavePen;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.CircleClock(MaxWidth, MaxHeight: Integer);
|
||||||
|
var
|
||||||
|
ClockHeight: Integer;
|
||||||
|
ClockWidth: Integer;
|
||||||
|
begin
|
||||||
|
if MaxWidth > HorzEquiv(MaxHeight) then begin
|
||||||
|
ClockWidth := HorzEquiv(MaxHeight);
|
||||||
|
FClockRect.Left := FClockRect.Left + ((MaxWidth - ClockWidth) div 2);
|
||||||
|
FClockRect.Right := FClockRect.Left + ClockWidth;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
ClockHeight := VertEquiv(MaxWidth);
|
||||||
|
FClockRect.Top := FClockRect.Top + ((MaxHeight - ClockHeight) div 2);
|
||||||
|
FClockRect.Bottom := FClockRect.Top + ClockHeight;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.DrawSecondHand(Pos: Integer);
|
||||||
|
var
|
||||||
|
Radius: Longint;
|
||||||
|
SaveMode: TPenMode;
|
||||||
|
begin
|
||||||
|
Radius := (FClockRadius * SecondTip) div 100;
|
||||||
|
SaveMode := Canvas.Pen.Mode;
|
||||||
|
Canvas.Pen.Mode := pmNot;
|
||||||
|
try
|
||||||
|
Canvas.MoveTo(FClockCenter.X, FClockCenter.Y);
|
||||||
|
Canvas.LineTo(FClockCenter.X + ((CircleTab^[Pos].X * Radius) div
|
||||||
|
CirTabScale), FClockCenter.Y + ((CircleTab^[Pos].Y * Radius) div
|
||||||
|
CirTabScale));
|
||||||
|
finally
|
||||||
|
Canvas.Pen.Mode := SaveMode;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.DrawFatHand(Pos: Integer; HourHand: Boolean);
|
||||||
|
var
|
||||||
|
ptSide, ptTail, ptTip: TPoint;
|
||||||
|
Index, Hand: Integer;
|
||||||
|
Scale: Longint;
|
||||||
|
SaveMode: TPenMode;
|
||||||
|
begin
|
||||||
|
if HourHand then Hand := HourSide else Hand := MinuteSide;
|
||||||
|
Scale := (FClockRadius * Hand) div 100;
|
||||||
|
Index := (Pos + SideShift) mod HandPositions;
|
||||||
|
ptSide.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
|
||||||
|
ptSide.X := (CircleTab^[Index].X * Scale) div CirTabScale;
|
||||||
|
if HourHand then Hand := HourTip else Hand := MinuteTip;
|
||||||
|
Scale := (FClockRadius * Hand) div 100;
|
||||||
|
ptTip.Y := (CircleTab^[Pos].Y * Scale) div CirTabScale;
|
||||||
|
ptTip.X := (CircleTab^[Pos].X * Scale) div CirTabScale;
|
||||||
|
if HourHand then Hand := HourTail else Hand := MinuteTail;
|
||||||
|
Scale := (FClockRadius * Hand) div 100;
|
||||||
|
Index := (Pos + TailShift) mod HandPositions;
|
||||||
|
ptTail.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
|
||||||
|
ptTail.X := (CircleTab^[Index].X * Scale) div CirTabScale;
|
||||||
|
with Canvas do begin
|
||||||
|
SaveMode := Pen.Mode;
|
||||||
|
Pen.Mode := pmCopy;
|
||||||
|
try
|
||||||
|
MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
|
||||||
|
LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
|
||||||
|
MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
|
||||||
|
LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
|
||||||
|
MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
|
||||||
|
LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
|
||||||
|
MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
|
||||||
|
LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
|
||||||
|
finally
|
||||||
|
Pen.Mode := SaveMode;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.PaintAnalogClock(PaintMode: TPaintMode);
|
||||||
|
var
|
||||||
|
NewTime: TRxClockTime;
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Color := Font.Color;
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
SetBkMode(Canvas.Handle, TRANSPARENT);
|
||||||
|
if PaintMode = pmPaintAll then begin
|
||||||
|
with Canvas do begin
|
||||||
|
FillRect(FClockRect);
|
||||||
|
Pen.Color := Self.Font.Color;
|
||||||
|
DrawAnalogFace;
|
||||||
|
DrawFatHand(HourHandPos(FDisplayTime), True);
|
||||||
|
DrawFatHand(FDisplayTime.Minute, False);
|
||||||
|
Pen.Color := Brush.Color;
|
||||||
|
if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
with Canvas do begin
|
||||||
|
Pen.Color := Brush.Color;
|
||||||
|
GetTime(NewTime);
|
||||||
|
if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
|
||||||
|
if (NewTime.Second <> FDisplayTime.Second) then
|
||||||
|
if ShowSeconds then DrawSecondHand(FDisplayTime.Second);
|
||||||
|
if ((NewTime.Minute <> FDisplayTime.Minute) or
|
||||||
|
(NewTime.Hour <> FDisplayTime.Hour)) then
|
||||||
|
begin
|
||||||
|
DrawFatHand(FDisplayTime.Minute, False);
|
||||||
|
DrawFatHand(HourHandPos(FDisplayTime), True);
|
||||||
|
Pen.Color := Self.Font.Color;
|
||||||
|
DrawFatHand(NewTime.Minute, False);
|
||||||
|
DrawFatHand(HourHandPos(NewTime), True);
|
||||||
|
end;
|
||||||
|
Pen.Color := Brush.Color;
|
||||||
|
if (NewTime.Second <> FDisplayTime.Second) then begin
|
||||||
|
if ShowSeconds then DrawSecondHand(NewTime.Second);
|
||||||
|
FDisplayTime := NewTime;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.PaintTimeStr(var Rect: TRect; FullTime: Boolean);
|
||||||
|
var
|
||||||
|
FontHeight, FontWidth, FullWidth, I, L, H: Integer;
|
||||||
|
TimeStr, SAmPm: string;
|
||||||
|
NewTime: TRxClockTime;
|
||||||
|
|
||||||
|
function IsPartSym(Idx, Num: Byte): Boolean;
|
||||||
|
var
|
||||||
|
TwoSymHour: Boolean;
|
||||||
|
begin
|
||||||
|
TwoSymHour := (H >= 10) or FLeadingZero;
|
||||||
|
case Idx of
|
||||||
|
1: begin {hours}
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
2: begin {minutes}
|
||||||
|
if TwoSymHour then Result := (Num in [4, 5])
|
||||||
|
else Result := (Num in [3, 4]);
|
||||||
|
end;
|
||||||
|
3: begin {seconds}
|
||||||
|
if TwoSymHour then Result := FShowSeconds and (Num in [7, 8])
|
||||||
|
else Result := FShowSeconds and (Num in [6, 7]);
|
||||||
|
end;
|
||||||
|
else Result := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure DrawSym(Sym: Char; Num: Byte);
|
||||||
|
begin
|
||||||
|
if FullTime or
|
||||||
|
((NewTime.Second <> FDisplayTime.Second) and IsPartSym(3, Num)) or
|
||||||
|
((NewTime.Minute <> FDisplayTime.Minute) and IsPartSym(2, Num)) or
|
||||||
|
(NewTime.Hour <> FDisplayTime.Hour) then
|
||||||
|
begin
|
||||||
|
Canvas.FillRect(Rect);
|
||||||
|
DrawText(Canvas.Handle, @Sym, 1, Rect, DT_EXPANDTABS or
|
||||||
|
DT_VCENTER or DT_CENTER or DT_NOCLIP or DT_SINGLELINE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
GetTime(NewTime);
|
||||||
|
H := NewTime.Hour;
|
||||||
|
if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
|
||||||
|
if FTwelveHour then begin
|
||||||
|
if H > 12 then Dec(H, 12) else if H = 0 then H := 12;
|
||||||
|
end;
|
||||||
|
if (not FullTime) and (NewTime.Hour <> FDisplayTime.Hour) then begin
|
||||||
|
Repaint;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if FLeadingZero then TimeStr := 'hh:mm' else TimeStr := 'h:mm';
|
||||||
|
if FShowSeconds then TimeStr := TimeStr + ':ss';
|
||||||
|
if FTwelveHour then TimeStr := TimeStr + ' ampm';
|
||||||
|
with NewTime do
|
||||||
|
TimeStr := FormatDateTime(TimeStr, GetSystemTime);
|
||||||
|
if (H >= 10) or FLeadingZero then L := 5 else L := 4;
|
||||||
|
if FShowSeconds then Inc(L, 3);
|
||||||
|
SAmPm := Copy(TimeStr, L + 1, MaxInt);
|
||||||
|
with Canvas do begin
|
||||||
|
Font := Self.Font;
|
||||||
|
FontHeight := TextHeight('8');
|
||||||
|
FontWidth := TextWidth('8');
|
||||||
|
FullWidth := TextWidth(SAmPm) + (L * FontWidth);
|
||||||
|
with Rect do begin
|
||||||
|
Left := ((Right + Left) - FullWidth) div 2 {shr 1};
|
||||||
|
Right := Left + FullWidth;
|
||||||
|
Top := ((Bottom + Top) - FontHeight) div 2 {shr 1};
|
||||||
|
Bottom := Top + FontHeight;
|
||||||
|
end;
|
||||||
|
Brush.Color := Color;
|
||||||
|
for I := 1 to L do begin
|
||||||
|
Rect.Right := Rect.Left + FontWidth;
|
||||||
|
DrawSym(TimeStr[I], I);
|
||||||
|
Inc(Rect.Left, FontWidth);
|
||||||
|
end;
|
||||||
|
if FullTime or (NewTime.Hour <> FDisplayTime.Hour) then begin
|
||||||
|
Rect.Right := Rect.Left + TextWidth(SAmPm);
|
||||||
|
DrawText(Handle, @SAmPm[1], Length(SAmPm), Rect,
|
||||||
|
DT_EXPANDTABS or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FDisplayTime := NewTime;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.Paint3DFrame(var Rect: TRect);
|
||||||
|
var
|
||||||
|
TopColor, BottomColor: TColor;
|
||||||
|
|
||||||
|
procedure AdjustColors(Bevel: TPanelBevel);
|
||||||
|
begin
|
||||||
|
TopColor := clBtnHighlight;
|
||||||
|
if Bevel = bvLowered then TopColor := clBtnShadow;
|
||||||
|
BottomColor := clBtnShadow;
|
||||||
|
if Bevel = bvLowered then BottomColor := clBtnHighlight;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Rect := GetClientRect;
|
||||||
|
with Canvas do
|
||||||
|
begin
|
||||||
|
Brush.Color := Color;
|
||||||
|
FillRect(Rect);
|
||||||
|
end;
|
||||||
|
if BevelOuter <> bvNone then
|
||||||
|
begin
|
||||||
|
AdjustColors(BevelOuter);
|
||||||
|
RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
||||||
|
end;
|
||||||
|
InflateRect(Rect, -BorderWidth, -BorderWidth);
|
||||||
|
if BevelInner <> bvNone then
|
||||||
|
begin
|
||||||
|
AdjustColors(BevelInner);
|
||||||
|
RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxClock.Paint;
|
||||||
|
var
|
||||||
|
R: TRect;
|
||||||
|
begin
|
||||||
|
Paint3DFrame(R);
|
||||||
|
case FShowMode of
|
||||||
|
scDigital: PaintTimeStr(R, True);
|
||||||
|
scAnalog: PaintAnalogClock(pmPaintAll);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@ -652,170 +652,37 @@ type
|
|||||||
property OnResize;
|
property OnResize;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
(*
|
|
||||||
{ TRxSpeedButton }
|
{ TRxSpeedButton }
|
||||||
|
(*
|
||||||
|
|
||||||
TRxNumGlyphs = 1..5;
|
TRxNumGlyphs = 1..5;
|
||||||
TRxDropDownMenuPos = (dmpBottom, dmpRight);
|
TRxDropDownMenuPos = (dmpBottom, dmpRight);
|
||||||
TRxButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);
|
TRxButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);
|
||||||
|
*)
|
||||||
|
|
||||||
TRxSpeedButton = class(TGraphicControl)
|
TRxSpeedButton = class(TSpeedButton)
|
||||||
private
|
private
|
||||||
FGroupIndex: Integer;
|
|
||||||
FStyle: TButtonStyle;
|
|
||||||
FGlyph: Pointer;
|
|
||||||
FDrawImage: TBitmap;
|
|
||||||
FDown: Boolean;
|
|
||||||
FDragging: Boolean;
|
|
||||||
FFlat: Boolean;
|
|
||||||
FMouseInControl: Boolean;
|
|
||||||
FAllowAllUp: Boolean;
|
|
||||||
FLayout: TButtonLayout;
|
|
||||||
FSpacing: Integer;
|
|
||||||
FMargin: Integer;
|
|
||||||
FModalResult: TModalResult;
|
|
||||||
FTransparent: Boolean;
|
|
||||||
FMarkDropDown: Boolean;
|
|
||||||
FDropDownMenu: TPopupMenu;
|
|
||||||
FMenuPosition: TRxDropDownMenuPos;
|
|
||||||
FInactiveGrayed: Boolean;
|
|
||||||
FMenuTracking: Boolean;
|
|
||||||
FRepeatTimer: TTimer;
|
|
||||||
FAllowTimer: Boolean;
|
FAllowTimer: Boolean;
|
||||||
FInitRepeatPause: Word;
|
FInitRepeatPause: Word;
|
||||||
FRepeatPause: Word;
|
FRepeatPause: Word;
|
||||||
FOnMouseEnter: TNotifyEvent;
|
FRepeatTimer: TTimer;
|
||||||
FOnMouseLeave: TNotifyEvent;
|
procedure SetAllowTimer(const AValue: Boolean);
|
||||||
procedure GlyphChanged(Sender: TObject);
|
|
||||||
procedure UpdateExclusive;
|
|
||||||
function GetGlyph: TBitmap;
|
|
||||||
procedure SetGlyph(Value: TBitmap);
|
|
||||||
function GetNumGlyphs: TRxNumGlyphs;
|
|
||||||
procedure SetNumGlyphs(Value: TRxNumGlyphs);
|
|
||||||
function GetWordWrap: Boolean;
|
|
||||||
procedure SetWordWrap(Value: Boolean);
|
|
||||||
function GetAlignment: TAlignment;
|
|
||||||
procedure SetAlignment(Value: TAlignment);
|
|
||||||
procedure SetDown(Value: Boolean);
|
|
||||||
procedure SetAllowAllUp(Value: Boolean);
|
|
||||||
procedure SetGroupIndex(Value: Integer);
|
|
||||||
procedure SetLayout(Value: TButtonLayout);
|
|
||||||
procedure SetSpacing(Value: Integer);
|
|
||||||
procedure SetMargin(Value: Integer);
|
|
||||||
procedure SetDropDownMenu(Value: TPopupMenu);
|
|
||||||
procedure SetFlat(Value: Boolean);
|
|
||||||
procedure SetStyle(Value: TButtonStyle);
|
|
||||||
procedure SetInactiveGrayed(Value: Boolean);
|
|
||||||
procedure SetTransparent(Value: Boolean);
|
|
||||||
procedure SetMarkDropDown(Value: Boolean);
|
|
||||||
procedure TimerExpired(Sender: TObject);
|
procedure TimerExpired(Sender: TObject);
|
||||||
procedure SetAllowTimer(Value: Boolean);
|
|
||||||
function CheckMenuDropDown(const Pos: TSmallPoint;
|
|
||||||
Manual: Boolean): Boolean;
|
|
||||||
procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
||||||
X, Y: Integer);
|
|
||||||
procedure CMButtonPressed(var Message: TMessage); message CM_RXBUTTONPRESSED;
|
|
||||||
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
|
|
||||||
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
|
|
||||||
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
||||||
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
|
|
||||||
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
||||||
procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
|
|
||||||
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
|
|
||||||
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
|
|
||||||
procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
|
|
||||||
procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
|
|
||||||
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
|
|
||||||
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
|
|
||||||
protected
|
protected
|
||||||
FState: TRxButtonState;
|
|
||||||
{$IFDEF RX_D4}
|
|
||||||
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
||||||
{$ENDIF}
|
|
||||||
function GetDropDownMenuPos: TPoint;
|
|
||||||
function GetPalette: HPALETTE; override;
|
|
||||||
procedure Paint; override;
|
|
||||||
procedure Loaded; override;
|
|
||||||
procedure PaintGlyph(Canvas: TCanvas; ARect: TRect; AState: TRxButtonState;
|
|
||||||
DrawMark: Boolean); virtual;
|
|
||||||
procedure MouseEnter; dynamic;
|
|
||||||
procedure MouseLeave; dynamic;
|
|
||||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||||
X, Y: Integer); override;
|
X, Y: Integer); override;
|
||||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
||||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||||
X, Y: Integer); override;
|
X, Y: Integer); override;
|
||||||
procedure Notification(AComponent: TComponent;
|
|
||||||
Operation: TOperation); override;
|
|
||||||
property ButtonGlyph: Pointer read FGlyph;
|
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure ButtonClick;
|
|
||||||
function CheckBtnMenuDropDown: Boolean;
|
|
||||||
procedure Click; override;
|
|
||||||
procedure UpdateTracking;
|
|
||||||
published
|
published
|
||||||
{$IFDEF RX_D4}
|
|
||||||
property Action;
|
|
||||||
property Anchors;
|
|
||||||
property BiDiMode;
|
|
||||||
property Constraints;
|
|
||||||
property DragKind;
|
|
||||||
property ParentBiDiMode;
|
|
||||||
{$ENDIF}
|
|
||||||
property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter;
|
|
||||||
property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
|
|
||||||
property AllowTimer: Boolean read FAllowTimer write SetAllowTimer default False;
|
property AllowTimer: Boolean read FAllowTimer write SetAllowTimer default False;
|
||||||
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
|
|
||||||
{ Ensure group index is declared before Down }
|
|
||||||
property Down: Boolean read FDown write SetDown default False;
|
|
||||||
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
|
|
||||||
property MenuPosition: TRxDropDownMenuPos read FMenuPosition write FMenuPosition
|
|
||||||
default dmpBottom;
|
|
||||||
property Caption;
|
|
||||||
property DragCursor;
|
|
||||||
property DragMode;
|
|
||||||
property Enabled;
|
|
||||||
property Flat: Boolean read FFlat write SetFlat default False;
|
|
||||||
property Font;
|
|
||||||
property Glyph: TBitmap read GetGlyph write SetGlyph;
|
|
||||||
property GrayedInactive: Boolean read FInactiveGrayed write SetInactiveGrayed
|
|
||||||
default True;
|
|
||||||
property InitPause: Word read FInitRepeatPause write FInitRepeatPause default 500;
|
property InitPause: Word read FInitRepeatPause write FInitRepeatPause default 500;
|
||||||
property Layout: TButtonLayout read FLayout write SetLayout default blGlyphTop;
|
|
||||||
property Margin: Integer read FMargin write SetMargin default -1;
|
|
||||||
property MarkDropDown: Boolean read FMarkDropDown write SetMarkDropDown default True;
|
|
||||||
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
|
|
||||||
property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
|
|
||||||
property ParentFont;
|
|
||||||
property ParentShowHint default False;
|
|
||||||
property RepeatInterval: Word read FRepeatPause write FRepeatPause default 100;
|
property RepeatInterval: Word read FRepeatPause write FRepeatPause default 100;
|
||||||
property ShowHint default True;
|
|
||||||
property Spacing: Integer read FSpacing write SetSpacing default 1;
|
|
||||||
property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
|
|
||||||
property Transparent: Boolean read FTransparent write SetTransparent default False;
|
|
||||||
property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
|
|
||||||
property Visible;
|
|
||||||
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
||||||
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
||||||
property OnClick;
|
|
||||||
property OnDblClick;
|
|
||||||
property OnDragDrop;
|
|
||||||
property OnDragOver;
|
|
||||||
property OnEndDrag;
|
|
||||||
property OnMouseDown;
|
|
||||||
property OnMouseMove;
|
|
||||||
property OnMouseUp;
|
|
||||||
{$IFDEF WIN32}
|
|
||||||
property OnStartDrag;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF RX_D4}
|
|
||||||
property OnEndDock;
|
|
||||||
property OnStartDock;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
{ TButtonImage }
|
{ TButtonImage }
|
||||||
|
|
||||||
TButtonImage = class(TObject)
|
TButtonImage = class(TObject)
|
||||||
@ -2864,9 +2731,9 @@ end;
|
|||||||
procedure TRxCustomLabel.SetFocusControl(Value: TWinControl);
|
procedure TRxCustomLabel.SetFocusControl(Value: TWinControl);
|
||||||
begin
|
begin
|
||||||
FFocusControl := Value;
|
FFocusControl := Value;
|
||||||
{$IFDEF WIN32}
|
{.$IFDEF WIN32}
|
||||||
if Value <> nil then Value.FreeNotification(Self);
|
if Value <> nil then Value.FreeNotification(Self);
|
||||||
{$ENDIF}
|
{.$ENDIF}
|
||||||
if FShowFocus then Invalidate;
|
if FShowFocus then Invalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -4458,677 +4325,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TRxSpeedButton }
|
|
||||||
|
|
||||||
constructor TRxSpeedButton.Create(AOwner: TComponent);
|
|
||||||
begin
|
|
||||||
inherited Create(AOwner);
|
|
||||||
SetBounds(0, 0, 25, 25);
|
|
||||||
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
|
|
||||||
{$IFDEF WIN32}
|
|
||||||
ControlStyle := ControlStyle + [csReplicatable];
|
|
||||||
{$ENDIF}
|
|
||||||
FInactiveGrayed := True;
|
|
||||||
FDrawImage := TBitmap.Create;
|
|
||||||
FGlyph := TRxButtonGlyph.Create;
|
|
||||||
TRxButtonGlyph(FGlyph).OnChange := GlyphChanged;
|
|
||||||
ParentFont := True;
|
|
||||||
ParentShowHint := False;
|
|
||||||
ShowHint := True;
|
|
||||||
FSpacing := 1;
|
|
||||||
FMargin := -1;
|
|
||||||
FInitRepeatPause := 500;
|
|
||||||
FRepeatPause := 100;
|
|
||||||
FStyle := bsAutoDetect;
|
|
||||||
FLayout := blGlyphTop;
|
|
||||||
FMarkDropDown := True;
|
|
||||||
Inc(ButtonCount);
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TRxSpeedButton.Destroy;
|
|
||||||
begin
|
|
||||||
TRxButtonGlyph(FGlyph).Free;
|
|
||||||
Dec(ButtonCount);
|
|
||||||
{$IFNDEF RX_D4}
|
|
||||||
if ButtonCount = 0 then begin
|
|
||||||
Pattern.Free;
|
|
||||||
Pattern := nil;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
FDrawImage.Free;
|
|
||||||
FDrawImage := nil;
|
|
||||||
if FRepeatTimer <> nil then FRepeatTimer.Free;
|
|
||||||
inherited Destroy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.Loaded;
|
|
||||||
var
|
|
||||||
State: TRxButtonState;
|
|
||||||
begin
|
|
||||||
inherited Loaded;
|
|
||||||
if Enabled then begin
|
|
||||||
if Flat then State := rbsInactive
|
|
||||||
else State := rbsUp;
|
|
||||||
end
|
|
||||||
else State := rbsDisabled;
|
|
||||||
TRxButtonGlyph(FGlyph).CreateButtonGlyph(State);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.PaintGlyph(Canvas: TCanvas; ARect: TRect;
|
|
||||||
AState: TRxButtonState; DrawMark: Boolean);
|
|
||||||
begin
|
|
||||||
TRxButtonGlyph(FGlyph).Draw(Canvas, ARect, Caption, FLayout,
|
|
||||||
FMargin, FSpacing, DrawMark, AState,
|
|
||||||
{$IFDEF RX_D4} DrawTextBiDiModeFlags(Alignments[Alignment]) {$ELSE}
|
|
||||||
Alignments[Alignment] {$ENDIF});
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.Paint;
|
|
||||||
var
|
|
||||||
PaintRect: TRect;
|
|
||||||
AState: TRxButtonState;
|
|
||||||
begin
|
|
||||||
if not Enabled {and not (csDesigning in ComponentState)} then begin
|
|
||||||
FState := rbsDisabled;
|
|
||||||
FDragging := False;
|
|
||||||
end
|
|
||||||
else if FState = rbsDisabled then
|
|
||||||
if FDown and (GroupIndex <> 0) then FState := rbsExclusive
|
|
||||||
else FState := rbsUp;
|
|
||||||
AState := FState;
|
|
||||||
if FFlat and not FMouseInControl and not (csDesigning in ComponentState) then
|
|
||||||
AState := rbsInactive;
|
|
||||||
PaintRect := Rect(0, 0, Width, Height);
|
|
||||||
FDrawImage.Width := Self.Width;
|
|
||||||
FDrawImage.Height := Self.Height;
|
|
||||||
with FDrawImage.Canvas do begin
|
|
||||||
Font := Self.Font;
|
|
||||||
Brush.Color := clBtnFace;
|
|
||||||
Brush.Style := bsSolid;
|
|
||||||
FillRect(PaintRect);
|
|
||||||
if FTransparent then CopyParentImage(Self, FDrawImage.Canvas);
|
|
||||||
if (AState <> rbsInactive) or (FState = rbsExclusive) then
|
|
||||||
PaintRect := DrawButtonFrame(FDrawImage.Canvas, PaintRect,
|
|
||||||
FState in [rbsDown, rbsExclusive], FFlat, FStyle)
|
|
||||||
else if FFlat then
|
|
||||||
InflateRect(PaintRect, -2, -2);
|
|
||||||
end;
|
|
||||||
if (FState = rbsExclusive) and not Transparent and
|
|
||||||
(not FFlat or (AState = rbsInactive)) then
|
|
||||||
begin
|
|
||||||
{$IFDEF RX_D4}
|
|
||||||
FDrawImage.Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
|
|
||||||
{$ELSE}
|
|
||||||
if Pattern = nil then
|
|
||||||
Pattern := CreateTwoColorsBrushPattern(clBtnFace, clBtnHighlight);
|
|
||||||
FDrawImage.Canvas.Brush.Bitmap := Pattern;
|
|
||||||
{$ENDIF}
|
|
||||||
InflateRect(PaintRect, 1, 1);
|
|
||||||
FDrawImage.Canvas.FillRect(PaintRect);
|
|
||||||
InflateRect(PaintRect, -1, -1);
|
|
||||||
end;
|
|
||||||
if FState in [rbsDown, rbsExclusive] then OffsetRect(PaintRect, 1, 1);
|
|
||||||
if (FState = rbsDisabled) or not FInactiveGrayed then AState := FState;
|
|
||||||
PaintGlyph(FDrawImage.Canvas, PaintRect, AState, FMarkDropDown and
|
|
||||||
Assigned(FDropDownMenu));
|
|
||||||
Canvas.Draw(0, 0, FDrawImage);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.Notification(AComponent: TComponent;
|
|
||||||
Operation: TOperation);
|
|
||||||
begin
|
|
||||||
inherited Notification(AComponent, Operation);
|
|
||||||
if (AComponent = DropDownMenu) and (Operation = opRemove) then
|
|
||||||
DropDownMenu := nil;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetDropDownMenuPos: TPoint;
|
|
||||||
begin
|
|
||||||
if Assigned(FDropDownMenu) then begin
|
|
||||||
if MenuPosition = dmpBottom then begin
|
|
||||||
case FDropDownMenu.Alignment of
|
|
||||||
paLeft: Result := Point(-1, Height);
|
|
||||||
paRight: Result := Point(Width + 1, Height);
|
|
||||||
else {paCenter} Result := Point(Width div 2, Height);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else { dmpRight } begin
|
|
||||||
case FDropDownMenu.Alignment of
|
|
||||||
paLeft: Result := Point(Width, -1);
|
|
||||||
paRight: Result := Point(-1, -1);
|
|
||||||
else {paCenter} Result := Point(Width div 2, Height);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end else Result := Point(0, 0);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.CheckBtnMenuDropDown: Boolean;
|
|
||||||
begin
|
|
||||||
Result := CheckMenuDropDown(
|
|
||||||
{$IFDEF WIN32}PointToSmallPoint(GetDropDownMenuPos){$ELSE}
|
|
||||||
GetDropDownMenuPos{$ENDIF}, True);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.CheckMenuDropDown(const Pos: TSmallPoint;
|
|
||||||
Manual: Boolean): Boolean;
|
|
||||||
var
|
|
||||||
Form: TCustomForm;
|
|
||||||
begin
|
|
||||||
Result := False;
|
|
||||||
if csDesigning in ComponentState then Exit;
|
|
||||||
if Assigned(FDropDownMenu) and (DropDownMenu.AutoPopup or Manual) then
|
|
||||||
begin
|
|
||||||
Form := GetParentForm(Self);
|
|
||||||
if Form <> nil then Form.SendCancelMode(nil);
|
|
||||||
DropDownMenu.PopupComponent := Self;
|
|
||||||
with ClientToScreen(SmallPointToPoint(Pos)) do DropDownMenu.Popup(X, Y);
|
|
||||||
Result := True;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.MouseEnter;
|
|
||||||
begin
|
|
||||||
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.MouseLeave;
|
|
||||||
begin
|
|
||||||
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
||||||
X, Y: Integer);
|
|
||||||
var
|
|
||||||
P: TPoint;
|
|
||||||
Msg: TMsg;
|
|
||||||
begin
|
|
||||||
if FMenuTracking then Exit;
|
|
||||||
inherited MouseDown(Button, Shift, X, Y);
|
|
||||||
if (not FMouseInControl) and Enabled then begin
|
|
||||||
FMouseInControl := True;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
if (Button = mbLeft) and Enabled {and not (ssDouble in Shift)} then begin
|
|
||||||
if not FDown then begin
|
|
||||||
FState := rbsDown;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
FDragging := True;
|
|
||||||
FMenuTracking := True;
|
|
||||||
try
|
|
||||||
P := GetDropDownMenuPos;
|
|
||||||
if CheckMenuDropDown(PointToSmallPoint(P), False) then
|
|
||||||
DoMouseUp(Button, Shift, X, Y);
|
|
||||||
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin
|
|
||||||
if (Msg.Message = WM_LBUTTONDOWN) or (Msg.Message = WM_LBUTTONDBLCLK) then
|
|
||||||
begin
|
|
||||||
P := ScreenToClient(Msg.Pt);
|
|
||||||
if (P.X >= 0) and (P.X < ClientWidth) and (P.Y >= 0)
|
|
||||||
and (P.Y <= ClientHeight) then KillMessage(0, Msg.Message);
|
|
||||||
{PeekMessage(Msg, 0, 0, 0, PM_REMOVE);}
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
finally
|
|
||||||
FMenuTracking := False;
|
|
||||||
end;
|
|
||||||
if FAllowTimer then begin
|
|
||||||
if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self);
|
|
||||||
FRepeatTimer.Interval := InitPause;
|
|
||||||
FRepeatTimer.OnTimer := TimerExpired;
|
|
||||||
FRepeatTimer.Enabled := True;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
||||||
var
|
|
||||||
NewState: TRxButtonState;
|
|
||||||
begin
|
|
||||||
inherited MouseMove(Shift, X, Y);
|
|
||||||
if FDragging then begin
|
|
||||||
if not FDown then NewState := rbsUp
|
|
||||||
else NewState := rbsExclusive;
|
|
||||||
if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
|
|
||||||
if FDown then NewState := rbsExclusive else NewState := rbsDown;
|
|
||||||
if NewState <> FState then begin
|
|
||||||
FState := NewState;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
||||||
X, Y: Integer);
|
|
||||||
begin
|
|
||||||
inherited MouseUp(Button, Shift, X, Y);
|
|
||||||
DoMouseUp(Button, Shift, X, Y);
|
|
||||||
if FRepeatTimer <> nil then FRepeatTimer.Enabled := False;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
||||||
X, Y: Integer);
|
|
||||||
var
|
|
||||||
DoClick: Boolean;
|
|
||||||
begin
|
|
||||||
if FDragging and (Button = mbLeft) then begin
|
|
||||||
FDragging := False;
|
|
||||||
DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
|
|
||||||
if FGroupIndex = 0 then begin
|
|
||||||
FState := rbsUp;
|
|
||||||
FMouseInControl := False;
|
|
||||||
if DoClick and not (FState in [rbsExclusive, rbsDown]) then
|
|
||||||
Repaint
|
|
||||||
else Invalidate;
|
|
||||||
end
|
|
||||||
else if DoClick then begin
|
|
||||||
SetDown(not FDown);
|
|
||||||
if FDown then Repaint;
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
if FDown then FState := rbsExclusive;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
if DoClick and not FMenuTracking then Click;
|
|
||||||
end;
|
|
||||||
UpdateTracking;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.ButtonClick;
|
|
||||||
var
|
|
||||||
FirstTickCount, Now: Longint;
|
|
||||||
begin
|
|
||||||
if FMenuTracking or (not Enabled) or (Assigned(FDropDownMenu) and
|
|
||||||
DropDownMenu.AutoPopup) then Exit;
|
|
||||||
if not FDown then begin
|
|
||||||
FState := rbsDown;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
try
|
|
||||||
FirstTickCount := GetTickCount;
|
|
||||||
repeat
|
|
||||||
Now := GetTickCount;
|
|
||||||
until (Now - FirstTickCount >= 20) or (Now < FirstTickCount);
|
|
||||||
if FGroupIndex = 0 then Click;
|
|
||||||
finally
|
|
||||||
FState := rbsUp;
|
|
||||||
if FGroupIndex = 0 then Repaint
|
|
||||||
else begin
|
|
||||||
SetDown(not FDown);
|
|
||||||
Click;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.Click;
|
|
||||||
var
|
|
||||||
Form: TCustomForm;
|
|
||||||
begin
|
|
||||||
Form := GetParentForm(Self);
|
|
||||||
if Form <> nil then Form.ModalResult := ModalResult;
|
|
||||||
inherited Click;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetPalette: HPALETTE;
|
|
||||||
begin
|
|
||||||
Result := Glyph.Palette;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetWordWrap: Boolean;
|
|
||||||
begin
|
|
||||||
Result := TRxButtonGlyph(FGlyph).WordWrap;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetWordWrap(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if Value <> WordWrap then begin
|
|
||||||
TRxButtonGlyph(FGlyph).WordWrap := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetAlignment: TAlignment;
|
|
||||||
begin
|
|
||||||
Result := TRxButtonGlyph(FGlyph).Alignment;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetAlignment(Value: TAlignment);
|
|
||||||
begin
|
|
||||||
if Alignment <> Value then begin
|
|
||||||
TRxButtonGlyph(FGlyph).Alignment := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetGlyph: TBitmap;
|
|
||||||
begin
|
|
||||||
Result := TRxButtonGlyph(FGlyph).Glyph;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetGlyph(Value: TBitmap);
|
|
||||||
begin
|
|
||||||
TRxButtonGlyph(FGlyph).Glyph := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TRxSpeedButton.GetNumGlyphs: TRxNumGlyphs;
|
|
||||||
begin
|
|
||||||
Result := TRxButtonGlyph(FGlyph).NumGlyphs;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetNumGlyphs(Value: TRxNumGlyphs);
|
|
||||||
begin
|
|
||||||
if Value < 0 then Value := 1
|
|
||||||
else if Value > Ord(High(TRxButtonState)) + 1 then
|
|
||||||
Value := Ord(High(TRxButtonState)) + 1;
|
|
||||||
if Value <> TRxButtonGlyph(FGlyph).NumGlyphs then begin
|
|
||||||
TRxButtonGlyph(FGlyph).NumGlyphs := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.GlyphChanged(Sender: TObject);
|
|
||||||
begin
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.UpdateExclusive;
|
|
||||||
var
|
|
||||||
Msg: TMessage;
|
|
||||||
begin
|
|
||||||
if (FGroupIndex <> 0) and (Parent <> nil) then begin
|
|
||||||
Msg.Msg := CM_RXBUTTONPRESSED;
|
|
||||||
Msg.WParam := FGroupIndex;
|
|
||||||
Msg.LParam := Longint(Self);
|
|
||||||
Msg.Result := 0;
|
|
||||||
Parent.Broadcast(Msg);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetDown(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if FGroupIndex = 0 then Value := False;
|
|
||||||
if Value <> FDown then begin
|
|
||||||
if FDown and (not FAllowAllUp) then Exit;
|
|
||||||
FDown := Value;
|
|
||||||
if Value then begin
|
|
||||||
if FState = rbsUp then Invalidate;
|
|
||||||
FState := rbsExclusive;
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
FState := rbsUp;
|
|
||||||
end;
|
|
||||||
Repaint;
|
|
||||||
if Value then UpdateExclusive;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetGroupIndex(Value: Integer);
|
|
||||||
begin
|
|
||||||
if FGroupIndex <> Value then begin
|
|
||||||
FGroupIndex := Value;
|
|
||||||
UpdateExclusive;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetLayout(Value: TButtonLayout);
|
|
||||||
begin
|
|
||||||
if FLayout <> Value then begin
|
|
||||||
FLayout := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetMargin(Value: Integer);
|
|
||||||
begin
|
|
||||||
if (Value <> FMargin) and (Value >= -1) then begin
|
|
||||||
FMargin := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetSpacing(Value: Integer);
|
|
||||||
begin
|
|
||||||
if Value <> FSpacing then begin
|
|
||||||
FSpacing := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetAllowAllUp(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if FAllowAllUp <> Value then begin
|
|
||||||
FAllowAllUp := Value;
|
|
||||||
UpdateExclusive;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetAllowTimer(Value: Boolean);
|
|
||||||
begin
|
|
||||||
FAllowTimer := Value;
|
|
||||||
if not FAllowTimer and (FRepeatTimer <> nil) then begin
|
|
||||||
FRepeatTimer.Enabled := False;
|
|
||||||
FRepeatTimer.Free;
|
|
||||||
FRepeatTimer := nil;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetDropDownMenu(Value: TPopupMenu);
|
|
||||||
begin
|
|
||||||
FDropDownMenu := Value;
|
|
||||||
{$IFDEF WIN32}
|
|
||||||
if Value <> nil then Value.FreeNotification(Self);
|
|
||||||
{$ENDIF}
|
|
||||||
if FMarkDropDown then Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetInactiveGrayed(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if Value <> FInactiveGrayed then begin
|
|
||||||
FInactiveGrayed := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetFlat(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if Value <> FFlat then begin
|
|
||||||
FFlat := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetStyle(Value: TButtonStyle);
|
|
||||||
begin
|
|
||||||
if Style <> Value then begin
|
|
||||||
FStyle := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetMarkDropDown(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if Value <> FMarkDropDown then begin
|
|
||||||
FMarkDropDown := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.SetTransparent(Value: Boolean);
|
|
||||||
begin
|
|
||||||
if Value <> FTransparent then begin
|
|
||||||
FTransparent := Value;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.WMRButtonDown(var Message: TWMRButtonDown);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
UpdateTracking;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.WMRButtonUp(var Message: TWMRButtonUp);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
UpdateTracking;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
|
|
||||||
begin
|
|
||||||
if not FMenuTracking then begin
|
|
||||||
inherited;
|
|
||||||
if FDown then DblClick;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMEnabledChanged(var Message: TMessage);
|
|
||||||
var
|
|
||||||
State: TRxButtonState;
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
if Enabled then begin
|
|
||||||
if Flat then State := rbsInactive
|
|
||||||
else State := rbsUp;
|
|
||||||
end else State := rbsDisabled;
|
|
||||||
TRxButtonGlyph(FGlyph).CreateButtonGlyph(State);
|
|
||||||
UpdateTracking;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMVisibleChanged(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
if Visible then UpdateTracking;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMMouseEnter(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
if (not FMouseInControl) and Enabled and IsForegroundTask then begin
|
|
||||||
FMouseInControl := True;
|
|
||||||
if FFlat then Repaint;
|
|
||||||
MouseEnter;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMMouseLeave(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
if FMouseInControl and Enabled and not FDragging then begin
|
|
||||||
FMouseInControl := False;
|
|
||||||
if FFlat then Invalidate;
|
|
||||||
MouseLeave;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.WMMouseMove(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMButtonPressed(var Message: TMessage);
|
|
||||||
var
|
|
||||||
Sender: TControl;
|
|
||||||
begin
|
|
||||||
if (Message.WParam = FGroupIndex) and Parent.HandleAllocated then begin
|
|
||||||
Sender := TControl(Message.LParam);
|
|
||||||
if (Sender <> nil) and (Sender is TRxSpeedButton) then
|
|
||||||
if Sender <> Self then begin
|
|
||||||
if TRxSpeedButton(Sender).Down and FDown then begin
|
|
||||||
FDown := False;
|
|
||||||
FState := rbsUp;
|
|
||||||
Repaint;
|
|
||||||
end;
|
|
||||||
FAllowAllUp := TRxSpeedButton(Sender).AllowAllUp;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMDialogChar(var Message: TCMDialogChar);
|
|
||||||
begin
|
|
||||||
with Message do
|
|
||||||
if IsAccel(CharCode, Caption) and Enabled then begin
|
|
||||||
Click;
|
|
||||||
Result := 1;
|
|
||||||
end
|
|
||||||
else inherited;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMFontChanged(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMTextChanged(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.CMSysColorChange(var Message: TMessage);
|
|
||||||
begin
|
|
||||||
TRxButtonGlyph(FGlyph).Invalidate;
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.UpdateTracking;
|
|
||||||
var
|
|
||||||
P: TPoint;
|
|
||||||
OldValue: Boolean;
|
|
||||||
begin
|
|
||||||
OldValue := FMouseInControl;
|
|
||||||
GetCursorPos(P);
|
|
||||||
FMouseInControl := Enabled and (FindDragTarget(P, True) = Self) and
|
|
||||||
IsForegroundTask;
|
|
||||||
if (FMouseInControl <> OldValue) then
|
|
||||||
if FMouseInControl then begin
|
|
||||||
if Flat then Repaint;
|
|
||||||
MouseEnter;
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
if Flat then Invalidate;
|
|
||||||
MouseLeave;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TRxSpeedButton.TimerExpired(Sender: TObject);
|
|
||||||
begin
|
|
||||||
FRepeatTimer.Interval := RepeatInterval;
|
|
||||||
if (FState = rbsDown) and MouseCapture then
|
|
||||||
try
|
|
||||||
Click;
|
|
||||||
except
|
|
||||||
FRepeatTimer.Enabled := False;
|
|
||||||
raise;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$IFDEF RX_D4}
|
|
||||||
procedure TRxSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
||||||
|
|
||||||
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
|
|
||||||
begin
|
|
||||||
with Glyph do begin
|
|
||||||
Width := ImageList.Width;
|
|
||||||
Height := ImageList.Height;
|
|
||||||
Canvas.Brush.Color := clFuchsia;
|
|
||||||
Canvas.FillRect(Rect(0, 0, Width, Height));
|
|
||||||
ImageList.Draw(Canvas, 0, 0, Index);
|
|
||||||
TransparentColor := clFuchsia;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
inherited ActionChange(Sender, CheckDefaults);
|
|
||||||
if Sender is TCustomAction then
|
|
||||||
with TCustomAction(Sender) do begin
|
|
||||||
if (not CheckDefaults or (Self.Down = False)) and (FGroupIndex <> 0) then
|
|
||||||
Self.Down := Checked;
|
|
||||||
if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
|
|
||||||
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
|
|
||||||
CopyImage(ActionList.Images, ImageIndex);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$ENDIF RX_D4}
|
{$ENDIF RX_D4}
|
||||||
|
|
||||||
{$IFDEF WIN32}
|
{$IFDEF WIN32}
|
||||||
@ -5142,4 +4338,67 @@ initialization
|
|||||||
AddExitProc(DestroyLocals);
|
AddExitProc(DestroyLocals);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
{ TRxSpeedButton }
|
||||||
|
|
||||||
|
procedure TRxSpeedButton.SetAllowTimer(const AValue: Boolean);
|
||||||
|
begin
|
||||||
|
if FAllowTimer=AValue then exit;
|
||||||
|
FAllowTimer:=AValue;
|
||||||
|
if not FAllowTimer and (FRepeatTimer <> nil) then
|
||||||
|
begin
|
||||||
|
FRepeatTimer.Enabled := False;
|
||||||
|
FRepeatTimer.Free;
|
||||||
|
FRepeatTimer := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxSpeedButton.TimerExpired(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FRepeatTimer.Interval := RepeatInterval;
|
||||||
|
if (FState = bsDown) and MouseCapture then
|
||||||
|
try
|
||||||
|
Click;
|
||||||
|
except
|
||||||
|
FRepeatTimer.Enabled := False;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
inherited MouseDown(Button, Shift, X, Y);
|
||||||
|
if (Button = mbLeft) and Enabled then
|
||||||
|
begin
|
||||||
|
if FAllowTimer then begin
|
||||||
|
if FRepeatTimer = nil then
|
||||||
|
FRepeatTimer := TTimer.Create(nil);
|
||||||
|
FRepeatTimer.Interval := InitPause;
|
||||||
|
FRepeatTimer.OnTimer := @TimerExpired;
|
||||||
|
FRepeatTimer.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
inherited MouseUp(Button, Shift, X, Y);
|
||||||
|
if FRepeatTimer <> nil then FRepeatTimer.Enabled := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TRxSpeedButton.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FInitRepeatPause := 500;
|
||||||
|
FRepeatPause := 100;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TRxSpeedButton.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
if FRepeatTimer <> nil then FRepeatTimer.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
@ -162,7 +162,6 @@ resourcestring
|
|||||||
SUnknownFieldType = 'SUnknownFieldType %s';
|
SUnknownFieldType = 'SUnknownFieldType %s';
|
||||||
SFieldReadOnly = 'SFieldReadOnly %s';
|
SFieldReadOnly = 'SFieldReadOnly %s';
|
||||||
|
|
||||||
|
|
||||||
const
|
const
|
||||||
{ The following strings should not be localized }
|
{ The following strings should not be localized }
|
||||||
sAction = '.Action';
|
sAction = '.Action';
|
||||||
|
|||||||
@ -8,7 +8,7 @@
|
|||||||
<Version Value="5"/>
|
<Version Value="5"/>
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<CodeGeneration>
|
||||||
<Generate Value="Faster"/>
|
<Generate Value="Faster"/>
|
||||||
@ -24,7 +24,7 @@ translate to Lazarus by alexs in 2005 - 2007
|
|||||||
<License Value="free ware
|
<License Value="free ware
|
||||||
"/>
|
"/>
|
||||||
<Version Major="1" Minor="1" Release="5" Build="98"/>
|
<Version Major="1" Minor="1" Release="5" Build="98"/>
|
||||||
<Files Count="44">
|
<Files Count="45">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="rxlookup.pas"/>
|
<Filename Value="rxlookup.pas"/>
|
||||||
<UnitName Value="rxlookup"/>
|
<UnitName Value="rxlookup"/>
|
||||||
@ -200,23 +200,27 @@ translate to Lazarus by alexs in 2005 - 2007
|
|||||||
</Item43>
|
</Item43>
|
||||||
<Item44>
|
<Item44>
|
||||||
<Filename Value="rxceeditlookupfields.pas"/>
|
<Filename Value="rxceeditlookupfields.pas"/>
|
||||||
<UnitName Value="rxceeditlookupfields"/>
|
<UnitName Value="rxceEditLookupFields"/>
|
||||||
</Item44>
|
</Item44>
|
||||||
|
<Item45>
|
||||||
|
<Filename Value="rxclock.pas"/>
|
||||||
|
<UnitName Value="RXClock"/>
|
||||||
|
</Item45>
|
||||||
</Files>
|
</Files>
|
||||||
<Type Value="RunAndDesignTime"/>
|
<Type Value="RunAndDesignTime"/>
|
||||||
<RequiredPkgs Count="4">
|
<RequiredPkgs Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="rx"/>
|
|
||||||
</Item1>
|
|
||||||
<Item2>
|
|
||||||
<PackageName Value="LCL"/>
|
|
||||||
</Item2>
|
|
||||||
<Item3>
|
|
||||||
<PackageName Value="IDEIntf"/>
|
|
||||||
</Item3>
|
|
||||||
<Item4>
|
|
||||||
<PackageName Value="FCL"/>
|
<PackageName Value="FCL"/>
|
||||||
<MinVersion Major="1" Valid="True"/>
|
<MinVersion Major="1" Valid="True"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="rx"/>
|
||||||
</Item4>
|
</Item4>
|
||||||
</RequiredPkgs>
|
</RequiredPkgs>
|
||||||
<UsageOptions>
|
<UsageOptions>
|
||||||
|
|||||||
Reference in New Issue
Block a user