diff --git a/components/rx/docs/WhatsNew.eng.txt b/components/rx/docs/WhatsNew.eng.txt index 711c3627f..0f4e6f1a4 100644 --- a/components/rx/docs/WhatsNew.eng.txt +++ b/components/rx/docs/WhatsNew.eng.txt @@ -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 diff --git a/components/rx/docs/WhatsNew.rus.txt b/components/rx/docs/WhatsNew.rus.txt index 1d392a0b4..a7eb27fa5 100644 --- a/components/rx/docs/WhatsNew.rus.txt +++ b/components/rx/docs/WhatsNew.rus.txt @@ -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) очищается diff --git a/components/rx/images/TRxClock.bmp b/components/rx/images/TRxClock.bmp new file mode 100644 index 000000000..58e6500ad Binary files /dev/null and b/components/rx/images/TRxClock.bmp differ diff --git a/components/rx/images/TRxSpeedButton.bmp b/components/rx/images/TRxSpeedButton.bmp new file mode 100644 index 000000000..e7279f8fb Binary files /dev/null and b/components/rx/images/TRxSpeedButton.bmp differ diff --git a/components/rx/images/mk_res.bat b/components/rx/images/mk_res.bat index c3da31771..0b1def421 100644 --- a/components/rx/images/mk_res.bat +++ b/components/rx/images/mk_res.bat @@ -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 diff --git a/components/rx/pickdate.pas b/components/rx/pickdate.pas index 247c886e8..49d078ab2 100644 --- a/components/rx/pickdate.pas +++ b/components/rx/pickdate.pas @@ -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; diff --git a/components/rx/rx.inc b/components/rx/rx.inc index a2bf84224..61382e877 100644 --- a/components/rx/rx.inc +++ b/components/rx/rx.inc @@ -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} diff --git a/components/rx/rx.lrs b/components/rx/rx.lrs index 6274a9da9..db80657f1 100644 --- a/components/rx/rx.lrs +++ b/components/rx/rx.lrs @@ -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' +]); diff --git a/components/rx/rxclock.pas b/components/rx/rxclock.pas new file mode 100644 index 000000000..2997d6f03 --- /dev/null +++ b/components/rx/rxclock.pas @@ -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. diff --git a/components/rx/rxctrls.pas b/components/rx/rxctrls.pas index 645723850..24ea4da63 100644 --- a/components/rx/rxctrls.pas +++ b/components/rx/rxctrls.pas @@ -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. diff --git a/components/rx/rxdconst.pas b/components/rx/rxdconst.pas index a7331b353..600bd3c97 100644 --- a/components/rx/rxdconst.pas +++ b/components/rx/rxdconst.pas @@ -162,7 +162,6 @@ resourcestring SUnknownFieldType = 'SUnknownFieldType %s'; SFieldReadOnly = 'SFieldReadOnly %s'; - const { The following strings should not be localized } sAction = '.Action'; diff --git a/components/rx/rxnew.lpk b/components/rx/rxnew.lpk index a8317ede7..519fc0883 100644 --- a/components/rx/rxnew.lpk +++ b/components/rx/rxnew.lpk @@ -8,7 +8,7 @@ - + @@ -24,7 +24,7 @@ translate to Lazarus by alexs in 2005 - 2007 - + @@ -200,23 +200,27 @@ translate to Lazarus by alexs in 2005 - 2007 - + + + + + - - - - - - - - - + + + + + + + + +