You've already forked lazarus-ccr
new components
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@704 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
@ -477,6 +477,8 @@ var
|
||||
S: string;
|
||||
begin
|
||||
S := GetDisplayText;
|
||||
// if not FFocused then
|
||||
// else
|
||||
if not PaintComboEdit(Self, S, FAlignment, FFocused {and not PopupVisible}, FCanvas, Message) then
|
||||
inherited WMPaint(Message);
|
||||
end;
|
||||
|
||||
@ -16,6 +16,15 @@ interface
|
||||
uses
|
||||
LCLType, LCLProc, LCLIntf, Registry, Classes, SysUtils, DB, IniFiles;
|
||||
|
||||
const
|
||||
IntegerDataTypes = [ftSmallint, ftInteger, ftWord, ftLargeint];
|
||||
|
||||
NumericDataTypes = IntegerDataTypes + [ftFloat, ftCurrency, ftBCD];
|
||||
|
||||
const
|
||||
TimeDataTypes = [ftTime, ftDateTime, ftTimeStamp];
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TLocateObject }
|
||||
|
||||
BIN
components/rx/images/TRxDBProgressBar.png
Normal file
BIN
components/rx/images/TRxDBProgressBar.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 373 B |
BIN
components/rx/images/TRxDBTrackBar.png
Normal file
BIN
components/rx/images/TRxDBTrackBar.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 417 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 TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.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 TRxDBProgressBar.png TRxDBTrackBar.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 TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.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 TRxDBProgressBar.png TRxDBTrackBar.png
|
||||
|
||||
|
||||
@ -519,3 +519,39 @@ LazarusResources.Add('TRxDBTimeEdit','PNG',[
|
||||
+#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
|
||||
]);
|
||||
LazarusResources.Add('TRxDBProgressBar','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'''IDATH'#137'c`'#160
|
||||
+'1`d```'#200#202#202#250#15#19#152'6m'#26'#'#3#195#255#255#184#181#192#181'2'
|
||||
+#18'eCVV'#214#255#255#255#25#224#24#217'2'#220#128#24#7' '#148#254'G'#199#132
|
||||
+'-!'#222#2#166#236#236','#20#1't>'#166#193'0'#195#145#217#184#1#227#255#255
|
||||
+#12#255#145#13#157':u'#26'Cvv'#22'4.pY'#2#215'N0'#30'X`'#134#18#15#24#161#137
|
||||
+#128#184'Hf'#204#202#202#250#143'l'#1#204'7'#188#188#26'$X'#138#9':;'#243#24
|
||||
+#25#24#240#4'Qp`'#16'E'#22#236#218's'#141#161#179'3'#143#17'g'#16#25#153#24
|
||||
+'2x'#214'^'#132#243#183'7'#235'c'#240'q'#129'sg'#206#195#217','#217#217'Y'#12
|
||||
+#216#130#136#129#129#129#161'6'#206#0'I'#219''#12'>1'#128#5#22'$0'#128#204
|
||||
+'?w'#247#11'\'#220'J'#149#27#131'O'#148#5'0C'#177#129#173'G'#239#192#217'9'
|
||||
+#30#250#24'|b'#0#137#25#141't'#192#130#205#208#254')S'#25#190'}|G'#21#11#24
|
||||
+#231#206']'#248#255#236#217#147'('#134#179'120'#236#219#179#151'"'#131'a'#201
|
||||
+#20#158#27#203#203''''#17'_B'#18#1'`'#25'm'#20#140#130'!'#0#0#6#165#149#157
|
||||
+#16'*hH'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxDBTrackBar','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'SIDATH'#137#237'T'
|
||||
+#177'n'#194'0'#16'}F'#217'*v'#182'D'#130#161#202#152#137'.'#208#181'R'#7'>'#3
|
||||
+']('#234#22'~!S$P,~'#161'_'#208#13#214'N'#29'Y*'#132#170'J'#253#139#234':'#4
|
||||
+#187'Il'#167')*'#27'O'#178'd;'#207#239#249#238'|'#1#206#12#161'&D'#196'j.'
|
||||
+#165#20#0#179#133'.'#204#189#22' "f'#134#30'e'#179#31#216#12''#135' "'#206
|
||||
+'si|'#136'c:FR6(" '#185'7'#204'$'#245#173#209'yJ'#172'l'#18#199#228#184'y1'
|
||||
+#221'm[G'#224#1'@'#158#203#138'hu-*'#245'H'#146#21'z'#189'/L&'#247#154#31#4#3
|
||||
+','#174#150#156#166's#'#10#175','#234#134'2'#17#2'X'#254#169#22'B'#21#212#150
|
||||
+#162'n'#247#218'z'#200#26#193'be'#240#210't.'#26'S4'#157#222#25#135#214#235
|
||||
+'g'#231'm'#203'|'#197'kL'#209#199#251#167'S'#204#6#27#191#241#21#141'n'#199
|
||||
+'F'#209#146#196']'#3#27'_7'#25#17#233#225'n'#182#2#195#217#134#179','#227#195
|
||||
+#225#141#153#153#135#179#141#147#219#242#21'U'#17#133'>'#158'v'#192'c0'#192
|
||||
+#205#195#22'Q'#232#227#197#193#237#0#245#198'2'#215'uH'#234#139'('#244#181
|
||||
+#184#171#139#129#227#207#206#150#142#234'o'#194#14#146'{n'#18#215#6'u'#147'6'
|
||||
+#226''''#195#245'JN'#221#239#252#223#213'.'#184#224'\'#248#6#216#165#172#203
|
||||
+#24'='#180#201#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
|
||||
@ -9,7 +9,7 @@ uses
|
||||
|
||||
procedure Register;
|
||||
implementation
|
||||
uses RxDBSpinEdit, RxDBTimeEdit;
|
||||
uses RxDBSpinEdit, RxDBTimeEdit, RxDBCtrls;
|
||||
|
||||
procedure RegisterRxDBSpinEdit;
|
||||
begin
|
||||
@ -21,10 +21,16 @@ begin
|
||||
RegisterComponents('RX DBAware',[TRxDBTimeEdit]);
|
||||
end;
|
||||
|
||||
procedure RegisterRxDBCtrls;
|
||||
begin
|
||||
RegisterComponents('RX DBAware',[TRxDBProgressBar, TRxDBTrackBar]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('RxDBTimeEdit', @RegisterRxDBTimeEdit);
|
||||
RegisterUnit('RxDBSpinEdit', @RegisterRxDBSpinEdit);
|
||||
RegisterUnit('RxDBCtrls', @RegisterRxDBCtrls);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -519,3 +519,39 @@ LazarusResources.Add('TRxDBTimeEdit','PNG',[
|
||||
+#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
|
||||
]);
|
||||
LazarusResources.Add('TRxDBProgressBar','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'''IDATH'#137'c`'#160
|
||||
+'1`d```'#200#202#202#250#15#19#152'6m'#26'#'#3#195#255#255#184#181#192#181'2'
|
||||
+#18'eCVV'#214#255#255#255#25#224#24#217'2'#220#128#24#7' '#148#254'G'#199#132
|
||||
+'-!'#222#2#166#236#236','#20#1't>'#166#193'0'#195#145#217#184#1#227#255#255
|
||||
+#12#255#145#13#157':u'#26'Cvv'#22'4.pY'#2#215'N0'#30'X`'#134#18#15#24#161#137
|
||||
+#128#184'Hf'#204#202#202#250#143'l'#1#204'7'#188#188#26'$X'#138#9':;'#243#24
|
||||
+#25#24#240#4'Qp`'#16'E'#22#236#218's'#141#161#179'3'#143#17'g'#16#25#153#24
|
||||
+'2x'#214'^'#132#243#183'7'#235'c'#240'q'#129'sg'#206#195#217','#217#217'Y'#12
|
||||
+#216#130#136#129#129#129#161'6'#206#0'I'#219''#12'>1'#128#5#22'$0'#128#204
|
||||
+'?w'#247#11'\'#220'J'#149#27#131'O'#148#5'0C'#177#129#173'G'#239#192#217'9'
|
||||
+#30#250#24'|b'#0#137#25#141't'#192#130#205#208#254')S'#25#190'}|G'#21#11#24
|
||||
+#231#206']'#248#255#236#217#147'('#134#179'120'#236#219#179#151'"'#131'a'#201
|
||||
+#20#158#27#203#203''''#17'_B'#18#1'`'#25'm'#20#140#130'!'#0#0#6#165#149#157
|
||||
+#16'*hH'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('TRxDBTrackBar','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'SIDATH'#137#237'T'
|
||||
+#177'n'#194'0'#16'}F'#217'*v'#182'D'#130#161#202#152#137'.'#208#181'R'#7'>'#3
|
||||
+']('#234#22'~!S$P,~'#161'_'#208#13#214'N'#29'Y*'#132#170'J'#253#139#234':'#4
|
||||
+#187'Il'#167')*'#27'O'#178'd;'#207#239#249#238'|'#1#206#12#161'&D'#196'j.'
|
||||
+#165#20#0#179#133'.'#204#189#22' "f'#134#30'e'#179#31#216#12''#135' "'#206
|
||||
+'si|'#136'c:FR6(" '#185'7'#204'$'#245#173#209'yJ'#172'l'#18#199#228#184'y1'
|
||||
+#221'm[G'#224#1'@'#158#203#138'hu-*'#245'H'#146#21'z'#189'/L&'#247#154#31#4#3
|
||||
+','#174#150#156#166's#'#10#175','#234#134'2'#17#2'X'#254#169#22'B'#21#212#150
|
||||
+#162'n'#247#218'z'#200#26#193'be'#240#210't.'#26'S4'#157#222#25#135#214#235
|
||||
+'g'#231'm'#203'|'#197'kL'#209#199#251#167'S'#204#6#27#191#241#21#141'n'#199
|
||||
+'F'#209#146#196']'#3#27'_7'#25#17#233#225'n'#182#2#195#217#134#179','#227#195
|
||||
+#225#141#153#153#135#179#141#147#219#242#21'U'#17#133'>'#158'v'#192'c0'#192
|
||||
+#205#195#22'Q'#232#227#197#193#237#0#245#198'2'#215'uH'#234#139'('#244#181
|
||||
+#184#171#139#129#227#207#206#150#142#234'o'#194#14#146'{n'#18#215#6'u'#147'6'
|
||||
+#226''''#195#245'JN'#221#239#252#223#213'.'#184#224'\'#248#6#216#165#172#203
|
||||
+#24'='#180#201#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
|
||||
398
components/rx/rxdbctrls.pas
Normal file
398
components/rx/rxdbctrls.pas
Normal file
@ -0,0 +1,398 @@
|
||||
unit RxDBCtrls;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ComCtrls, DB, DbCtrls, LMessages, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TCustomRxDBProgressBar }
|
||||
|
||||
TCustomRxDBProgressBar = class(TCustomProgressBar)
|
||||
private
|
||||
FDataLink: TFieldDataLink;
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
procedure SetDataField(const AValue: string);
|
||||
procedure SetDataSource(const AValue: TDataSource);
|
||||
procedure DataChange(Sender: TObject);
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
procedure LayoutChange(Sender: TObject);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
protected
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Field: TField read GetField;
|
||||
end;
|
||||
|
||||
TRxDBProgressBar = class(TCustomRxDBProgressBar)
|
||||
published
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property BorderWidth;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property Hint;
|
||||
property Max;
|
||||
property Min;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDock;
|
||||
property OnStartDrag;
|
||||
property Orientation;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Smooth;
|
||||
property Step;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Visible;
|
||||
property BarShowText;
|
||||
end;
|
||||
|
||||
type
|
||||
|
||||
{ TCustomRxDBTrackBar }
|
||||
|
||||
TCustomRxDBTrackBar = class(TCustomTrackBar)
|
||||
private
|
||||
FDataLink: TFieldDataLink;
|
||||
FInScrollEvent:boolean;
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
procedure SetDataField(const AValue: string);
|
||||
procedure SetDataSource(const AValue: TDataSource);
|
||||
procedure DataChange(Sender: TObject);
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
procedure LayoutChange(Sender: TObject);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
||||
function GetReadOnly: Boolean;
|
||||
procedure SetReadOnly(const AValue: Boolean);
|
||||
function IsReadOnly: boolean;
|
||||
procedure UpdateData(Sender: TObject);
|
||||
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 DoChange(var msg); message LM_CHANGED;
|
||||
// procedure Change; override;
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Field: TField read GetField;
|
||||
end;
|
||||
|
||||
TRxDBTrackBar = class(TCustomRxDBTrackBar)
|
||||
published
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property ReadOnly;
|
||||
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property Frequency;
|
||||
property Hint;
|
||||
property LineSize;
|
||||
property Max;
|
||||
property Min;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelDown;
|
||||
property OnMouseWheelUp;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property Orientation;
|
||||
property PageSize;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ScalePos;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property TickMarks;
|
||||
property TickStyle;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses dbutils;
|
||||
|
||||
type
|
||||
TFieldDataLinkHack = class(TFieldDataLink)
|
||||
end;
|
||||
|
||||
{ TCustomRxDBProgressBar }
|
||||
|
||||
function TCustomRxDBProgressBar.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomRxDBProgressBar.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomRxDBProgressBar.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
DataChange(Sender)
|
||||
else
|
||||
begin
|
||||
Text := '';
|
||||
FDataLink.Reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.LayoutChange(Sender: TObject);
|
||||
begin
|
||||
DataChange(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBProgressBar.DataChange(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in IntegerDataTypes) then
|
||||
Self.Position:=FDatalink.Field.AsInteger
|
||||
else
|
||||
Position:=Min
|
||||
end;
|
||||
|
||||
constructor TCustomRxDBProgressBar.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnActiveChange := @ActiveChange;
|
||||
FDataLink.OnLayoutChange := @LayoutChange;
|
||||
end;
|
||||
|
||||
destructor TCustomRxDBProgressBar.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDataLink);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TCustomRxDBTrackBar }
|
||||
|
||||
function TCustomRxDBTrackBar.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTrackBar.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTrackBar.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.DataChange(Sender: TObject);
|
||||
begin
|
||||
FInScrollEvent:=true;
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in IntegerDataTypes) then
|
||||
Self.Position:=FDatalink.Field.AsInteger
|
||||
else
|
||||
Self.Position:=0;
|
||||
FInScrollEvent:=false;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
DataChange(Sender)
|
||||
else
|
||||
begin
|
||||
Position:=0;
|
||||
FDataLink.Reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.LayoutChange(Sender: TObject);
|
||||
begin
|
||||
DataChange(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.WMSetFocus(var Message: TLMSetFocus);
|
||||
begin
|
||||
inherited WMSetFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
inherited WMKillFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset
|
||||
else
|
||||
TFieldDataLinkHack(FDatalink).UpdateData;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTrackBar.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
inherited;
|
||||
FDataLink.ReadOnly := AValue;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTrackBar.IsReadOnly: boolean;
|
||||
begin
|
||||
result := true;
|
||||
if FDatalink.Active and not Self.ReadOnly then
|
||||
result := (Field=nil) or Field.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.UpdateData(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in IntegerDataTypes) then
|
||||
FDataLink.Field.AsInteger := Self.Position;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.DoChange(var msg);
|
||||
begin
|
||||
inherited DoChange(Msg);
|
||||
if not FInScrollEvent then
|
||||
begin
|
||||
FDatalink.Edit;
|
||||
FDataLink.Modified;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
procedure TCustomRxDBTrackBar.Change;
|
||||
begin
|
||||
FDatalink.Edit;
|
||||
FDataLink.Modified;
|
||||
inherited Change;
|
||||
end;
|
||||
}
|
||||
procedure TCustomRxDBTrackBar.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTrackBar.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;
|
||||
|
||||
constructor TCustomRxDBTrackBar.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FInScrollEvent:=false;
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
FDataLink.OnActiveChange := @ActiveChange;
|
||||
FDataLink.OnLayoutChange := @LayoutChange;
|
||||
end;
|
||||
|
||||
destructor TCustomRxDBTrackBar.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDataLink);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -8,11 +8,6 @@ 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
|
||||
|
||||
@ -100,6 +95,7 @@ type
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses dbutils;
|
||||
|
||||
type
|
||||
TFieldDataLinkHack = class(TFieldDataLink)
|
||||
@ -280,8 +276,7 @@ end;
|
||||
|
||||
destructor TCustomRxDBSpinEdit.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
FreeAndNil(FDataLink);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
@ -6,25 +6,278 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
RxTimeEdit;
|
||||
RxTimeEdit, DB, DbCtrls, LMessages, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TCustomRxDBTimeEdit }
|
||||
|
||||
TCustomRxDBTimeEdit = class(TCustomRxTimeEdit)
|
||||
private
|
||||
{ Private declarations }
|
||||
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;
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
||||
protected
|
||||
{ Protected declarations }
|
||||
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;
|
||||
public
|
||||
{ Public declarations }
|
||||
published
|
||||
{ Published declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Field: TField read GetField;
|
||||
end;
|
||||
|
||||
TRxDBTimeEdit = class(TCustomRxDBTimeEdit)
|
||||
published
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property ReadOnly;
|
||||
|
||||
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 ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses dbutils;
|
||||
|
||||
type
|
||||
TFieldDataLinkHack = class(TFieldDataLink)
|
||||
end;
|
||||
|
||||
{ TCustomRxDBTimeEdit }
|
||||
|
||||
procedure TCustomRxDBTimeEdit.DataChange(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in TimeDataTypes) then
|
||||
Self.Time:=FDatalink.Field.AsDateTime
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
function TCustomRxDBTimeEdit.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTimeEdit.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTimeEdit.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
function TCustomRxDBTimeEdit.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
inherited;
|
||||
FDataLink.ReadOnly := AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.UpdateData(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in TimeDataTypes) then
|
||||
begin
|
||||
FDataLink.Field.AsDateTime := Self.Time;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
DataChange(Sender)
|
||||
else
|
||||
begin
|
||||
Text := '';
|
||||
FDataLink.Reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.LayoutChange(Sender: TObject);
|
||||
begin
|
||||
DataChange(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
function TCustomRxDBTimeEdit.IsReadOnly: boolean;
|
||||
begin
|
||||
result := true;
|
||||
if FDatalink.Active and not Self.ReadOnly then
|
||||
result := (Field=nil) or Field.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.WMSetFocus(var Message: TLMSetFocus);
|
||||
begin
|
||||
inherited WMSetFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.WMKillFocus(var Message: TLMKillFocus);
|
||||
begin
|
||||
inherited WMKillFocus(Message);
|
||||
if not FDatalink.Editing then
|
||||
FDatalink.Reset
|
||||
else
|
||||
TFieldDataLinkHack(FDatalink).UpdateData;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.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 TCustomRxDBTimeEdit.Change;
|
||||
begin
|
||||
FDatalink.Edit;
|
||||
FDataLink.Modified;
|
||||
inherited Change;
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomRxDBTimeEdit.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;
|
||||
|
||||
constructor TCustomRxDBTimeEdit.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 TCustomRxDBTimeEdit.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDataLink);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -21,7 +21,7 @@ translate to Lazarus by alexs in 2005 - 2009
|
||||
<License Value="free ware
|
||||
"/>
|
||||
<Version Major="1" Minor="2" Release="1" Build="98"/>
|
||||
<Files Count="50">
|
||||
<Files Count="51">
|
||||
<Item1>
|
||||
<Filename Value="rxlookup.pas"/>
|
||||
<UnitName Value="rxlookup"/>
|
||||
@ -224,6 +224,10 @@ translate to Lazarus by alexs in 2005 - 2009
|
||||
<Filename Value="rxdbtimeedit.pas"/>
|
||||
<UnitName Value="RxDBTimeEdit"/>
|
||||
</Item50>
|
||||
<Item51>
|
||||
<Filename Value="rxdbctrls.pas"/>
|
||||
<UnitName Value="rxdbctrls"/>
|
||||
</Item51>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="4">
|
||||
|
||||
@ -15,7 +15,7 @@ uses
|
||||
fduallst, rxxpman, pagemngr, rxappicon, seldsfrm, rxctrls, rxlogin,
|
||||
rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit, rxcustomchartpanel,
|
||||
rxsortmemds, AutoPanel, pickdate, rxiconv, rxceEditLookupFields, rxclock,
|
||||
rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit,
|
||||
rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit, RxDBCtrls,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
@ -140,7 +140,7 @@ end;
|
||||
procedure TCustomRxTimeEdit.DoChangeValue(AValue: integer);
|
||||
var
|
||||
S:ShortString;
|
||||
H1, M2, S3:byte;
|
||||
H1, M2, S3:Integer;
|
||||
i,p:integer;
|
||||
|
||||
procedure IncHour;
|
||||
|
||||
@ -283,9 +283,11 @@ begin
|
||||
ACanvas := TControlCanvas.Create;
|
||||
ACanvas.Control := Editor;
|
||||
end;
|
||||
|
||||
DC := Message.DC;
|
||||
if DC = 0 then DC := BeginPaint(Handle, PS);
|
||||
ACanvas.Handle := DC;
|
||||
|
||||
try
|
||||
ACanvas.Font := Font;
|
||||
if not Enabled and NewStyleControls and not
|
||||
@ -295,12 +297,14 @@ begin
|
||||
with ACanvas do
|
||||
begin
|
||||
R := ClientRect;
|
||||
if not (NewStyleControls {and Ctl3D}) and (BorderStyle = bsSingle) then
|
||||
{
|
||||
if not (NewStyleControls ) and (BorderStyle = bsSingle) then
|
||||
begin
|
||||
Brush.Color := clWindowFrame;
|
||||
{ FrameRect(R);
|
||||
InflateRect(R, -1, -1);}
|
||||
FrameRect(R);
|
||||
InflateRect(R, -1, -1);
|
||||
end;
|
||||
}
|
||||
Brush.Color := Color;
|
||||
S := AText;
|
||||
AWidth := TextWidth(S);
|
||||
|
||||
Reference in New Issue
Block a user