From aaf09b3fb1e2dbde9b941ad54889441534a253e7 Mon Sep 17 00:00:00 2001 From: alexs75 Date: Tue, 30 Oct 2007 11:43:24 +0000 Subject: [PATCH] minor fix in TRxDBLookupCombo, TRxLookupEdit. New procedure in rxstrutils git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@282 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/rx/docs/WhatsNew.eng.txt | 2 + components/rx/docs/WhatsNew.rus.txt | 6 + components/rx/docs/todo.txt | 1 - components/rx/fduallst.lfm | 12 +- components/rx/fduallst.lrs | 75 ++++++------ components/rx/fduallst.pas | 14 +-- components/rx/registerrx.pas | 7 +- components/rx/rx.inc | 2 + components/rx/rxappicon.pas | 6 + components/rx/rxceeditlookupfields.pas | 154 +++++++++++++++++++++++++ components/rx/rxctrls.pas | 5 +- components/rx/rxlookup.pas | 20 +++- components/rx/rxnew.lpk | 16 ++- components/rx/rxnew.pas | 2 +- components/rx/rxpopupunit.pas | 12 +- components/rx/rxstrutils.pas | 29 ++++- 16 files changed, 298 insertions(+), 65 deletions(-) create mode 100644 components/rx/rxceeditlookupfields.pas diff --git a/components/rx/docs/WhatsNew.eng.txt b/components/rx/docs/WhatsNew.eng.txt index df7105096..75c1ac456 100644 --- a/components/rx/docs/WhatsNew.eng.txt +++ b/components/rx/docs/WhatsNew.eng.txt @@ -12,6 +12,8 @@ + in RxDBGrid images of markers moved to rxdbgrids.lrs (Petr Smolik) + add module for autosort in RxDBGrid exsortzeos.pas for ZeosDB (Petr Smolik) - In TCurrencyEdit property BorderSpacing now published + + New procedure StrToStrings in module rxstrutils - fill List:TStrings + procedure StrToStrings(const S:string; const List:TStrings; const Delims:Char); 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 4d19823a2..27a89f0eb 100644 --- a/components/rx/docs/WhatsNew.rus.txt +++ b/components/rx/docs/WhatsNew.rus.txt @@ -15,6 +15,12 @@ + В RxDBGrid изображения маркеров вынесены в ресурсы (Petr Smolik) + Добавлен модуль автоматической сортировки в RxDBGrid exsortzeos.pas для ZeosDB (Petr Smolik) - В TCurrencyEdit опубликовано свойство BorderSpacing + + В модуль rxstrutils добавлена процедура StrToStrings - заполняет класс TStrings строками + содержащимися в строке S и разделёнными симовлом Delims + + Реализован редактор свойств для полей LookupField и LookupDisplay у компонент + TRxLookupEdit и TRxDBLookupCombo + + TRxDBLookupCombo реализована поддержка свойства AutoSize + + При установке свойства Font у TRxDBLookupCombo выпадающий список использует этот же шрифт 29.08.2007 - версия 1.1.5.98 (svn revision 39) + В RxDBGrid После закрытия набора данных список помеченных строк (SelectedRows) очищается diff --git a/components/rx/docs/todo.txt b/components/rx/docs/todo.txt index 6c596ceec..ada1fd2ec 100644 --- a/components/rx/docs/todo.txt +++ b/components/rx/docs/todo.txt @@ -10,4 +10,3 @@ | | | |-----------------| -3. TRxDbComboBox не правильно отображает начальные значение из поля \ No newline at end of file diff --git a/components/rx/fduallst.lfm b/components/rx/fduallst.lfm index 1477a4aee..0d67529bc 100644 --- a/components/rx/fduallst.lfm +++ b/components/rx/fduallst.lfm @@ -5,9 +5,12 @@ object DualListForm: TDualListForm Width = 392 HorzScrollBar.Page = 391 VertScrollBar.Page = 268 + ActiveControl = SrcList BorderIcons = [] BorderStyle = bsDialog Caption = 'DualListForm' + ClientHeight = 269 + ClientWidth = 392 Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] @@ -27,7 +30,6 @@ object DualListForm: TDualListForm Top = 12 Width = 34 Caption = 'Source' - Color = clNone ParentColor = False end object DstLabel: TLabel @@ -36,7 +38,6 @@ object DualListForm: TDualListForm Top = 12 Width = 23 Caption = 'Dest' - Color = clNone ParentColor = False end object SrcList: TListBox @@ -74,6 +75,7 @@ object DualListForm: TDualListForm Height = 26 Top = 32 Width = 26 + BorderSpacing.InnerBorder = 4 Caption = '>' Font.Color = clBlack Font.Height = -12 @@ -87,6 +89,7 @@ object DualListForm: TDualListForm Height = 26 Top = 64 Width = 26 + BorderSpacing.InnerBorder = 4 Caption = '>>' Font.Color = clBlack Font.Height = -12 @@ -100,6 +103,7 @@ object DualListForm: TDualListForm Height = 26 Top = 97 Width = 26 + BorderSpacing.InnerBorder = 4 Caption = '<' Font.Color = clBlack Font.Height = -12 @@ -113,6 +117,7 @@ object DualListForm: TDualListForm Height = 26 Top = 129 Width = 26 + BorderSpacing.InnerBorder = 4 Caption = '<<' Font.Color = clBlack Font.Height = -12 @@ -126,6 +131,7 @@ object DualListForm: TDualListForm Height = 25 Top = 239 Width = 77 + BorderSpacing.InnerBorder = 4 Caption = 'OK' Default = True ModalResult = 1 @@ -136,6 +142,7 @@ object DualListForm: TDualListForm Height = 25 Top = 239 Width = 77 + BorderSpacing.InnerBorder = 4 Cancel = True Caption = 'Cancel' ModalResult = 2 @@ -146,6 +153,7 @@ object DualListForm: TDualListForm Height = 25 Top = 239 Width = 77 + BorderSpacing.InnerBorder = 4 Caption = 'Help' OnClick = HelpBtnClick TabOrder = 8 diff --git a/components/rx/fduallst.lrs b/components/rx/fduallst.lrs index 3808d5953..ab21803e8 100644 --- a/components/rx/fduallst.lrs +++ b/components/rx/fduallst.lrs @@ -3,41 +3,44 @@ LazarusResources.Add('TDualListForm','FORMDATA',[ 'TPF0'#13'TDualListForm'#12'DualListForm'#4'Left'#3'7'#1#6'Height'#3#13#1#3'T' +'op'#3#225#0#5'Width'#3#136#1#18'HorzScrollBar.Page'#3#135#1#18'VertScrollBa' - +'r.Page'#3#12#1#11'BorderIcons'#11#0#11'BorderStyle'#7#8'bsDialog'#7'Caption' - +#6#12'DualListForm'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#10 - +'Font.Style'#11#6'fsBold'#0#10'OnActivate'#7#9'ListClick'#8'OnCreate'#7#10'F' - +'ormCreate'#6'OnShow'#7#9'ListClick'#8'Position'#7#14'poScreenCenter'#0#6'TB' - +'evel'#6'Bevel1'#4'Left'#2#4#6'Height'#3#224#0#3'Top'#2#7#5'Width'#3#128#1#0 - +#0#6'TLabel'#8'SrcLabel'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#12#5'Width'#2 - +'"'#7'Caption'#6#6'Source'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLab' - +'el'#8'DstLabel'#4'Left'#3#216#0#6'Height'#2#14#3'Top'#2#12#5'Width'#2#23#7 - +'Caption'#6#4'Dest'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#8'TListBox'#7 - +'SrcList'#4'Left'#2#12#6'Height'#3#194#0#3'Top'#2#30#5'Width'#3#164#0#10'Ite' - +'mHeight'#2#13#11'MultiSelect'#9#7'OnClick'#7#9'ListClick'#10'OnDblClick'#7 - +#11'IncBtnClick'#9'OnKeyDown'#7#14'SrcListKeyDown'#14'ParentShowHint'#8#8'Sh' - +'owHint'#9#6'Sorted'#9#8'TabOrder'#2#0#0#0#8'TListBox'#7'DstList'#4'Left'#3 - +#216#0#6'Height'#3#194#0#3'Top'#2#30#5'Width'#3#164#0#10'ItemHeight'#2#13#11 - +'MultiSelect'#9#7'OnClick'#7#9'ListClick'#10'OnDblClick'#7#12'ExclBtnClick'#9 - +'OnKeyDown'#7#14'DstListKeyDown'#14'ParentShowHint'#8#8'ShowHint'#9#6'Sorted' - +#9#8'TabOrder'#2#5#0#0#7'TButton'#6'IncBtn'#4'Left'#3#183#0#6'Height'#2#26#3 - +'Top'#2' '#5'Width'#2#26#7'Caption'#6#1'>'#10'Font.Color'#7#7'clBlack'#11'Fo' - +'nt.Height'#2#244#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsBol' - +'d'#0#7'OnClick'#7#11'IncBtnClick'#8'TabOrder'#2#1#0#0#7'TButton'#9'IncAllBt' - +'n'#4'Left'#3#183#0#6'Height'#2#26#3'Top'#2'@'#5'Width'#2#26#7'Caption'#6#2 - +'>>'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#244#9'Font.Name'#6#13'MS ' - +'Sans Serif'#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#14'IncAllBtnClick'#8 - +'TabOrder'#2#2#0#0#7'TButton'#7'ExclBtn'#4'Left'#3#183#0#6'Height'#2#26#3'To' - +'p'#2'a'#5'Width'#2#26#7'Caption'#6#1'<'#10'Font.Color'#7#7'clBlack'#11'Font' + +'r.Page'#3#12#1#13'ActiveControl'#7#7'SrcList'#11'BorderIcons'#11#0#11'Borde' + +'rStyle'#7#8'bsDialog'#7'Caption'#6#12'DualListForm'#12'ClientHeight'#3#13#1 + +#11'ClientWidth'#3#136#1#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Ser' + +'if'#10'Font.Style'#11#6'fsBold'#0#10'OnActivate'#7#9'ListClick'#8'OnCreate' + +#7#10'FormCreate'#6'OnShow'#7#9'ListClick'#8'Position'#7#14'poScreenCenter'#0 + +#6'TBevel'#6'Bevel1'#4'Left'#2#4#6'Height'#3#224#0#3'Top'#2#7#5'Width'#3#128 + +#1#0#0#6'TLabel'#8'SrcLabel'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#12#5'Width' + +#2'"'#7'Caption'#6#6'Source'#11'ParentColor'#8#0#0#6'TLabel'#8'DstLabel'#4'L' + +'eft'#3#216#0#6'Height'#2#14#3'Top'#2#12#5'Width'#2#23#7'Caption'#6#4'Dest' + +#11'ParentColor'#8#0#0#8'TListBox'#7'SrcList'#4'Left'#2#12#6'Height'#3#194#0 + +#3'Top'#2#30#5'Width'#3#164#0#10'ItemHeight'#2#13#11'MultiSelect'#9#7'OnClic' + +'k'#7#9'ListClick'#10'OnDblClick'#7#11'IncBtnClick'#9'OnKeyDown'#7#14'SrcLis' + +'tKeyDown'#14'ParentShowHint'#8#8'ShowHint'#9#6'Sorted'#9#8'TabOrder'#2#0#0#0 + +#8'TListBox'#7'DstList'#4'Left'#3#216#0#6'Height'#3#194#0#3'Top'#2#30#5'Widt' + +'h'#3#164#0#10'ItemHeight'#2#13#11'MultiSelect'#9#7'OnClick'#7#9'ListClick' + +#10'OnDblClick'#7#12'ExclBtnClick'#9'OnKeyDown'#7#14'DstListKeyDown'#14'Pare' + +'ntShowHint'#8#8'ShowHint'#9#6'Sorted'#9#8'TabOrder'#2#5#0#0#7'TButton'#6'In' + +'cBtn'#4'Left'#3#183#0#6'Height'#2#26#3'Top'#2' '#5'Width'#2#26#25'BorderSpa' + +'cing.InnerBorder'#2#4#7'Caption'#6#1'>'#10'Font.Color'#7#7'clBlack'#11'Font' +'.Height'#2#244#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsBold' - +#0#7'OnClick'#7#12'ExclBtnClick'#8'TabOrder'#2#3#0#0#7'TButton'#10'ExclAllBt' - +'n'#4'Left'#3#183#0#6'Height'#2#26#3'Top'#3#129#0#5'Width'#2#26#7'Caption'#6 - +#2'<<'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#244#9'Font.Name'#6#13'M' - +'S Sans Serif'#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#15'ExclAllBtnClick' - +#8'TabOrder'#2#4#0#0#7'TButton'#5'OkBtn'#4'Left'#3#138#0#6'Height'#2#25#3'To' - +'p'#3#239#0#5'Width'#2'M'#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1 - +#8'TabOrder'#2#6#0#0#7'TButton'#9'CancelBtn'#4'Left'#3#221#0#6'Height'#2#25#3 - +'Top'#3#239#0#5'Width'#2'M'#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResul' - +'t'#2#2#8'TabOrder'#2#7#0#0#7'TButton'#7'HelpBtn'#4'Left'#3'6'#1#6'Height'#2 - +#25#3'Top'#3#239#0#5'Width'#2'M'#7'Caption'#6#4'Help'#7'OnClick'#7#12'HelpBt' - +'nClick'#8'TabOrder'#2#8#0#0#0 + +#0#7'OnClick'#7#11'IncBtnClick'#8'TabOrder'#2#1#0#0#7'TButton'#9'IncAllBtn'#4 + +'Left'#3#183#0#6'Height'#2#26#3'Top'#2'@'#5'Width'#2#26#25'BorderSpacing.Inn' + +'erBorder'#2#4#7'Caption'#6#2'>>'#10'Font.Color'#7#7'clBlack'#11'Font.Height' + +#2#244#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsBold'#0#7'OnCl' + +'ick'#7#14'IncAllBtnClick'#8'TabOrder'#2#2#0#0#7'TButton'#7'ExclBtn'#4'Left' + +#3#183#0#6'Height'#2#26#3'Top'#2'a'#5'Width'#2#26#25'BorderSpacing.InnerBord' + +'er'#2#4#7'Caption'#6#1'<'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#244 + +#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7 + +#12'ExclBtnClick'#8'TabOrder'#2#3#0#0#7'TButton'#10'ExclAllBtn'#4'Left'#3#183 + +#0#6'Height'#2#26#3'Top'#3#129#0#5'Width'#2#26#25'BorderSpacing.InnerBorder' + +#2#4#7'Caption'#6#2'<<'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#244#9 + +'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#15 + +'ExclAllBtnClick'#8'TabOrder'#2#4#0#0#7'TButton'#5'OkBtn'#4'Left'#3#138#0#6 + +'Height'#2#25#3'Top'#3#239#0#5'Width'#2'M'#25'BorderSpacing.InnerBorder'#2#4 + +#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#6#0#0#7'T' + +'Button'#9'CancelBtn'#4'Left'#3#221#0#6'Height'#2#25#3'Top'#3#239#0#5'Width' + +#2'M'#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11 + +'ModalResult'#2#2#8'TabOrder'#2#7#0#0#7'TButton'#7'HelpBtn'#4'Left'#3'6'#1#6 + +'Height'#2#25#3'Top'#3#239#0#5'Width'#2'M'#25'BorderSpacing.InnerBorder'#2#4 + +#7'Caption'#6#4'Help'#7'OnClick'#7#12'HelpBtnClick'#8'TabOrder'#2#8#0#0#0 ]); diff --git a/components/rx/fduallst.pas b/components/rx/fduallst.pas index 7348cff50..24cec597f 100644 --- a/components/rx/fduallst.pas +++ b/components/rx/fduallst.pas @@ -138,20 +138,20 @@ procedure TDualListForm.SrcListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin BoxDragOver(SrcList, Source, X, Y, State, Accept, SrcList.Sorted); -{ if State = dsDragLeave then + if State = dsDragLeave then (Source as TListBox).DragCursor := crDrag; if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then - (Source as TListBox).DragCursor := crMultiDrag;} + (Source as TListBox).DragCursor := crMultiDrag; end; procedure TDualListForm.DstListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin BoxDragOver(DstList, Source, X, Y, State, Accept, DstList.Sorted); -{ if State = dsDragLeave then + if State = dsDragLeave then (Source as TListBox).DragCursor := crDrag; if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then - (Source as TListBox).DragCursor := crMultiDrag;} + (Source as TListBox).DragCursor := crMultiDrag; end; procedure TDualListForm.SrcListDragDrop(Sender, Source: TObject; X, @@ -209,9 +209,9 @@ end; procedure TDualListForm.FormCreate(Sender: TObject); begin -{ OkBtn.Caption := ResStr(SOKButton); - CancelBtn.Caption := ResStr(SCancelButton); - HelpBtn.Caption := ResStr(SHelpButton);} +{ OkBtn.Caption := SOKButton; + CancelBtn.Caption := SCancelButton; + HelpBtn.Caption := SHelpButton;} if NewStyleControls then Font.Style := []; end; diff --git a/components/rx/registerrx.pas b/components/rx/registerrx.pas index 3d0c0b592..25b53bc27 100644 --- a/components/rx/registerrx.pas +++ b/components/rx/registerrx.pas @@ -10,10 +10,12 @@ uses procedure Register; implementation -uses PropEdits, dbdateedit, rxlookup, folderlister, rxdbgrid, rxmemds, duallist, +uses + PropEdits, dbdateedit, rxlookup, folderlister, rxdbgrid, rxmemds, duallist, curredit, rxswitch, rxdice, rxdbcomb, rxtoolbar, rxxpman, PageMngr, RxAppIcon, Dialogs, ComponentEditors, seldsfrm, DBPropEdits, DB, rxctrls, RxLogin, - RxCustomChartPanel, AutoPanel, pickdate, rxconst, tooledit; + RxCustomChartPanel, AutoPanel, pickdate, rxconst, tooledit, + rxceEditLookupFields; type @@ -253,6 +255,7 @@ begin RegisterComponentEditor(TRxMemoryData, TMemDataSetEditor); // RegisterPropertyEditor(TypeInfo(string), TRxColumn, 'FieldName', TRxDBGridFieldProperty); + RegisterCEEditLookupFields; end; initialization diff --git a/components/rx/rx.inc b/components/rx/rx.inc index 53571c309..a2bf84224 100644 --- a/components/rx/rx.inc +++ b/components/rx/rx.inc @@ -6,3 +6,5 @@ {.$DEFINE ENABLE_Child_Defs} {$DEFINE NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID} {$DEFINE RXDBGRID_OPTIONS_WO_CANCEL_ON_EXIT} +{.$DEFINE USED_BiDi} +{$DEFINE DEFAULT_POPUP_CALENDAR} diff --git a/components/rx/rxappicon.pas b/components/rx/rxappicon.pas index 490982908..37c8f3cd6 100644 --- a/components/rx/rxappicon.pas +++ b/components/rx/rxappicon.pas @@ -35,8 +35,10 @@ type implementation {$IFDEF WIN32} +{$IFNDEF LCLGtk2} uses Windows, win32int, InterfaceBase, vclutils; {$ENDIF} +{$ENDIF} { TRxAppIcon } @@ -86,6 +88,7 @@ end; procedure TRxAppIcon.ApplyIcon; {$IFDEF WIN32} +{$IFNDEF LCLGtk2} procedure DoApply; var H:HICON; @@ -106,12 +109,15 @@ begin end; end; {$ENDIF} +{$ENDIF} begin if FIconStream.Size>0 then begin Icon.LoadFromStream(FIconStream); {$IFDEF WIN32} +{$IFNDEF LCLGtk2} DoApply; +{$ENDIF} {$ENDIF} end; FIconStream.Position:=0; diff --git a/components/rx/rxceeditlookupfields.pas b/components/rx/rxceeditlookupfields.pas new file mode 100644 index 000000000..93665d2c2 --- /dev/null +++ b/components/rx/rxceeditlookupfields.pas @@ -0,0 +1,154 @@ +unit rxceEditLookupFields; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, PropEdits; + +type + + { TLookupFieldProperty } + + TLookupFieldProperty = class(TStringPropertyEditor) + public + function GetAttributes: TPropertyAttributes; override; + procedure GetValues(Proc: TGetStrProc); override; + procedure FillValues(const Values: TStrings); virtual; + end; + + { TLookupDisplayProperty } + + TLookupDisplayProperty = class(TLookupFieldProperty) + public + function GetAttributes: TPropertyAttributes; override; + procedure Edit; override; + end; + +procedure RegisterCEEditLookupFields; +implementation +uses + // + db, duallist, Forms, rxstrutils, TypInfo, + //unit for edits + rxlookup; + +procedure RegisterCEEditLookupFields; +begin + RegisterPropertyEditor(TypeInfo(string), TRxDBLookupCombo, 'LookupField', TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TRxDBLookupCombo, 'LookupDisplay', TLookupDisplayProperty); + RegisterPropertyEditor(TypeInfo(string), TRxLookupEdit, 'LookupField', TLookupFieldProperty); + RegisterPropertyEditor(TypeInfo(string), TRxLookupEdit, 'LookupDisplay', TLookupDisplayProperty); +end; + +{ TLookupFieldProperty } + +function TLookupFieldProperty.GetAttributes: TPropertyAttributes; +begin + Result:= [paValueList, paSortList, paMultiSelect]; +end; + +procedure TLookupFieldProperty.GetValues(Proc: TGetStrProc); +var + I: Integer; + Values: TStringList; +begin + Values := TStringList.Create; + try + FillValues(Values); + for I := 0 to Values.Count - 1 do Proc(Values[I]); + finally + Values.Free; + end; +end; + +procedure TLookupFieldProperty.FillValues(const Values: TStrings); +var + DataSource: TDataSource; +begin + DataSource := GetObjectProp(GetComponent(0), 'LookupSource') as TDataSource; +// DataSource := TRxDBLookupCombo(GetComponent(0)).LookupSource; + if (DataSource is TDataSource) and Assigned(DataSource.DataSet) then + DataSource.DataSet.GetFieldNames(Values); +end; + +{ TLookupDisplayProperty } + +function TLookupDisplayProperty.GetAttributes: TPropertyAttributes; +begin + Result:=inherited GetAttributes + [paDialog] +end; + +procedure TLookupDisplayProperty.Edit; +var + DualListDialog1: TDualListDialog; + Cmp1:TRxDBLookupCombo; + Cmp2:TRxLookupEdit; + +procedure DoInitFill; +var + i,j:integer; + LookupDisplay:string; +begin + if Assigned(Cmp1) then + LookupDisplay:=Cmp1.LookupDisplay + else + LookupDisplay:=Cmp2.LookupDisplay; + if LookupDisplay<>'' then + begin + StrToStrings(LookupDisplay, DualListDialog1.List2, ';'); + for i:=DualListDialog1.List1.Count-1 downto 0 do + begin + j:=DualListDialog1.List2.IndexOf(DualListDialog1.List1[i]); + if j>=0 then + DualListDialog1.List1.Delete(i); + end; + end; +end; + +function DoFillDone:string; +var + i:integer; +begin + for i:=0 to DualListDialog1.List2.Count-1 do + Result:=Result + DualListDialog1.List2[i]+';'; + if Result<>'' then + Result:=Copy(Result, 1, Length(Result)-1); +end; + +procedure DoSetCaptions; +begin + DualListDialog1.Label1Caption:='All fields'; + DualListDialog1.Label2Caption:='Fields is LookupDisplay'; + DualListDialog1.Title:='Fill fields in LookupDisplay property'; +end; + +begin + Cmp1:=nil; + Cmp2:=nil; + + if GetComponent(0) is TRxDBLookupCombo then + Cmp1:=TRxDBLookupCombo(GetComponent(0)) + else + Cmp2:=TRxLookupEdit(GetComponent(0)); + + DualListDialog1:=TDualListDialog.Create(Application); + try + DoSetCaptions; + FillValues(DualListDialog1.List1); + DoInitFill; + if DualListDialog1.Execute then + begin + if Assigned(Cmp1) then + Cmp1.LookupDisplay:=DoFillDone + else + Cmp2.LookupDisplay:=DoFillDone; + end; + finally + FreeAndNil(DualListDialog1); + end; +end; + +end. + diff --git a/components/rx/rxctrls.pas b/components/rx/rxctrls.pas index 0ea241f51..645723850 100644 --- a/components/rx/rxctrls.pas +++ b/components/rx/rxctrls.pas @@ -14,7 +14,8 @@ unit rxctrls; interface uses LResources, LCLType, LCLIntf, LMessages, Classes, Controls, Graphics, - StdCtrls, ExtCtrls, Forms, Buttons, Menus, RxConst, IniFiles, GraphType{, Placemnt}; + StdCtrls, ExtCtrls, Forms, Buttons, Menus, RxConst, IniFiles, GraphType + {, Placemnt}; type TPositiveInt = 1..MaxInt; @@ -915,7 +916,7 @@ function CheckBitmap: TBitmap; implementation -uses SysUtils, Dialogs, CommCtrl, VCLUtils, Math, RxAppUtils, ImgList, +uses SysUtils, Dialogs, {CommCtrl,} VCLUtils, Math, RxAppUtils, ImgList, ActnList (* Consts, {$IFDEF RX_D6}, RTLConsts{$ENDIF} *) diff --git a/components/rx/rxlookup.pas b/components/rx/rxlookup.pas index 46d1d4461..bf569febe 100644 --- a/components/rx/rxlookup.pas +++ b/components/rx/rxlookup.pas @@ -182,6 +182,7 @@ type procedure UpdateData; procedure OnClosePopup(AResult:boolean); protected + procedure DoAutoSize; override; procedure SetEnabled(Value: Boolean); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: char); override; @@ -923,7 +924,7 @@ begin FLookupDataLink.DataSet.First; FRxPopUpForm:=ShowRxDBPopUpForm(Self, FLookupDataLink.DataSet, @OnClosePopup, - FPopUpFormOptions, FLookupDisplay, LookupDisplayIndex, ButtonWidth); + FPopUpFormOptions, FLookupDisplay, LookupDisplayIndex, ButtonWidth, Font); end end; @@ -969,7 +970,7 @@ begin FillPopupWidth(FPopUpFormOptions, FRxPopUpForm); FRxPopUpForm:=nil; - if AResult then + if AResult and Assigned(FDataLink.DataSource) then begin FDataLink.Edit; UpdateData; @@ -981,6 +982,11 @@ begin Parent.Repaint; end; +procedure TRxCustomDBLookupCombo.DoAutoSize; +begin + Height:=Canvas.TextHeight('Wg')+10; +end; + procedure TRxCustomDBLookupCombo.SetEnabled(Value: Boolean); begin inherited SetEnabled(Value); @@ -1049,7 +1055,7 @@ begin inherited SetParent(AParent); if FButton <> nil then begin - FButton.Parent := Parent; +// FButton.Parent := Parent; CheckButtonVisible; end; end; @@ -1067,7 +1073,7 @@ begin end; inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); - DoPositionButton; +// DoPositionButton; end; procedure TRxCustomDBLookupCombo.DoPositionButton; @@ -1160,6 +1166,7 @@ begin if TextMargin > 0 then Inc(TextMargin); X := 2 + TextMargin; Canvas.FillRect(R); + R.Right:=R.Right - GetButtonWidth; if FDisplayAll then PaintDisplayValues(Canvas, R, TextMargin) else @@ -1234,10 +1241,14 @@ begin FButton.Width := Self.Height; FButton.Height := Self.Height; FButton.FreeNotification(Self); + FButton.Parent:=Self; CheckButtonVisible; FButton.OnClick := @DoButtonClick; FButton.Cursor := crArrow; FButton.ControlStyle := FButton.ControlStyle + [csNoDesignSelectable]; + FButton.Align:=alRight; + FButton.BorderSpacing.Around:=2; + ControlStyle := ControlStyle - [csSetCaption]; FDirectInput := True; ParentColor:=false; @@ -1248,6 +1259,7 @@ begin ButtonWidth:=15; Ctl3D:=true; TabStop:=true; + end; destructor TRxCustomDBLookupCombo.Destroy; diff --git a/components/rx/rxnew.lpk b/components/rx/rxnew.lpk index f1e6b45ac..a8317ede7 100644 --- a/components/rx/rxnew.lpk +++ b/components/rx/rxnew.lpk @@ -24,7 +24,7 @@ translate to Lazarus by alexs in 2005 - 2007 - + @@ -198,21 +198,25 @@ translate to Lazarus by alexs in 2005 - 2007 + + + + - - + - + - + - + + diff --git a/components/rx/rxnew.pas b/components/rx/rxnew.pas index 435e383eb..1fc10c562 100644 --- a/components/rx/rxnew.pas +++ b/components/rx/rxnew.pas @@ -13,7 +13,7 @@ uses rxtbrsetup, fduallst, rxxpman, pagemngr, rxappicon, seldsfrm, rxctrls, rxlogin, rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit, rxcustomchartpanel, rxsortmemds, AutoPanel, pickdate, rxiconv, - LazarusPackageIntf; + rxceEditLookupFields, LazarusPackageIntf; implementation diff --git a/components/rx/rxpopupunit.pas b/components/rx/rxpopupunit.pas index 72d5862c4..17a263e4c 100644 --- a/components/rx/rxpopupunit.pas +++ b/components/rx/rxpopupunit.pas @@ -184,7 +184,7 @@ type function ShowRxDBPopUpForm(AControl:TWinControl; ADataSet:TDataSet; AOnPopUpCloseEvent:TPopUpCloseEvent; APopUpFormOptions:TPopUpFormOptions; - AFieldList:string; ALookupDisplayIndex, BtnWidtn: integer):TPopUpForm; + AFieldList:string; ALookupDisplayIndex, BtnWidtn: integer; const Font:TFont):TPopUpForm; procedure FillPopupWidth(APopUpFormOptions:TPopUpFormOptions; ARxPopUpForm:TPopUpForm); @@ -194,12 +194,19 @@ uses dbutils, math; {.$DEFINE LINUX} function ShowRxDBPopUpForm(AControl:TWinControl; ADataSet:TDataSet; AOnPopUpCloseEvent:TPopUpCloseEvent; APopUpFormOptions:TPopUpFormOptions; - AFieldList:string; ALookupDisplayIndex, BtnWidtn: integer):TPopUpForm; + AFieldList:string; ALookupDisplayIndex, BtnWidtn: integer; const Font:TFont):TPopUpForm; begin Result:=TPopUpForm.CreatePopUp(AControl, APopUpFormOptions, AFieldList, BtnWidtn); Result.FOnPopUpCloseEvent:=AOnPopUpCloseEvent; Result.DataSet:=ADataSet; Result.LookupDisplayIndex:=ALookupDisplayIndex; + + if Assigned(Font) then + begin + Result.FGrid.Font.Assign(Font); +// Result.Font.Assign(Font); + end; + {$IFDEF LINUX} if Result.ShowModal = mrOk then if Assigned(AOnPopUpCloseEvent) then @@ -470,6 +477,7 @@ begin FGrid.TitleStyle:=FPopUpFormOptions.TitleStyle; FGrid.BorderStyle:=FPopUpFormOptions.BorderStyle; FGrid.OnGetCellProps:=FPopUpFormOptions.OnGetCellProps; + end; { TPopUpFormOptions } diff --git a/components/rx/rxstrutils.pas b/components/rx/rxstrutils.pas index b38030008..57c5f566b 100644 --- a/components/rx/rxstrutils.pas +++ b/components/rx/rxstrutils.pas @@ -15,7 +15,7 @@ unit rxstrutils; interface -uses SysUtils ; +uses SysUtils, Classes; type {$IFNDEF RX_D4} @@ -207,8 +207,10 @@ function RomanToInt(const S: string): Longint; { RomanToInt converts the given string to an integer value. If the string doesn't contain a valid roman numeric value, the 0 value is returned. } +procedure StrToStrings(const S:string; const List:TStrings; const Delims:Char); + const - CRLF = #13#10; +// CRLF = #13#10; DigitChars = ['0'..'9']; {$IFNDEF CBUILDER} Brackets = ['(',')','[',']','{','}']; @@ -1081,4 +1083,27 @@ begin end; end; +procedure StrToStrings(const S:string; const List:TStrings; const Delims:Char); +var + i,j:integer; +begin + if S<>'' then + begin + j:=1; + for i:=1 to Length(S) do + begin + if S[i] = Delims then + begin + if i>j+1 then + begin + List.Add(Copy(S, j, i-j)); + end; + j:=i+1; + end; + end; + if j