You've already forked lazarus-ccr
new components, fix in RxCalendarGrid from Edward Ivanov
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@703 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
@ -10,6 +10,8 @@
|
||||
+ У компоненты TRxDateEdit добавлено свойствой - ValidDate. Определяет коректность введённой даты.
|
||||
+ Добавлена два исходных компонента: TRxSpinButton и TRxSpinEdit (автор порта - Edward Ivanov)
|
||||
- исправлены глифы у TRxClock, TRxDateEdit, TAutoPanel (Edward Ivanov)
|
||||
- Исправления в TRxDatePicker (Edward Ivanov)
|
||||
+ Добавлены компоненты TRxDBSpinEdit, TRxTimeEdit, TRxDBTimeEdit
|
||||
22.05.2008 - версия 2.0.0.136 (svn revision 100)
|
||||
+ У объекта TRxCustomDBLookupCombo введён контроль на CircularDataLink
|
||||
+ У объекта TRxCustomDBLookupCombo ускорена отрисовка данных
|
||||
|
||||
BIN
components/rx/images/TRXDBSpinEdit.png
Normal file
BIN
components/rx/images/TRXDBSpinEdit.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 564 B |
BIN
components/rx/images/TRxDBTimeEdit.png
Normal file
BIN
components/rx/images/TRxDBTimeEdit.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 493 B |
BIN
components/rx/images/TRxTimeEdit.png
Normal file
BIN
components/rx/images/TRxTimeEdit.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 418 B |
@ -1,2 +1,2 @@
|
||||
del rx.lrs
|
||||
D:\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 TRxSpinButton.png TRxSpinEdit.png
|
||||
D:\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 TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
rm rx.lrs
|
||||
/usr/local/share/lazarus/tools/lazres 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.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png
|
||||
/usr/local/share/lazarus/tools/lazres 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.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png
|
||||
|
||||
|
||||
@ -453,3 +453,69 @@ LazarusResources.Add('TRxSpinEdit','PNG',[
|
||||
+'T'#15#160'z4'#159#3#168's'#181'>'#192#191#169#220'9'#185#245#10#158'vWe'#213
|
||||
+'GM'#130#23#211'$E'#25#128#18#229'#'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRXDBSpinEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1#230'IDATH'#137#205
|
||||
+#148#193'j'#19'Q'#24#133#191'2'#142'+)}'#129#190'D'#23#226'"P_A'#220#187#200
|
||||
+'n'#210#216'M'#7#178'(C'#9']T"*'#212'd#]'#248#12'n'#5#145','#220#139'o'#224
|
||||
+#170#22#196#166#134#218'af'#174#139#206#157#220#153';'#153#220#22#4#15#4#238
|
||||
+''#239#253#207#185'9'#255'a'#224#31'C'#244'"'#12'C'#165#215#211#233'T@'#169
|
||||
+#230#150#178'U'#218#207#13#132'a'#168#148#162#252#153'b'#205'X'''#222'B'#190
|
||||
+'JD)'#147#212']'#192#3#232#247#195#202'f'#189#6#16#145#194'6Mn'#174'm'#232#7
|
||||
+#249#0#147#201#180'BZ'#175'M'#153'*'#233#234'9'#220'<'#168#16#208#164'n'#208
|
||||
+'"nC'#22#237#181')'#160'_'#191#189#253#208'Q'#180#25#189#222'3i'#181#232#219
|
||||
+#215#217#157#201#15#15'cz'#189'5'#22#189'z'#243#206#218'K'#146#132' '#8#0#200
|
||||
+#178#12'gh'#221'Q'#179'1'#243'_'#223#129'B'#160#223#15#27'-jB'#16#4#229#4
|
||||
+#252#157'!'#217#231#23#214#29#233'F\|x'#190#20'Xe'#209#163#193#167'J'#227#151
|
||||
+#147#199#0#228#10':'#197#136#207#206#23#0'D'#251#3#198'/O,'#177'V'#139'4a]'
|
||||
+#168#227'-'#215#151#243#5#163#209#176#20#137#227'c['#160#205'"M'#174#197#234
|
||||
+#184#248#249#155#189#221#131'JmB'#160#250#161#211'x'#253'vB '#235#5#164#27'Y'
|
||||
+'{z'#200#27#155'['#226#129#157'wWr'#23#148'3'#184'/a\'#196#178#227#216','
|
||||
+#221#200'-E'#26'JA'#206'2!.8;_'#16#237#15#202#186#158'$'#207',D '#184#5'9'
|
||||
+#220#164'H'''''#142#143#185#156'/*'#231#149''#224#145#146#233#173'|'#233'}Z'
|
||||
+#156#231')x'#2#190#225#161'N'#205#222#238#129#149' K@'#169#28'H'#16#229#225
|
||||
+'y>Y'#14'H'#138#200#21#29#30#212'nC:'#27#225'wc'#139#244#207#199'#'#174#175
|
||||
+'~'#0'ELOO'#223#171#167'O'#238#158#148'U'#216#216#220#186#165#225#255'#'#254
|
||||
+#2#182'2'#241'd'#141']'#3'd'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxTimeEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1'TIDATH'#137#237'TAN'
|
||||
+#195'0'#16#156')'#136'7'#181#183#210#15' '#238'H'#28'zm'#223#144#245#7#16#18
|
||||
+#220'P+'#193'C'#218'T'#28#224#140#248#13#18#195'!'#177#177#235#196'mQ'#17#23
|
||||
+'F'#178'6'#235#216#187#179';'#155#0#255#248'k'#16#0'$i'#185'|'#250#149#4#167
|
||||
+#177#243#254#246'|'#212#224#23#151'Wi'#2#0#184#185'}8Z'#130#205'f'#131'A'#223
|
||||
+#203#209'|'#157#216']'#251#30'$'#19#191'7'#193'Op'#194#179',Ig'#2#146'x'#189
|
||||
+#159'$'#150'd'#198'>'#174#130'$>'#241#145#248#1#146#180'X<'#10#128#26#183'Yf'
|
||||
+'&3'#11#254#247'{i8[i'#23#234#186'V'#16'y:'#189'n'#147#245#183'@'#2#200#134
|
||||
+#221'p'#182#194'h'#190#198#203#221'9'#156's'#157#231#199#227'q3E$C`'#231#12
|
||||
+'Ue'#0#16#172#135's'#6#201#218#22'L'#160#18#155#140#156#242'e='#251#190']'
|
||||
+#251#180'h'#208#6#135'sV'#166#144'U'#146#10#233#7'!^E'#246#187'*'#232#170#2
|
||||
+'H'#7'!'#136#236#217#199'=wL'#173'G'#149'T'#155'V-'#169#213'S'#217#254'Q*'
|
||||
+#232#210#128#177#6#219'SS'#210#160#170#12'$P'#215'u'#241#172'o'#192'!'#19#215
|
||||
+'\dr'#191#23#217#175#162'4M'#135'LZ '#18'='#11'H'#191#228'.'#241#227#201#220
|
||||
+'''A\'#1#183#2#228'l'#14#12'^:'#216#167#200#222#129'='#190#0'q'#209'z'#166'R'
|
||||
+'2h'#222#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxDBTimeEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1#159'IDATH'#137#181'V'
|
||||
+'1N'#195'0'#20'}?'#148'r'#131'\'#164#3'e3''@'#236#136#165'bq'#138#16'G'#232
|
||||
+#196'X!'#154','#168#11#7')'#223',='#6'Co'#193#242#25#26#187#174'c;'#141#16'O'
|
||||
+#138#226#196#254#239#253#255'l'#199#1#254#25'd'#27'Zk'#177#237#166'i'#8#16
|
||||
+#137#135#184'P'#202#247'{'#208'Z'#139#8#220#229#139#197#209''''#158'!'#207
|
||||
+#139#136't'#175'<'#200#18#213'u'#227'^V'#149#6#0'L&'#151#157#128#217#236#222
|
||||
+#181#215#235#143#222#2'Hk-u'#221'8R+VU'#26#23#231'?'#209#160#229#235';'#158
|
||||
+#159#30'z'#201'on'#239#242#22#253#21#204','#133'oIh'#17#0'\=~'#30#245#217#231
|
||||
+#240#189#179'$X\#'#223#146#208#162#161'8'#163#177#19#145'v'#254'G>i*'#27'Z'
|
||||
+#237#159#167#243'M'#167#138#237#219'u4s"'#2'3'#231'WQY'#150#0#0#165#212#209
|
||||
+']D'#142#200'S0'#198#12#179#136#153#161#148#2#17'a:'#223'8'#145#197'b'#17#21
|
||||
+'PJ'#229'-'#178#25#251#2#204#236#250#228#132#13#157#183#168'i'#160'Z'#194#152
|
||||
+'x'#159#128'1'#6#4'@'#180#238#218#177'\'#213'x)(*`'#173#242'E'#194'I'#182#227
|
||||
+#10#160#251'IX'#174'j'#140'3'#223#202#208':'#0#157'j'#142#150#233'n'#247#141
|
||||
+#178',]'#224#246#203#128#219'6'#7'd'#202#155#135#152#136#191#7#128#253'y '
|
||||
+#169#0'V*9'#7#182#146#220'<'#184'e'#10#28'|'#13#179#141#10'{c'#141'1I'#1#224
|
||||
+'p'#162'%'#171'H'#161#21#232'='#213#138'Xv)'#12'M"'#204'@B'#18'SYx'#237#147
|
||||
+#206'd'#191#2#10#201'B'#12'%'#207#13'L-'#141#211#255'$Z'#252#2'}'#212'D'#152
|
||||
+'a'#180#26#28#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
|
||||
@ -19,8 +19,16 @@ uses
|
||||
|
||||
{ TRxCalendar }
|
||||
|
||||
{ TRxCalendar implementation copied from Borland CALENDAR.PAS sample unit
|
||||
and modified }
|
||||
{ TRxCalendar implementation copied from Borland CALENDAR.PAS sample
|
||||
unit and modified }
|
||||
|
||||
const
|
||||
//TRxShortDaysWeek: array[0..6] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
|
||||
TRxShortDaysOfWeek: array[0..6] of string =
|
||||
('Su', 'Mo', 'Tu', 'We', 'Th', 'Fr', 'Sa');
|
||||
TRxLongMonthNames: array[0..11] of string =
|
||||
('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August',
|
||||
'September', 'October', 'November', 'December');
|
||||
|
||||
type
|
||||
TDayOfWeek = 0..6;
|
||||
@ -48,11 +56,14 @@ type
|
||||
FWeekends: TDaysOfWeek;
|
||||
FWeekendColor: TColor;
|
||||
FDaysArray:TDaysArray;
|
||||
FShortDaysOfWeek: TStrings;
|
||||
function GetDateElement(Index: Integer): Integer;
|
||||
procedure FillDaysArray;
|
||||
function GetShortDaysOfWeek: TStrings;
|
||||
procedure SetCalendarDate(Value: TDateTime);
|
||||
procedure SetDateElement(Index: Integer; Value: Integer);
|
||||
procedure SetNotInThisMonthColor(const AValue: TColor);
|
||||
procedure SetShortDaysOfWeek(const AValue: TStrings);
|
||||
procedure SetStartOfWeek(Value: TDayOfWeekName);
|
||||
procedure SetUseCurrentDate(Value: Boolean);
|
||||
procedure SetWeekendColor(Value: TColor);
|
||||
@ -60,6 +71,8 @@ type
|
||||
function IsWeekend(ACol, ARow: Integer): Boolean;
|
||||
procedure CalendarUpdate(DayOnly: Boolean);
|
||||
function StoreCalendarDate: Boolean;
|
||||
procedure AddWeek;
|
||||
procedure DecWeek;
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
procedure Change; dynamic;
|
||||
@ -70,6 +83,9 @@ type
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure KeyPress(var Key: Char); override;
|
||||
procedure LMSize(var Message: TLMSize); message LM_SIZE;
|
||||
procedure RxCalendarMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
procedure RxCalendarMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
procedure UpdateShortDaysOfWeek; virtual;
|
||||
|
||||
property CalendarDate: TDateTime read FDate write SetCalendarDate
|
||||
stored StoreCalendarDate;
|
||||
@ -85,11 +101,13 @@ type
|
||||
property NotInThisMonthColor:TColor read FNotInThisMonthColor write SetNotInThisMonthColor default clSilver;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure NextMonth;
|
||||
procedure NextYear;
|
||||
procedure PrevMonth;
|
||||
procedure PrevYear;
|
||||
procedure UpdateCalendar; virtual;
|
||||
property ShortDaysOfWeek: TStrings read GetShortDaysOfWeek write SetShortDaysOfWeek;
|
||||
end;
|
||||
|
||||
{ TRxCalendar1 }
|
||||
@ -112,6 +130,7 @@ type
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property SelectedColor;
|
||||
property ShortDaysOfWeek; //
|
||||
property StartOfWeek;
|
||||
property TabStop;
|
||||
property UseCurrentDate;
|
||||
@ -149,6 +168,7 @@ type
|
||||
FFourDigitYear: Boolean;
|
||||
FBtns: array[0..3] of TSpeedButton;
|
||||
FMonthMenu:TPopupMenu;
|
||||
FMonthNames: TStrings;
|
||||
procedure CalendarMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
function GetDate: TDateTime;
|
||||
@ -158,6 +178,7 @@ type
|
||||
procedure NextYearBtnClick(Sender: TObject);
|
||||
procedure CalendarChange(Sender: TObject);
|
||||
procedure SetDate(const AValue: TDateTime);
|
||||
procedure SetMonthNames(const AValue: TStrings);
|
||||
procedure TopPanelDblClick(Sender: TObject);
|
||||
procedure MonthMenuClick(Sender: TObject);
|
||||
procedure CalendarDblClick(Sender: TObject);
|
||||
@ -170,10 +191,12 @@ type
|
||||
procedure Deactivate; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure AutoSizeForm;
|
||||
property Date:TDateTime read GetDate write SetDate;
|
||||
property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
|
||||
property Calendar: TCustomRxCalendar read FCalendar;
|
||||
property MonthNames: TStrings read FMonthNames write SetMonthNames;
|
||||
end;
|
||||
|
||||
{ TSelectDateDlg }
|
||||
@ -267,7 +290,11 @@ begin
|
||||
for i:=1 to 12 do
|
||||
begin
|
||||
MI:=TMenuItem.Create(Result);
|
||||
MI.Caption:=LongMonthNames[i];
|
||||
(*
|
||||
// Old variant
|
||||
// MI.Caption:=LongMonthNames[i];
|
||||
*)
|
||||
MI.Caption := TRxLongMonthNames[i - 1];
|
||||
MI.OnClick:=AOnClick;
|
||||
MI.Tag:=i;
|
||||
Result.Items.Add(MI);
|
||||
@ -311,6 +338,7 @@ var
|
||||
ADefaultTextStyle: TTextStyle;
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FShortDaysOfWeek := TStringList.Create;
|
||||
FUseCurrentDate := True;
|
||||
FStartOfWeek := Mon;
|
||||
FWeekends := [Sun];
|
||||
@ -328,11 +356,20 @@ begin
|
||||
ADefaultTextStyle.Alignment:=taCenter;
|
||||
ADefaultTextStyle.Layout:=tlCenter;
|
||||
DefaultTextStyle:=ADefaultTextStyle;
|
||||
|
||||
FocusRectVisible := False;
|
||||
OnMouseWheelUp := @RxCalendarMouseWheelUp;
|
||||
OnMouseWheelDown := @RxCalendarMouseWheelDown;
|
||||
UpdateShortDaysOfWeek;
|
||||
UpdateCalendar;
|
||||
TitleStyle:=tsNative;
|
||||
end;
|
||||
|
||||
destructor TCustomRxCalendar.Destroy;
|
||||
begin
|
||||
FShortDaysOfWeek.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.CreateParams(var Params: TCreateParams);
|
||||
begin
|
||||
inherited CreateParams(Params);
|
||||
@ -370,6 +407,7 @@ procedure TCustomRxCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
|
||||
AState: TGridDrawState);
|
||||
var
|
||||
DayNum:integer;
|
||||
R: TRect;
|
||||
begin
|
||||
PrepareCanvas(aCol, aRow, aState);
|
||||
|
||||
@ -381,17 +419,34 @@ begin
|
||||
|
||||
if ARow>0 then
|
||||
begin
|
||||
if not ((gdSelected in aState) and (gdFocused in aState)) then
|
||||
Canvas.Font.Color:=FDaysArray[ACol, ARow].DayColor
|
||||
if not ((gdSelected in aState) and (gdFocused in aState)) then begin
|
||||
if (FDaysArray[ACol, ARow].DayDate = Date) and (FDaysArray[ACol, ARow].DayColor <> FNotInThisMonthColor) then begin
|
||||
R := ARect;
|
||||
// Variant 1
|
||||
//Dec(R.Bottom, 1);
|
||||
//Dec(R.Right, 1);
|
||||
//Canvas.Frame3d(R, 1, bvLowered);
|
||||
|
||||
// Variant 2
|
||||
RxFrame3D(Canvas, R, clWindowFrame, clBtnHighlight, 1);
|
||||
RxFrame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
|
||||
end;
|
||||
Canvas.Font.Color:=FDaysArray[ACol, ARow].DayColor;
|
||||
end
|
||||
else
|
||||
Canvas.Font.Color:=clWindow
|
||||
Canvas.Font.Color := clHighlightText // clWindow
|
||||
;
|
||||
DrawCellText(ACol, ARow, ARect, AState, IntToStr(FDaysArray[ACol, ARow].DayNum));
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
Canvas.Font.Color:=clText;
|
||||
DrawCellText(ACol, ARow, ARect, AState, ShortDayNames[(Ord(StartOfWeek) + ACol) mod 7 + 1]);
|
||||
//DrawCellText(ACol, ARow, ARect, AState, ShortDayNames[(Ord(StartOfWeek) + ACol) mod 7 + 1]);
|
||||
if FShortDaysOfWeek <> nil then begin
|
||||
if ACol <= FShortDaysOfWeek.Count - 1 then
|
||||
DrawCellText(ACol, ARow, ARect, AState, FShortDaysOfWeek.Strings[(Ord(StartOfWeek) + ACol) mod 7]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -419,6 +474,16 @@ procedure TCustomRxCalendar.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if Shift = [] then
|
||||
case Key of
|
||||
VK_UP:
|
||||
begin
|
||||
DecWeek;
|
||||
Exit;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
AddWeek;
|
||||
Exit;
|
||||
end;
|
||||
VK_LEFT, VK_SUBTRACT:
|
||||
begin
|
||||
if (Day > 1) then Day := Day - 1
|
||||
@ -456,6 +521,20 @@ begin
|
||||
DefaultRowHeight := (Message.Height - GridLinesH) div 7;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.RxCalendarMouseWheelUp(Sender: TObject;
|
||||
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
begin
|
||||
DecWeek;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.RxCalendarMouseWheelDown(Sender: TObject;
|
||||
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
begin
|
||||
AddWeek;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.SetCalendarDate(Value: TDateTime);
|
||||
begin
|
||||
if FDate <> Value then
|
||||
@ -471,6 +550,22 @@ begin
|
||||
Result := not FUseCurrentDate;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.AddWeek;
|
||||
begin
|
||||
if (Day + 7 <= DaysThisMonth) then
|
||||
Day := Day + 7
|
||||
else
|
||||
CalendarDate := CalendarDate + 7;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.DecWeek;
|
||||
begin
|
||||
if (Day - 7 >= 1) then
|
||||
Day := Day - 7
|
||||
else
|
||||
CalendarDate := CalendarDate - 7;
|
||||
end;
|
||||
|
||||
function TCustomRxCalendar.GetDateElement(Index: Integer): Integer;
|
||||
var
|
||||
AYear, AMonth, ADay: Word;
|
||||
@ -526,6 +621,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.UpdateShortDaysOfWeek;
|
||||
var
|
||||
Ind: Integer;
|
||||
//OldNotify: TNotifyEvent;
|
||||
begin
|
||||
if (FShortDaysOfWeek <> nil) and (FShortDaysOfWeek.Count = 0) then begin
|
||||
//OldNotify := FDaysOfWeek.OnChange;
|
||||
//TStringList(FShortDays).OnChange := nil;
|
||||
for Ind := Low(TRxShortDaysOfWeek) to High(TRxShortDaysOfWeek) do
|
||||
FShortDaysOfWeek.Add(TRxShortDaysOfWeek[Ind]);
|
||||
//FShortDaysOfWeek.OnChange := OldNotify;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomRxCalendar.GetShortDaysOfWeek: TStrings;
|
||||
begin
|
||||
Result := FShortDaysOfWeek;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.SetDateElement(Index: Integer; Value: Integer);
|
||||
var
|
||||
AYear, AMonth, ADay: Word;
|
||||
@ -561,6 +675,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.SetShortDaysOfWeek(const AValue: TStrings);
|
||||
begin
|
||||
if AValue.Text <> FShortDaysOfWeek.Text then begin
|
||||
FShortDaysOfWeek.Assign(AValue);
|
||||
Invalidate; //
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxCalendar.SetWeekendColor(Value: TColor);
|
||||
begin
|
||||
if Value <> FWeekendColor then
|
||||
@ -822,6 +944,12 @@ begin
|
||||
|
||||
if (csDesigning in ComponentState) then Exit;
|
||||
|
||||
FMonthNames := TStringList.Create;
|
||||
if FMonthNames.Count = 0 then begin
|
||||
for i := Low(TRxLongMonthNames) to High(TRxLongMonthNames) do
|
||||
FMonthNames.Add(TRxLongMonthNames[i]);
|
||||
end;
|
||||
|
||||
BackPanel := TPanel.Create(Self);
|
||||
BackPanel.Anchors:=[akLeft, akRight, akTop, akBottom];
|
||||
|
||||
@ -934,6 +1062,12 @@ begin
|
||||
CalendarChange(nil);
|
||||
end;
|
||||
|
||||
destructor TPopupCalendar.Destroy;
|
||||
begin
|
||||
FMonthNames.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPopupCalendar.AutoSizeForm;
|
||||
begin
|
||||
FControlPanel.Height:=FCalendar.Canvas.TextHeight('Wg')+4;
|
||||
@ -996,8 +1130,6 @@ begin
|
||||
else FCalendar.PrevMonth;
|
||||
end;
|
||||
VK_ESCAPE:ModalResult:=mrCancel;
|
||||
else
|
||||
TLocCalendar(FCalendar).KeyDown(Key, Shift);
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
@ -1056,8 +1188,14 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPopupCalendar.CalendarChange(Sender: TObject);
|
||||
var
|
||||
s: string; //
|
||||
AYear, AMonth, ADay: Word;
|
||||
begin
|
||||
FTitleLabel.Caption := FormatDateTime('MMMM, YYYY', FCalendar.CalendarDate);
|
||||
DecodeDate(FCalendar.CalendarDate, AYear, AMonth, ADay);
|
||||
s := Format('%s, %d', [TRxLongMonthNames[AMonth - 1], AYear]);
|
||||
FTitleLabel.Caption := s; //
|
||||
// FTitleLabel.Caption := FormatDateTime('MMMM, YYYY', FCalendar.CalendarDate);
|
||||
end;
|
||||
|
||||
procedure TPopupCalendar.SetDate(const AValue: TDateTime);
|
||||
@ -1065,6 +1203,14 @@ begin
|
||||
FCalendar.CalendarDate:=AValue;
|
||||
end;
|
||||
|
||||
procedure TPopupCalendar.SetMonthNames(const AValue: TStrings);
|
||||
begin
|
||||
if AValue.Text <> FMonthNames.Text then begin
|
||||
FMonthNames.Assign(AValue);
|
||||
CalendarChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TSelectDateDlg }
|
||||
|
||||
constructor TSelectDateDlg.Create(AOwner: TComponent);
|
||||
@ -1262,14 +1408,14 @@ begin
|
||||
VK_ESCAPE: ModalResult := mrCancel;
|
||||
VK_NEXT:
|
||||
begin
|
||||
if ssCtrl in Shift then Calendar.NextYear
|
||||
else Calendar.NextMonth;
|
||||
if ssCtrl in Shift then Calendar.NextYear;
|
||||
//else Calendar.NextMonth;
|
||||
TitleLabel.Update;
|
||||
end;
|
||||
VK_PRIOR:
|
||||
begin
|
||||
if ssCtrl in Shift then Calendar.PrevYear
|
||||
else Calendar.PrevMonth;
|
||||
if ssCtrl in Shift then Calendar.PrevYear;
|
||||
//else Calendar.PrevMonth;
|
||||
TitleLabel.Update;
|
||||
end;
|
||||
VK_TAB:
|
||||
|
||||
@ -15,7 +15,7 @@ uses
|
||||
curredit, rxswitch, rxdice, rxdbcomb, rxtoolbar, rxxpman, PageMngr, RxAppIcon,
|
||||
Dialogs, ComponentEditors, seldsfrm, DBPropEdits, DB, rxctrls, RxLogin,
|
||||
RxCustomChartPanel, AutoPanel, pickdate, rxconst, tooledit, rxclock,
|
||||
rxceEditLookupFields, rxpopupunit, rxspin;
|
||||
rxceEditLookupFields, rxpopupunit, rxspin, RxTimeEdit;
|
||||
|
||||
type
|
||||
|
||||
@ -276,6 +276,11 @@ begin
|
||||
RegisterComponents('RX',[TRxSpinButton, TRxSpinEdit]);
|
||||
end;
|
||||
|
||||
procedure RegisterRxTimeEdit;
|
||||
begin
|
||||
RegisterComponents('RX',[TRxTimeEdit]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
//RX
|
||||
@ -296,6 +301,7 @@ begin
|
||||
RegisterUnit('tooledit', @RegisterToolEdit);
|
||||
RegisterUnit('rxclock', @RegisterRxClock);
|
||||
RegisterUnit('rxspin', @RegisterRxSpin);
|
||||
RegisterUnit('RxTimeEdit', @RegisterRxTimeEdit);
|
||||
|
||||
//RX DBAware
|
||||
RegisterUnit('dbdateedit', @RegisterUnitDBDateEdit);
|
||||
|
||||
31
components/rx/registerrxdb.pas
Normal file
31
components/rx/registerrxdb.pas
Normal file
@ -0,0 +1,31 @@
|
||||
unit RegisterRxDB;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, LazarusPackageIntf;
|
||||
|
||||
procedure Register;
|
||||
implementation
|
||||
uses RxDBSpinEdit, RxDBTimeEdit;
|
||||
|
||||
procedure RegisterRxDBSpinEdit;
|
||||
begin
|
||||
RegisterComponents('RX DBAware',[TRxDBSpinEdit]);
|
||||
end;
|
||||
|
||||
procedure RegisterRxDBTimeEdit;
|
||||
begin
|
||||
RegisterComponents('RX DBAware',[TRxDBTimeEdit]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('RxDBTimeEdit', @RegisterRxDBTimeEdit);
|
||||
RegisterUnit('RxDBSpinEdit', @RegisterRxDBSpinEdit);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -453,3 +453,69 @@ LazarusResources.Add('TRxSpinEdit','PNG',[
|
||||
+'T'#15#160'z4'#159#3#168's'#181'>'#192#191#169#220'9'#185#245#10#158'vWe'#213
|
||||
+'GM'#130#23#211'$E'#25#128#18#229'#'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRXDBSpinEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1#230'IDATH'#137#205
|
||||
+#148#193'j'#19'Q'#24#133#191'2'#142'+)}'#129#190'D'#23#226'"P_A'#220#187#200
|
||||
+'n'#210#216'M'#7#178'(C'#9']T"*'#212'd#]'#248#12'n'#5#145','#220#139'o'#224
|
||||
+#170#22#196#166#134#218'af'#174#139#206#157#220#153';'#153#220#22#4#15#4#238
|
||||
+''#239#253#207#185'9'#255'a'#224#31'C'#244'"'#12'C'#165#215#211#233'T@'#169
|
||||
+#230#150#178'U'#218#207#13#132'a'#168#148#162#252#153'b'#205'X'''#222'B'#190
|
||||
+'JD)'#147#212']'#192#3#232#247#195#202'f'#189#6#16#145#194'6Mn'#174'm'#232#7
|
||||
+#249#0#147#201#180'BZ'#175'M'#153'*'#233#234'9'#220'<'#168#16#208#164'n'#208
|
||||
+'"nC'#22#237#181')'#160'_'#191#189#253#208'Q'#180#25#189#222'3i'#181#232#219
|
||||
+#215#217#157#201#15#15'cz'#189'5'#22#189'z'#243#206#218'K'#146#132' '#8#0#200
|
||||
+#178#12'gh'#221'Q'#179'1'#243'_'#223#129'B'#160#223#15#27'-jB'#16#4#229#4
|
||||
+#252#157'!'#217#231#23#214#29#233'F\|x'#190#20'Xe'#209#163#193#167'J'#227#151
|
||||
+#147#199#0#228#10':'#197#136#207#206#23#0'D'#251#3#198'/O,'#177'V'#139'4a]'
|
||||
+#168#227'-'#215#151#243#5#163#209#176#20#137#227'c['#160#205'"M'#174#197#234
|
||||
+#184#248#249#155#189#221#131'JmB'#160#250#161#211'x'#253'vB '#235#5#164#27'Y'
|
||||
+'{z'#200#27#155'['#226#129#157'wWr'#23#148'3'#184'/a\'#196#178#227#216','
|
||||
+#221#200'-E'#26'JA'#206'2!.8;_'#16#237#15#202#186#158'$'#207',D '#184#5'9'
|
||||
+#220#164'H'''''#142#143#185#156'/*'#231#149''#224#145#146#233#173'|'#233'}Z'
|
||||
+#156#231')x'#2#190#225#161'N'#205#222#238#129#149' K@'#169#28'H'#16#229#225
|
||||
+'y>Y'#14'H'#138#200#21#29#30#212'nC:'#27#225'wc'#139#244#207#199'#'#174#175
|
||||
+'~'#0'ELOO'#223#171#167'O'#238#158#148'U'#216#216#220#186#165#225#255'#'#254
|
||||
+#2#182'2'#241'd'#141']'#3'd'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxTimeEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1'TIDATH'#137#237'TAN'
|
||||
+#195'0'#16#156')'#136'7'#181#183#210#15' '#238'H'#28'zm'#223#144#245#7#16#18
|
||||
+#220'P+'#193'C'#218'T'#28#224#140#248#13#18#195'!'#177#177#235#196'mQ'#17#23
|
||||
+'F'#178'6'#235#216#187#179';'#155#0#255#248'k'#16#0'$i'#185'|'#250#149#4#167
|
||||
+#177#243#254#246'|'#212#224#23#151'Wi'#2#0#184#185'}8Z'#130#205'f'#131'A'#223
|
||||
+#203#209'|'#157#216']'#251#30'$'#19#191'7'#193'Op'#194#179',Ig'#2#146'x'#189
|
||||
+#159'$'#150'd'#198'>'#174#130'$>'#241#145#248#1#146#180'X<'#10#128#26#183'Yf'
|
||||
+'&3'#11#254#247'{i8[i'#23#234#186'V'#16'y:'#189'n'#147#245#183'@'#2#200#134
|
||||
+#221'p'#182#194'h'#190#198#203#221'9'#156's'#157#231#199#227'q3E$C`'#231#12
|
||||
+'Ue'#0#16#172#135's'#6#201#218#22'L'#160#18#155#140#156#242'e='#251#190']'
|
||||
+#251#180'h'#208#6#135'sV'#166#144'U'#146#10#233#7'!^E'#246#187'*'#232#170#2
|
||||
+'H'#7'!'#136#236#217#199'=wL'#173'G'#149'T'#155'V-'#169#213'S'#217#254'Q*'
|
||||
+#232#210#128#177#6#219'SS'#210#160#170#12'$P'#215'u'#241#172'o'#192'!'#19#215
|
||||
+'\dr'#191#23#217#175#162'4M'#135'LZ '#18'='#11'H'#191#228'.'#241#227#201#220
|
||||
+'''A\'#1#183#2#228'l'#14#12'^:'#216#167#200#222#129'='#190#0'q'#209'z'#166'R'
|
||||
+'2h'#222#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxDBTimeEdit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#9'pHYs'#0#0#14#156#0#0#14#156#1#7#148'S'#221#0#0#1#159'IDATH'#137#181'V'
|
||||
+'1N'#195'0'#20'}?'#148'r'#131'\'#164#3'e3''@'#236#136#165'bq'#138#16'G'#232
|
||||
+#196'X!'#154','#168#11#7')'#223',='#6'Co'#193#242#25#26#187#174'c;'#141#16'O'
|
||||
+#138#226#196#254#239#253#255'l'#199#1#254#25'd'#27'Zk'#177#237#166'i'#8#16
|
||||
+#137#135#184'P'#202#247'{'#208'Z'#139#8#220#229#139#197#209''''#158'!'#207
|
||||
+#139#136't'#175'<'#200#18#213'u'#227'^V'#149#6#0'L&'#151#157#128#217#236#222
|
||||
+#181#215#235#143#222#2'Hk-u'#221'8R+VU'#26#23#231'?'#209#160#229#235';'#158
|
||||
+#159#30'z'#201'on'#239#242#22#253#21#204','#133'oIh'#17#0'\=~'#30#245#217#231
|
||||
+#240#189#179'$X\#'#223#146#208#162#161'8'#163#177#19#145'v'#254'G>i*'#27'Z'
|
||||
+#237#159#167#243'M'#167#138#237#219'u4s"'#2'3'#231'WQY'#150#0#0#165#212#209
|
||||
+']D'#142#200'S0'#198#12#179#136#153#161#148#2#17'a:'#223'8'#145#197'b'#17#21
|
||||
+'PJ'#229'-'#178#25#251#2#204#236#250#228#132#13#157#183#168'i'#160'Z'#194#152
|
||||
+'x'#159#128'1'#6#4'@'#180#238#218#177'\'#213'x)(*`'#173#242'E'#194'I'#182#227
|
||||
+#10#160#251'IX'#174'j'#140'3'#223#202#208':'#0#157'j'#142#150#233'n'#247#141
|
||||
+#178',]'#224#246#203#128#219'6'#7'd'#202#155#135#152#136#191#7#128#253'y '
|
||||
+#169#0'V*9'#7#182#146#220'<'#184'e'#10#28'|'#13#179#141#10'{c'#141'1I'#1#224
|
||||
+'p'#162'%'#171'H'#161#21#232'='#213#138'Xv)'#12'M"'#204'@B'#18'SYx'#237#147
|
||||
+#206'd'#191#2#10#201'B'#12'%'#207#13'L-'#141#211#255'$Z'#252#2'}'#212'D'#152
|
||||
+'a'#180#26#28#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
|
||||
288
components/rx/rxdbspinedit.pas
Normal file
288
components/rx/rxdbspinedit.pas
Normal file
@ -0,0 +1,288 @@
|
||||
unit RxDBSpinEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Spin,
|
||||
DbCtrls, DB, LMessages, LCLType;
|
||||
|
||||
const
|
||||
IntegerDataTypes = [ftSmallint, ftInteger, ftWord, ftLargeint];
|
||||
|
||||
NumericDataTypes = IntegerDataTypes + [ftFloat, ftCurrency, ftBCD];
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TCustomRxDBSpinEdit }
|
||||
|
||||
TCustomRxDBSpinEdit = class(TCustomFloatSpinEdit)
|
||||
private
|
||||
FDataLink: TFieldDataLink;
|
||||
|
||||
procedure DataChange(Sender: TObject);
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
function GetReadOnly: Boolean;
|
||||
procedure SetDataField(const AValue: string);
|
||||
procedure SetDataSource(const AValue: TDataSource);
|
||||
procedure SetReadOnly(const AValue: Boolean);
|
||||
procedure UpdateData(Sender: TObject);
|
||||
procedure FocusRequest(Sender: TObject);
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
procedure LayoutChange(Sender: TObject);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
function IsReadOnly: boolean;
|
||||
protected
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure Change; override;
|
||||
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Field: TField read GetField;
|
||||
published
|
||||
{ Published declarations }
|
||||
end;
|
||||
|
||||
TRxDBSpinEdit = class(TCustomRxDBSpinEdit)
|
||||
published
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property ReadOnly;
|
||||
|
||||
property Align;
|
||||
property Anchors;
|
||||
property AutoSelect;
|
||||
property AutoSize;
|
||||
property BorderSpacing;
|
||||
property Constraints;
|
||||
property DecimalPlaces;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property Increment;
|
||||
property MaxValue;
|
||||
property MinValue;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnEditingDone;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property TabStop;
|
||||
property TabOrder;
|
||||
property Value;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TFieldDataLinkHack = class(TFieldDataLink)
|
||||
end;
|
||||
|
||||
{ TCustomRxDBSpinEdit }
|
||||
|
||||
procedure TCustomRxDBSpinEdit.DataChange(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in NumericDataTypes) then
|
||||
begin
|
||||
if (FDataLink.Field.DataType in IntegerDataTypes) then
|
||||
DecimalPlaces:=0
|
||||
else
|
||||
begin
|
||||
if FDataLink.Field.DataType = ftBCD then
|
||||
DecimalPlaces:=(FDatalink.Field as TBCDField).Precision
|
||||
else
|
||||
DecimalPlaces:=(FDatalink.Field as TFloatField).Precision;
|
||||
end;
|
||||
Value:=FDatalink.Field.AsFloat;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Text := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomRxDBSpinEdit.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomRxDBSpinEdit.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomRxDBSpinEdit.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
function TCustomRxDBSpinEdit.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
inherited;
|
||||
FDataLink.ReadOnly := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.UpdateData(Sender: TObject);
|
||||
begin
|
||||
FDataLink.Field.Value := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
DataChange(Sender)
|
||||
else
|
||||
begin
|
||||
Text := '';
|
||||
FDataLink.Reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.LayoutChange(Sender: TObject);
|
||||
begin
|
||||
DataChange(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
if Key=VK_ESCAPE then
|
||||
begin
|
||||
//cancel out of editing by reset on esc
|
||||
FDataLink.Reset;
|
||||
SelectAll;
|
||||
Key := VK_UNKNOWN;
|
||||
end
|
||||
else
|
||||
if Key=VK_DELETE then
|
||||
begin
|
||||
if not IsReadOnly then
|
||||
FDatalink.Edit;
|
||||
end
|
||||
else
|
||||
if Key=VK_TAB then
|
||||
begin
|
||||
if FDataLink.CanModify and FDatalink.Editing then
|
||||
FDataLink.UpdateRecord;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.Change;
|
||||
begin
|
||||
FDatalink.Edit;
|
||||
FDataLink.Modified;
|
||||
inherited Change;
|
||||
end;
|
||||
|
||||
function TCustomRxDBSpinEdit.IsReadOnly: boolean;
|
||||
begin
|
||||
result := true;
|
||||
if FDatalink.Active and not Self.ReadOnly then
|
||||
result := (Field=nil) or Field.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if (Operation=opRemove) then
|
||||
begin
|
||||
if (FDataLink<>nil) and (AComponent=DataSource) then
|
||||
DataSource:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.WMSetFocus(var Message: TLMSetFocus);
|
||||
begin
|
||||
inherited WMSetFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBSpinEdit.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
inherited WMKillFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset
|
||||
else
|
||||
TFieldDataLinkHack(FDatalink).UpdateData;
|
||||
end;
|
||||
|
||||
constructor TCustomRxDBSpinEdit.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
FDataLink.OnActiveChange := @ActiveChange;
|
||||
FDataLink.OnLayoutChange := @LayoutChange;
|
||||
end;
|
||||
|
||||
destructor TCustomRxDBSpinEdit.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
30
components/rx/rxdbtimeedit.pas
Normal file
30
components/rx/rxdbtimeedit.pas
Normal file
@ -0,0 +1,30 @@
|
||||
unit RxDBTimeEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
RxTimeEdit;
|
||||
|
||||
type
|
||||
TCustomRxDBTimeEdit = class(TCustomRxTimeEdit)
|
||||
private
|
||||
{ Private declarations }
|
||||
protected
|
||||
{ Protected declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
published
|
||||
{ Published declarations }
|
||||
end;
|
||||
|
||||
TRxDBTimeEdit = class(TCustomRxDBTimeEdit)
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
end.
|
||||
@ -16,12 +16,12 @@
|
||||
</CompilerOptions>
|
||||
<Description Value="Delphi VCL Extensions (RX)
|
||||
Copyright (c) 1998 Master-Bank
|
||||
translate to Lazarus by alexs in 2005 - 2007
|
||||
translate to Lazarus by alexs in 2005 - 2009
|
||||
"/>
|
||||
<License Value="free ware
|
||||
"/>
|
||||
<Version Major="1" Minor="1" Release="5" Build="98"/>
|
||||
<Files Count="46">
|
||||
<Version Major="1" Minor="2" Release="1" Build="98"/>
|
||||
<Files Count="50">
|
||||
<Item1>
|
||||
<Filename Value="rxlookup.pas"/>
|
||||
<UnitName Value="rxlookup"/>
|
||||
@ -207,6 +207,23 @@ translate to Lazarus by alexs in 2005 - 2007
|
||||
<Filename Value="rxspin.pas"/>
|
||||
<UnitName Value="rxspin"/>
|
||||
</Item46>
|
||||
<Item47>
|
||||
<Filename Value="rxdbspinedit.pas"/>
|
||||
<UnitName Value="RxDBSpinEdit"/>
|
||||
</Item47>
|
||||
<Item48>
|
||||
<Filename Value="registerrxdb.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="RegisterRxDB"/>
|
||||
</Item48>
|
||||
<Item49>
|
||||
<Filename Value="rxtimeedit.pas"/>
|
||||
<UnitName Value="RxTimeEdit"/>
|
||||
</Item49>
|
||||
<Item50>
|
||||
<Filename Value="rxdbtimeedit.pas"/>
|
||||
<UnitName Value="RxDBTimeEdit"/>
|
||||
</Item50>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="4">
|
||||
@ -225,11 +242,10 @@ translate to Lazarus by alexs in 2005 - 2007
|
||||
</Item4>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)\"/>
|
||||
<UnitPath Value="$(PkgOutDir)/"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
|
||||
@ -15,13 +15,15 @@ uses
|
||||
fduallst, rxxpman, pagemngr, rxappicon, seldsfrm, rxctrls, rxlogin,
|
||||
rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit, rxcustomchartpanel,
|
||||
rxsortmemds, AutoPanel, pickdate, rxiconv, rxceEditLookupFields, rxclock,
|
||||
rxspin, LazarusPackageIntf;
|
||||
rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('registerrx', @registerrx.Register);
|
||||
RegisterUnit('RegisterRxDB', @RegisterRxDB.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
271
components/rx/rxtimeedit.pas
Normal file
271
components/rx/rxtimeedit.pas
Normal file
@ -0,0 +1,271 @@
|
||||
unit RxTimeEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, rxspin,
|
||||
MaskEdit, LMessages, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TCustomRxTimeEdit }
|
||||
|
||||
TCustomRxTimeEdit = class(TCustomMaskEdit)
|
||||
private
|
||||
FButton: TRxSpinButton;
|
||||
FButtonNeedsFocus: Boolean;
|
||||
FOnButtonClick : TNotifyEvent;
|
||||
procedure CheckButtonVisible;
|
||||
function GetButtonHint: TTranslateString;
|
||||
function GetTime: TTime;
|
||||
procedure SetButtonHint(const AValue: TTranslateString);
|
||||
procedure SetButtonNeedsFocus(const AValue: Boolean);
|
||||
procedure SetTime(const AValue: TTime);
|
||||
procedure DoChangeValue(AValue:integer);
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
||||
protected
|
||||
procedure SetParent(AParent: TWinControl); override;
|
||||
procedure DoPositionButton; virtual;
|
||||
procedure UpClick(Sender: TObject); virtual;
|
||||
procedure DownClick(Sender: TObject); virtual;
|
||||
property ButtonOnlyWhenFocused: Boolean read FButtonNeedsFocus write SetButtonNeedsFocus default False;
|
||||
property OnButtonClick : TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
||||
property ButtonHint: TTranslateString read GetButtonHint write SetButtonHint;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Time:TTime read GetTime write SetTime;
|
||||
end;
|
||||
|
||||
type
|
||||
TRxTimeEdit = class(TCustomRxTimeEdit)
|
||||
published
|
||||
property AutoSize;
|
||||
property AutoSelect;
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property ButtonOnlyWhenFocused;
|
||||
property ButtonHint;
|
||||
property CharCase;
|
||||
property Color;
|
||||
// property DirectInput;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property EchoMode;
|
||||
property Enabled;
|
||||
// property Flat;
|
||||
property Font;
|
||||
// property Glyph;
|
||||
property MaxLength;
|
||||
// property NumGlyphs;
|
||||
property OnButtonClick;
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PasswordChar;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Text;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TCustomRxTimeEdit }
|
||||
|
||||
procedure TCustomRxTimeEdit.CheckButtonVisible;
|
||||
begin
|
||||
If Assigned(FButton) then
|
||||
FButton.Visible:=(csdesigning in ComponentState) or
|
||||
(Visible and (Focused or not FButtonNeedsFocus));
|
||||
end;
|
||||
|
||||
function TCustomRxTimeEdit.GetButtonHint: TTranslateString;
|
||||
begin
|
||||
Result:=FButton.Hint;
|
||||
end;
|
||||
|
||||
function TCustomRxTimeEdit.GetTime: TTime;
|
||||
begin
|
||||
Result:=StrToTimeDef(Text, 0);
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.SetButtonHint(const AValue: TTranslateString);
|
||||
begin
|
||||
if AValue = '' then
|
||||
FButton.Hint:=Hint
|
||||
else
|
||||
FButton.Hint:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.SetButtonNeedsFocus(const AValue: Boolean);
|
||||
begin
|
||||
if FButtonNeedsFocus<>AValue then
|
||||
begin
|
||||
FButtonNeedsFocus:=AValue;
|
||||
CheckButtonVisible;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.SetTime(const AValue: TTime);
|
||||
begin
|
||||
Text:=TimeToStr(AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.DoChangeValue(AValue: integer);
|
||||
var
|
||||
S:ShortString;
|
||||
H1, M2, S3:byte;
|
||||
i,p:integer;
|
||||
|
||||
procedure IncHour;
|
||||
begin
|
||||
H1:=H1+AValue;
|
||||
if H1<0 then H1:=0;
|
||||
end;
|
||||
|
||||
procedure IncMin;
|
||||
begin
|
||||
M2:=M2+AValue;
|
||||
if M2>59 then
|
||||
M2:=0
|
||||
else
|
||||
if M2<0 then
|
||||
M2:=59
|
||||
else
|
||||
exit;
|
||||
IncHour;
|
||||
end;
|
||||
|
||||
procedure IncSec;
|
||||
begin
|
||||
S3:=S3+AValue;
|
||||
if S3>59 then
|
||||
S3:=0
|
||||
else
|
||||
if S3<0 then
|
||||
S3:=59
|
||||
else
|
||||
exit;
|
||||
IncMin;
|
||||
end;
|
||||
|
||||
begin
|
||||
S:=Text;
|
||||
for i:=1 to Length(S) do
|
||||
if S[i]=' ' then
|
||||
S[i]:='0';
|
||||
|
||||
H1:=StrToInt(S[1]+S[2]);
|
||||
M2:=StrToInt(S[4]+S[5]);
|
||||
S3:=StrToInt(S[7]+S[8]);
|
||||
P:=GetSelStart;
|
||||
if P < 3 then IncHour
|
||||
else
|
||||
if P < 6 then IncMin
|
||||
else IncSec;
|
||||
Text:=Format('%2.2d'+ TimeSeparator +'%2.2d'+ TimeSeparator +'%2.2d', [H1, M2, S3]);
|
||||
SetSelStart(P);
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.WMSetFocus(var Message: TLMSetFocus);
|
||||
begin
|
||||
FButton.Visible:=True;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
if FButtonNeedsFocus then
|
||||
FButton.Visible:=False;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.SetParent(AParent: TWinControl);
|
||||
begin
|
||||
inherited SetParent(AParent);
|
||||
if FButton <> nil then
|
||||
begin
|
||||
DoPositionButton;
|
||||
CheckButtonVisible;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.DoPositionButton;
|
||||
begin
|
||||
if FButton = nil then exit;
|
||||
FButton.Parent := Parent;
|
||||
FButton.Visible := Visible;
|
||||
FButton.AnchorToCompanion(akLeft,0,Self);
|
||||
// if FButton.Width = 0 then
|
||||
FButton.Width:=26;//Height;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.UpClick(Sender: TObject);
|
||||
begin
|
||||
if not ReadOnly then
|
||||
begin
|
||||
DoChangeValue(1);
|
||||
if Assigned(FOnButtonClick) then
|
||||
FOnButtonClick(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxTimeEdit.DownClick(Sender: TObject);
|
||||
begin
|
||||
if not ReadOnly then
|
||||
begin
|
||||
DoChangeValue(-1);
|
||||
if Assigned(FOnButtonClick) then
|
||||
FOnButtonClick(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomRxTimeEdit.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FButton := TRxSpinButton.Create(Self);
|
||||
FButton.FocusControl := Self;
|
||||
FButton.Width := Self.Height;
|
||||
FButton.Height := Self.Height;
|
||||
FButton.FreeNotification(Self);
|
||||
FButton.ControlStyle := FButton.ControlStyle + [csNoDesignSelectable];
|
||||
FButton.OnTopClick := @UpClick;
|
||||
FButton.OnBottomClick := @DownClick;
|
||||
|
||||
EditMask:='##'+TimeSeparator + '##'+TimeSeparator + '##';
|
||||
end;
|
||||
|
||||
destructor TCustomRxTimeEdit.Destroy;
|
||||
begin
|
||||
if FButton <> nil then
|
||||
FreeAndNil(FButton);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user