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
|
||||
(see Demos/RxDBGrid)
|
||||
- minor fix in filter combobox in RxDBGrid for GTK and GTK2
|
||||
+ TRxSpeedButton and TRxClock
|
||||
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
||||
+ In RxDBgrid - after close dataset list of SelectedRows is cleared
|
||||
+ fix resaizing find form for RxDbGrd
|
||||
|
||||
@ -32,6 +32,7 @@
|
||||
+ � RxDBGrid ���������� �������� ��� ����� ���� ftDate, ftDateTime �� ������� TRxDateEdit
|
||||
(��. Demos/RxDBGrid)
|
||||
+ ��������� ���������� � RxDBGrid ��� GTK � GTK2
|
||||
+ ���������� ���������� TRxSpeedButton � TRxClock
|
||||
29.08.2007 - ������ 1.1.5.98 (svn revision 39)
|
||||
+ � 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
|
||||
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;
|
||||
property Date:TDateTime read GetDate write SetDate;
|
||||
property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
|
||||
property Calendar: TCustomRxCalendar read FCalendar;
|
||||
end;
|
||||
|
||||
{ TSelectDateDlg }
|
||||
@ -286,11 +287,11 @@ end;
|
||||
{ TRxTimerSpeedButton }
|
||||
|
||||
type
|
||||
TRxTimerSpeedButton = class(TSpeedButton)
|
||||
TRxTimerSpeedButton = class(TRxSpeedButton)
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
// property AllowTimer default True;
|
||||
property AllowTimer default True;
|
||||
// property Style default bsWin31;
|
||||
end;
|
||||
|
||||
@ -298,7 +299,7 @@ constructor TRxTimerSpeedButton.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
// Style := bsWin31;
|
||||
// AllowTimer := True;
|
||||
AllowTimer := True;
|
||||
ControlStyle := ControlStyle + [csReplicatable];
|
||||
end;
|
||||
|
||||
|
||||
@ -5,6 +5,8 @@
|
||||
{$DEFINE HASVARIANT}
|
||||
{.$DEFINE ENABLE_Child_Defs}
|
||||
{$DEFINE NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID}
|
||||
{$DEFINE RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT}
|
||||
{.$DEFINE RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT}
|
||||
{.$DEFINE USED_BiDi}
|
||||
{$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
|
||||
+#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;
|
||||
end;
|
||||
|
||||
(*
|
||||
{ TRxSpeedButton }
|
||||
(*
|
||||
|
||||
TRxNumGlyphs = 1..5;
|
||||
TRxDropDownMenuPos = (dmpBottom, dmpRight);
|
||||
TRxButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);
|
||||
*)
|
||||
|
||||
TRxSpeedButton = class(TGraphicControl)
|
||||
TRxSpeedButton = class(TSpeedButton)
|
||||
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;
|
||||
FInitRepeatPause: Word;
|
||||
FRepeatPause: Word;
|
||||
FOnMouseEnter: TNotifyEvent;
|
||||
FOnMouseLeave: TNotifyEvent;
|
||||
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);
|
||||
FRepeatTimer: TTimer;
|
||||
procedure SetAllowTimer(const AValue: Boolean);
|
||||
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
|
||||
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;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
property ButtonGlyph: Pointer read FGlyph;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ButtonClick;
|
||||
function CheckBtnMenuDropDown: Boolean;
|
||||
procedure Click; override;
|
||||
procedure UpdateTracking;
|
||||
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 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 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 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;
|
||||
|
||||
(*
|
||||
{ TButtonImage }
|
||||
|
||||
TButtonImage = class(TObject)
|
||||
@ -2864,9 +2731,9 @@ end;
|
||||
procedure TRxCustomLabel.SetFocusControl(Value: TWinControl);
|
||||
begin
|
||||
FFocusControl := Value;
|
||||
{$IFDEF WIN32}
|
||||
{.$IFDEF WIN32}
|
||||
if Value <> nil then Value.FreeNotification(Self);
|
||||
{$ENDIF}
|
||||
{.$ENDIF}
|
||||
if FShowFocus then Invalidate;
|
||||
end;
|
||||
|
||||
@ -4458,677 +4325,6 @@ begin
|
||||
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}
|
||||
|
||||
{$IFDEF WIN32}
|
||||
@ -5142,4 +4338,67 @@ initialization
|
||||
AddExitProc(DestroyLocals);
|
||||
{$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.
|
||||
|
||||
@ -162,7 +162,6 @@ resourcestring
|
||||
SUnknownFieldType = 'SUnknownFieldType %s';
|
||||
SFieldReadOnly = 'SFieldReadOnly %s';
|
||||
|
||||
|
||||
const
|
||||
{ The following strings should not be localized }
|
||||
sAction = '.Action';
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
@ -24,7 +24,7 @@ translate to Lazarus by alexs in 2005 - 2007
|
||||
<License Value="free ware
|
||||
"/>
|
||||
<Version Major="1" Minor="1" Release="5" Build="98"/>
|
||||
<Files Count="44">
|
||||
<Files Count="45">
|
||||
<Item1>
|
||||
<Filename Value="rxlookup.pas"/>
|
||||
<UnitName Value="rxlookup"/>
|
||||
@ -200,23 +200,27 @@ translate to Lazarus by alexs in 2005 - 2007
|
||||
</Item43>
|
||||
<Item44>
|
||||
<Filename Value="rxceeditlookupfields.pas"/>
|
||||
<UnitName Value="rxceeditlookupfields"/>
|
||||
<UnitName Value="rxceEditLookupFields"/>
|
||||
</Item44>
|
||||
<Item45>
|
||||
<Filename Value="rxclock.pas"/>
|
||||
<UnitName Value="RXClock"/>
|
||||
</Item45>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="rx"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="rx"/>
|
||||
</Item4>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
|
||||
Reference in New Issue
Block a user