From 7e13a73664b44a4ee7c74463c0b6f756c8e9c030 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 13 Jun 2005 18:34:21 +0000 Subject: [PATCH] added DB Fields Editor for the IDE from Alexandrov Alexandru - needs FPC 2.1 git-svn-id: trunk@7238 - --- .gitattributes | 9 + components/printers/printer4lazarus.pas | 3 +- docs/Contributors.txt | 1 + docs/DesignGuidelines.txt | 1 + ideintf/Makefile.fpc | 3 + ideintf/allideintf.pas | 3 +- ideintf/fieldseditor.lfm | 103 ++++++ ideintf/fieldseditor.lrs | 37 ++ ideintf/fieldseditor.pas | 471 ++++++++++++++++++++++++ ideintf/fieldslist.lfm | 46 +++ ideintf/fieldslist.lrs | 17 + ideintf/fieldslist.pas | 141 +++++++ ideintf/newfield.lfm | 278 ++++++++++++++ ideintf/newfield.lrs | 70 ++++ ideintf/newfield.pas | 364 ++++++++++++++++++ lcl/dbctrls.pp | 27 ++ 16 files changed, 1571 insertions(+), 3 deletions(-) create mode 100644 ideintf/fieldseditor.lfm create mode 100644 ideintf/fieldseditor.lrs create mode 100644 ideintf/fieldseditor.pas create mode 100644 ideintf/fieldslist.lfm create mode 100644 ideintf/fieldslist.lrs create mode 100644 ideintf/fieldslist.pas create mode 100644 ideintf/newfield.lfm create mode 100644 ideintf/newfield.lrs create mode 100644 ideintf/newfield.pas diff --git a/.gitattributes b/.gitattributes index 38d197e5d2..ce279e08f5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -921,6 +921,12 @@ ideintf/componenttreeview.lrs svneol=native#text/pascal ideintf/componenttreeview.pas svneol=native#text/pascal ideintf/configstorage.pas svneol=native#text/pascal ideintf/dbpropedits.pas svneol=native#text/pascal +ideintf/fieldseditor.lfm svneol=native#text/plain +ideintf/fieldseditor.lrs svneol=native#text/pascal +ideintf/fieldseditor.pas svneol=native#text/pascal +ideintf/fieldslist.lfm svneol=native#text/plain +ideintf/fieldslist.lrs svneol=native#text/pascal +ideintf/fieldslist.pas svneol=native#text/pascal ideintf/formeditingintf.pas svneol=native#text/pascal ideintf/graphpropedits.pas svneol=native#text/pascal ideintf/helpfpdoc.pas svneol=native#text/pascal @@ -931,6 +937,9 @@ ideintf/imagelisteditor.pp svneol=native#text/pascal ideintf/lazideintf.pas svneol=native#text/pascal ideintf/listviewpropedit.pp svneol=native#text/pascal ideintf/macrointf.pas svneol=native#text/pascal +ideintf/newfield.lfm svneol=native#text/plain +ideintf/newfield.lrs svneol=native#text/pascal +ideintf/newfield.pas svneol=native#text/pascal ideintf/newitemintf.pas svneol=native#text/pascal ideintf/objectinspector.pp svneol=native#text/pascal ideintf/objinspstrconsts.pas svneol=native#text/pascal diff --git a/components/printers/printer4lazarus.pas b/components/printers/printer4lazarus.pas index 76d08575c1..ad8321685c 100644 --- a/components/printers/printer4lazarus.pas +++ b/components/printers/printer4lazarus.pas @@ -7,8 +7,7 @@ unit Printer4Lazarus; interface uses - PrintersDlgs, OSPrinters, uDlgSelectPrinter, cupsdyn, uDlgPropertiesPrinter, - LazarusPackageIntf; + PrintersDlgs, OSPrinters, LazarusPackageIntf; implementation diff --git a/docs/Contributors.txt b/docs/Contributors.txt index 8da9ec3b91..34c6e89ef1 100644 --- a/docs/Contributors.txt +++ b/docs/Contributors.txt @@ -1,6 +1,7 @@ The following people contributed to Lazarus: Alexander Shiyan +Alexandru Alexandrov Andreas Hausladen Andrew Haines Andrew Johnson diff --git a/docs/DesignGuidelines.txt b/docs/DesignGuidelines.txt index c2c21a9307..a321600313 100644 --- a/docs/DesignGuidelines.txt +++ b/docs/DesignGuidelines.txt @@ -17,6 +17,7 @@ Coding style: New files: - Every file should start with a header containing the license and a few lines describing the content. +- pascal sources should have lowercase filenames (.pas, .pp, .inc, .lfm, .lrs) Include files: - should start with the {%MainUnit } directive diff --git a/ideintf/Makefile.fpc b/ideintf/Makefile.fpc index 539d776730..ed7a9e1ded 100644 --- a/ideintf/Makefile.fpc +++ b/ideintf/Makefile.fpc @@ -22,6 +22,8 @@ implicitunits=actionseditor \ componentreg \ componenttreeview \ configstorage \ + fieldseditor \ + fieldslist \ formeditingintf \ graphpropedits \ helpfpdoc \ @@ -30,6 +32,7 @@ implicitunits=actionseditor \ idecommands \ imagelisteditor \ listviewpropedit \ + newfield \ objectinspector \ objinspstrconsts \ projectintf \ diff --git a/ideintf/allideintf.pas b/ideintf/allideintf.pas index daa8857a24..4065ea5879 100644 --- a/ideintf/allideintf.pas +++ b/ideintf/allideintf.pas @@ -24,7 +24,8 @@ uses ComponentEditors, GraphPropEdits, DBPropEdits, ListViewPropEdit, ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools, FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML, - ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf, MacroIntf; + FieldsEditor, ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf, + MacroIntf; implementation diff --git a/ideintf/fieldseditor.lfm b/ideintf/fieldseditor.lfm new file mode 100644 index 0000000000..82d66e6058 --- /dev/null +++ b/ideintf/fieldseditor.lfm @@ -0,0 +1,103 @@ +object DSFieldsEditorFrm: TDSFieldsEditorFrm + Caption = 'Fields Editor' + ClientHeight = 288 + ClientWidth = 180 + OnClose = FieldsEditorFrmClose + OnDestroy = FieldsEditorFrmDestroy + PixelsPerInch = 96 + HorzScrollBar.Page = 179 + VertScrollBar.Page = 287 + Left = 228 + Height = 288 + Top = 96 + Width = 180 + object FieldsListBox: TListBox + Align = alClient + ExtendedSelect = True + MultiSelect = True + OnClick = ListBox1Click + OnKeyDown = FieldsListBoxKeyDown + PopupMenu = PopupMenu1 + TabOrder = 0 + Height = 288 + Width = 180 + end + object PopupMenu1: TPopupMenu + left = 8 + top = 144 + object MenuItem1: TMenuItem + Action = AddFieldsActn + OnClick = AddFieldsActnExecute + end + object MenuItem2: TMenuItem + Action = DeleteFieldsActn + OnClick = DeleteFieldsActnExecute + end + object MenuItem5: TMenuItem + Action = NewActn + OnClick = NewActnExecute + end + object MenuItem3: TMenuItem + Action = MoveUpActn + OnClick = MoveUpActnExecute + end + object MenuItem4: TMenuItem + Action = MoveDownActn + OnClick = MoveDownActnExecute + end + object MenuItem6: TMenuItem + Action = SelectAllActn + OnClick = SelectAllActnExecute + end + object MenuItem7: TMenuItem + Action = UnselectAllActn + OnClick = UnselectAllActnExecute + end + end + object ActionList1: TActionList + left = 40 + top = 144 + object AddFieldsActn: TAction + Caption = '&Add fields' + Hint = 'Add fields from FieldDefs' + OnExecute = AddFieldsActnExecute + ShortCut = 16429 + Category = 'Fields' + end + object DeleteFieldsActn: TAction + Caption = '&Delete' + Hint = 'Delete selected field(s)' + OnExecute = DeleteFieldsActnExecute + ShortCut = 46 + Category = 'Fields' + end + object NewActn: TAction + Caption = '&New' + Hint = 'Create new field and add it at current position' + OnExecute = NewActnExecute + ShortCut = 45 + Category = 'Fields' + end + object MoveUpActn: TAction + Caption = 'Move &Up' + OnExecute = MoveUpActnExecute + Category = 'Fields' + end + object MoveDownActn: TAction + Caption = 'Move &Down' + OnExecute = MoveDownActnExecute + Category = 'Fields' + end + object SelectAllActn: TAction + Caption = '&Select all' + OnExecute = SelectAllActnExecute + ShortCut = 16449 + Category = 'Fields' + end + object UnselectAllActn: TAction + Caption = '&Unselect all' + OnExecute = UnselectAllActnExecute + Category = 'Fields' + end + end +end diff --git a/ideintf/fieldseditor.lrs b/ideintf/fieldseditor.lrs new file mode 100644 index 0000000000..fdda9524fd --- /dev/null +++ b/ideintf/fieldseditor.lrs @@ -0,0 +1,37 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TDSFieldsEditorFrm','FORMDATA',[ + 'TPF0'#18'TDSFieldsEditorFrm'#17'DSFieldsEditorFrm'#7'Caption'#6#13'Fields Ed' + +'itor'#12'ClientHeight'#3' '#1#11'ClientWidth'#3#180#0#7'OnClose'#7#20'Field' + +'sEditorFrmClose'#9'OnDestroy'#7#22'FieldsEditorFrmDestroy'#13'PixelsPerInch' + +#2'`'#18'HorzScrollBar.Page'#3#179#0#18'VertScrollBar.Page'#3#31#1#4'Left'#3 + +#228#0#6'Height'#3' '#1#3'Top'#2'`'#5'Width'#3#180#0#0#8'TListBox'#13'Fields' + +'ListBox'#5'Align'#7#8'alClient'#14'ExtendedSelect'#9#11'MultiSelect'#9#7'On' + +'Click'#7#13'ListBox1Click'#9'OnKeyDown'#7#20'FieldsListBoxKeyDown'#9'PopupM' + +'enu'#7#10'PopupMenu1'#8'TabOrder'#2#0#6'Height'#3' '#1#5'Width'#3#180#0#0#0 + +#10'TPopupMenu'#10'PopupMenu1'#4'left'#2#8#3'top'#3#144#0#0#9'TMenuItem'#9'M' + +'enuItem1'#6'Action'#7#13'AddFieldsActn'#7'OnClick'#7#20'AddFieldsActnExecut' + +'e'#0#0#9'TMenuItem'#9'MenuItem2'#6'Action'#7#16'DeleteFieldsActn'#7'OnClick' + +#7#23'DeleteFieldsActnExecute'#0#0#9'TMenuItem'#9'MenuItem5'#6'Action'#7#7'N' + +'ewActn'#7'OnClick'#7#14'NewActnExecute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Act' + +'ion'#7#10'MoveUpActn'#7'OnClick'#7#17'MoveUpActnExecute'#0#0#9'TMenuItem'#9 + +'MenuItem4'#6'Action'#7#12'MoveDownActn'#7'OnClick'#7#19'MoveDownActnExecute' + +#0#0#9'TMenuItem'#9'MenuItem6'#6'Action'#7#13'SelectAllActn'#7'OnClick'#7#20 + +'SelectAllActnExecute'#0#0#9'TMenuItem'#9'MenuItem7'#6'Action'#7#15'Unselect' + +'AllActn'#7'OnClick'#7#22'UnselectAllActnExecute'#0#0#0#11'TActionList'#11'A' + +'ctionList1'#4'left'#2'('#3'top'#3#144#0#0#7'TAction'#13'AddFieldsActn'#7'Ca' + +'ption'#6#11'&Add fields'#4'Hint'#6#25'Add fields from FieldDefs'#9'OnExecut' + +'e'#7#20'AddFieldsActnExecute'#8'ShortCut'#3'-@'#8'Category'#6#6'Fields'#0#0 + +#7'TAction'#16'DeleteFieldsActn'#7'Caption'#6#7'&Delete'#4'Hint'#6#24'Delete' + +' selected field(s)'#9'OnExecute'#7#23'DeleteFieldsActnExecute'#8'ShortCut'#2 + +'.'#8'Category'#6#6'Fields'#0#0#7'TAction'#7'NewActn'#7'Caption'#6#4'&New'#4 + +'Hint'#6'/Create new field and add it at current position'#9'OnExecute'#7#14 + +'NewActnExecute'#8'ShortCut'#2'-'#8'Category'#6#6'Fields'#0#0#7'TAction'#10 + +'MoveUpActn'#7'Caption'#6#8'Move &Up'#9'OnExecute'#7#17'MoveUpActnExecute'#8 + +'Category'#6#6'Fields'#0#0#7'TAction'#12'MoveDownActn'#7'Caption'#6#10'Move ' + +'&Down'#9'OnExecute'#7#19'MoveDownActnExecute'#8'Category'#6#6'Fields'#0#0#7 + +'TAction'#13'SelectAllActn'#7'Caption'#6#11'&Select all'#9'OnExecute'#7#20'S' + +'electAllActnExecute'#8'ShortCut'#3'A@'#8'Category'#6#6'Fields'#0#0#7'TActio' + +'n'#15'UnselectAllActn'#7'Caption'#6#13'&Unselect all'#9'OnExecute'#7#22'Uns' + +'electAllActnExecute'#8'Category'#6#6'Fields'#0#0#0#0 +]); diff --git a/ideintf/fieldseditor.pas b/ideintf/fieldseditor.pas new file mode 100644 index 0000000000..52478ff787 --- /dev/null +++ b/ideintf/fieldseditor.pas @@ -0,0 +1,471 @@ +{ Copyright (C) 2005 Alexandru Alexandrov + Date: 11.06.2005 + + ***************************************************************************** + * * + * See the file COPYING.modifiedLGPL, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** +} +unit fieldseditor; + +{$mode objfpc}{$H+} + +interface + +{$IFNDEF VER2_0} +uses + Classes, SysUtils, LResources, TypInfo, LCLProc, Forms, + Controls, Menus, Graphics, Dialogs, ComCtrls, + db, ActnList, StdCtrls, ComponentEditors, PropEdits, LCLType, + NewField, FieldsList, ComponentReg; + +type + + TFieldsComponentEditor = class; + + { TDSFieldsEditorFrm } + + TDSFieldsEditorFrm = class(TForm) + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + UnselectAllActn: TAction; + SelectAllActn: TAction; + FieldsListBox: TListBox; + MoveDownActn: TAction; + MoveUpActn: TAction; + NewActn: TAction; + DeleteFieldsActn: TAction; + AddFieldsActn: TAction; + ActionList1: TActionList; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + PopupMenu1: TPopupMenu; + procedure AddFieldsActnExecute(Sender: TObject); + procedure DeleteFieldsActnExecute(Sender: TObject); + procedure FieldsEditorFrmClose(Sender: TObject; + var CloseAction: TCloseAction); + procedure FieldsEditorFrmDestroy(Sender: TObject); + procedure FieldsListBoxKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure NewActnExecute(Sender: TObject); + procedure ListBox1Click(Sender: TObject); + procedure MoveDownActnExecute(Sender: TObject); + procedure MoveUpActnExecute(Sender: TObject); + procedure SelectAllActnExecute(Sender: TObject); + procedure UnselectAllActnExecute(Sender: TObject); + protected + { protected declarations } + procedure DoSelected(All: boolean); + procedure SelectionChanged; + procedure OnComponentRenamed(AComponent: TComponent); + procedure OnDeletePersistent(var APersistent: TPersistent); + procedure OnGetSelection(const ASelection: TPersistentSelectionList); + procedure OnSetSelection(const ASelection: TPersistentSelectionList); + procedure OnPersistentAdded(APersistent: TPersistent; Select: boolean); + private + { private declarations } + LinkDataset: TDataset; + FDesigner: TComponentEditorDesigner; + FComponentEditor: TFieldsComponentEditor; + procedure ExchangeItems(const fFirst, fSecond: integer); + procedure RefreshFieldsListBox(SelectAllNew: boolean); + public + { public declarations } + constructor Create(AOwner: TComponent; ADataset: TDataset; ADesigner: TComponentEditorDesigner); + property Designer: TComponentEditorDesigner read FDesigner write FDesigner; + property ComponentEditor: TFieldsComponentEditor write FComponentEditor; + end; + + { TActionListComponentEditor } + + TFieldsComponentEditor = class(TComponentEditor) + private + FDataSet: TDataset; + FFieldsEditorForm: TDSFieldsEditorFrm; + fWindowClosed: Boolean; + protected + public + constructor Create(AComponent: TComponent; + ADesigner: TComponentEditorDesigner); override; + destructor Destroy; override; + function GetVerbCount: Integer; override; + function GetVerb(Index: Integer): string; override; + procedure ExecuteVerb(Index: Integer); override; + procedure EditorWindowClose; + property LinkDataset: TDataset read FDataSet write FDataSet; + end; + +implementation + +resourcestring + rsTitle = 'Edit fields'; + +{ TDSFieldsEditorFrm } + +procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject); +var FieldsList: TFieldsListFrm; + mr: TModalResult; +begin + FieldsList := TFieldsListFrm.Create(Self, LinkDataset, Designer); + try + mr := FieldsList.ShowModal; + finally + FieldsList.Free; + end; + SelectionChanged; +end; + +constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset; + ADesigner: TComponentEditorDesigner); +begin + inherited Create(AOwner); + + LinkDataset := ADataset; + FDesigner := ADesigner; + Caption := rsTitle + ' - ' + LinkDataset.Name; + FieldsListBox.Clear; + RefreshFieldsListBox(False); + + GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed); + GlobalDesignHook.AddHandlerDeletePersistent(@OnDeletePersistent); + GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection); + GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection); + GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded); + + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject); +var i: integer; + sActive: boolean; + bModified: boolean; + fld: TField; +begin + sActive := LinkDataSet.Active; + LinkDataSet.Active := False; + bModified := False; + for i := FieldsListBox.Items.Count - 1 downto 0 do + if FieldsListBox.Selected[i] then begin + fld := TField(FieldsListBox.Items.Objects[i]); + FieldsListBox.Items.Delete(i); + FDesigner.PropertyEditorHook.PersistentDeleting(fld); + fld.Free; + bModified := True; + end; + if bModified then fDesigner.Modified; + if LinkDataset.Fields.Count > 0 then LinkDataSet.Active := sActive; + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + CloseAction := caFree; +end; + +procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject); +begin + if Assigned(GlobalDesignHook) then + GlobalDesignHook.RemoveAllHandlersForObject(Self); + if Assigned(FComponentEditor) then + FComponentEditor.EditorWindowClose; + inherited Destroy; +end; + +procedure TDSFieldsEditorFrm.FieldsListBoxKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if ssCtrl in Shift then + case Key of + VK_UP: begin + MoveUpActn.Execute; + Key := 0; + end; + VK_DOWN: begin + MoveDownActn.Execute; + Key := 0; + end; + end; +end; + +procedure TDSFieldsEditorFrm.ExchangeItems(const fFirst, fSecond: integer); +var SelFirst, + SelSecond: boolean; +begin + with FieldsListBox do begin +// save selected + SelFirst := Selected[fFirst]; + SelSecond := Selected[fSecond]; +// exchange items + FieldsListBox.Items.Exchange(fFirst,fSecond); +// restore selected + Selected[fFirst] := SelSecond; + Selected[fSecond] := SelFirst; + + TField(Items.Objects[fFirst]).Index := fFirst; + end; +end; + +procedure TDSFieldsEditorFrm.RefreshFieldsListBox(SelectAllNew: boolean); +var i, j: integer; + fld: TField; +begin + if LinkDataset.Active And LinkDataset.DefaultFields then LinkDataset.Close; + //Deselect & refresh all existing + DoSelected(False); + //Add new fields + for i := 0 to LinkDataset.Fields.Count - 1 do begin + fld := LinkDataset.Fields[i]; + if FieldsListBox.Items.IndexOfObject(fld) < 0 then begin + j := FieldsListBox.Items.AddObject(fld.FieldName, fld); + FieldsListBox.Selected[j] := SelectAllNew; + end; + end; +end; + +procedure TDSFieldsEditorFrm.NewActnExecute(Sender: TObject); +var nf: TNewFieldFrm; +begin + nf := TNewFieldFrm.Create(Self, LinkDataset, Designer); + try + nf.ShowModal; + finally + nf.Free; + end; + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.ListBox1Click(Sender: TObject); +begin + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.MoveDownActnExecute(Sender: TObject); +var i: integer; + bModified: boolean; +begin + if FieldsListBox.Selected[FieldsListBox.Items.Count - 1] then exit; + bModified := False; + for i := FieldsListBox.Items.Count - 2 downto 0 do + if FieldsListBox.Selected[i] then begin + ExchangeItems(i, i + 1); + bModified := True; + end; + SelectionChanged; + if bModified then fDesigner.Modified; +end; + +procedure TDSFieldsEditorFrm.MoveUpActnExecute(Sender: TObject); +var i: integer; + bModified: boolean; +begin + if FieldsListBox.Selected[0] then exit; + bModified := False; + for i := 1 to FieldsListBox.Items.Count - 1 do + if FieldsListBox.Selected[i] then begin + ExchangeItems(i - 1, i); + bModified := True; + end; + SelectionChanged; + if bModified then fDesigner.Modified; +end; + +procedure TDSFieldsEditorFrm.SelectAllActnExecute(Sender: TObject); +begin + DoSelected(True); + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.UnselectAllActnExecute(Sender: TObject); +begin + DoSelected(False); + SelectionChanged; +end; + +procedure TDSFieldsEditorFrm.DoSelected(All: boolean); +var i: integer; +begin + for i := 0 to FieldsListBox.Items.Count - 1 do begin + FieldsListBox.Items[i] := (FieldsListBox.Items.Objects[i] as TField).FieldName; + FieldsListBox.Selected[i] := All; + end; +end; + +procedure TDSFieldsEditorFrm.SelectionChanged; +var SelList: TPersistentSelectionList; +begin + GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection); + try + SelList := TPersistentSelectionList.Create; + try + OnGetSelection(SelList); + FDesigner.PropertyEditorHook.SetSelection(SelList) ; + finally + SelList.Free; + end; + finally + GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection); + end; +end; + +procedure TDSFieldsEditorFrm.OnComponentRenamed(AComponent: TComponent); +var Field: TField; + i: integer; +begin + if AComponent is TField then begin + Field := TField(AComponent); + if not Assigned( Field ) then Exit; + i := FieldsListBox.Items.IndexOfObject(Field); + if i >= 0 then + FieldsListBox.Items[i] := Field.FieldName; + end else + if AComponent is TDataset And (AComponent = LinkDataset) then + Caption := rsTitle + ' - ' + LinkDataset.Name; +end; + +procedure TDSFieldsEditorFrm.OnDeletePersistent(var APersistent: TPersistent); +var i: integer; +begin + if APersistent = LinkDataset then begin +// removing all fields here ? + end else begin + i := FieldsListBox.Items.IndexOfObject(APersistent as TObject); + if i >= 0 then FieldsListBox.Items.Delete( i ); + end; +end; + +procedure TDSFieldsEditorFrm.OnGetSelection( + const ASelection: TPersistentSelectionList); +var i: integer; +begin + if Not Assigned(ASelection) then exit; + if ASelection.Count > 0 then ASelection.Clear; + for i := 0 to FieldsListBox.Items.Count - 1 do + if FieldsListBox.Selected[i] then + ASelection.Add(TPersistent(FieldsListBox.Items.Objects[i])); +end; + +procedure TDSFieldsEditorFrm.OnSetSelection( + const ASelection: TPersistentSelectionList); +var i, j: integer; +begin + if Assigned(ASelection) then begin + //Unselect all + DoSelected(False); + //select from list + for i := 0 to ASelection.Count - 1 do + if ASelection.Items[i] is TField then begin + j := FieldsListBox.Items.IndexOfObject(ASelection.Items[i]); + if j >= 0 then FieldsListBox.Selected[j] := True; + end; + end; +end; + +procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent; + Select: boolean); +var i: integer; +begin + if Assigned(APersistent) And + (APersistent is TField) And + ((APersistent as TField).DataSet = LinkDataset) then begin + i := FieldsListBox.Items.AddObject( TField(APersistent).FieldName, APersistent ); + FieldsListBox.Selected[i] := Select; + TField(APersistent).Index := i; + end; +end; + +{ TFieldsComponentEditor } + +constructor TFieldsComponentEditor.Create(AComponent: TComponent; + ADesigner: TComponentEditorDesigner); +begin + inherited Create(AComponent, ADesigner); + fWindowClosed := True; +end; + +destructor TFieldsComponentEditor.Destroy; +begin + if not fWindowClosed + then FreeThenNil(FFieldsEditorForm); + inherited Destroy; +end; + +function TFieldsComponentEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + +function TFieldsComponentEditor.GetVerb(Index: Integer): string; +begin + case Index of + 0: Result := rsTitle; + end; +end; + +procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer); +var ADataset: TDataset; + i: Integer; + b: boolean; + fTop, fLeft, fHeight, fWidth: integer; + aForm: TForm; +begin + case index of + 0: begin + ADataset := GetComponent as TDataset; + if ADataset = nil + then raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil'); + if fWindowClosed then begin + //close other Fields designer forms + // and save window pos. + b := False; + with Application do + for i := 0 to ComponentCount - 1 do + if Components[i] is TDSFieldsEditorFrm then begin + b := True; + aForm := Components[i] as TDSFieldsEditorFrm; + fTop := aForm.Top; + fLeft := aForm.Left; + fHeight := aForm.Height; + fWidth := aForm.Width; + TDSFieldsEditorFrm(Components[i]).Free; + end; + FFieldsEditorForm := TDSFieldsEditorFrm.Create(Application, ADataset, Designer); + if b then begin + FFieldsEditorForm.Top := fTop; + FFieldsEditorForm.Left := fLeft; + FFieldsEditorForm.Height := fHeight; + FFieldsEditorForm.Width := fWidth; + end; + fWindowClosed := False; + end; + with FFieldsEditorForm do begin + ComponentEditor := Self; + ShowOnTop; + end; + end; + end; +end; + +procedure TFieldsComponentEditor.EditorWindowClose; +begin + fWindowClosed := True; +end; + + +initialization + {$I fieldseditor.lrs} + RegisterComponentEditor(TDataset, TFieldsComponentEditor); + +{$ELSE The FCL of FPC 2.0 does not support this} +implementation +{$ENDIF} +end. diff --git a/ideintf/fieldslist.lfm b/ideintf/fieldslist.lfm new file mode 100644 index 0000000000..6d6bb6bb93 --- /dev/null +++ b/ideintf/fieldslist.lfm @@ -0,0 +1,46 @@ +object FieldsListFrm: TFieldsListFrm + Caption = 'FieldsListFrm' + ClientHeight = 271 + ClientWidth = 173 + PixelsPerInch = 96 + HorzScrollBar.Page = 172 + VertScrollBar.Page = 270 + Left = 358 + Height = 271 + Top = 99 + Width = 173 + object BitBtnOk: TBitBtn + Anchors = [akLeft, akBottom] + Caption = '&Create' + Default = True + Kind = bkOK + ModalResult = 1 + OnClick = BitBtnOkClick + TabOrder = 0 + Left = 9 + Height = 25 + Top = 241 + Width = 75 + end + object BitBtnCancel: TBitBtn + Anchors = [akLeft, akBottom] + Cancel = True + Caption = 'Cancel' + Kind = bkCancel + ModalResult = 2 + TabOrder = 1 + Left = 89 + Height = 25 + Top = 241 + Width = 75 + end + object ListBox1: TListBox + Align = alTop + Anchors = [akTop, akLeft, akRight, akBottom] + ExtendedSelect = True + MultiSelect = True + TabOrder = 2 + Height = 232 + Width = 173 + end +end diff --git a/ideintf/fieldslist.lrs b/ideintf/fieldslist.lrs new file mode 100644 index 0000000000..6034421f2d --- /dev/null +++ b/ideintf/fieldslist.lrs @@ -0,0 +1,17 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TFieldsListFrm','FORMDATA',[ + 'TPF0'#14'TFieldsListFrm'#13'FieldsListFrm'#7'Caption'#6#13'FieldsListFrm'#12 + +'ClientHeight'#3#15#1#11'ClientWidth'#3#173#0#13'PixelsPerInch'#2'`'#18'Horz' + +'ScrollBar.Page'#3#172#0#18'VertScrollBar.Page'#3#14#1#4'Left'#3'f'#1#6'Heig' + +'ht'#3#15#1#3'Top'#2'c'#5'Width'#3#173#0#0#7'TBitBtn'#8'BitBtnOk'#7'Anchors' + +#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#7'&Create'#7'Default'#9#4'Kind'#7#4 + +'bkOK'#11'ModalResult'#2#1#7'OnClick'#7#13'BitBtnOkClick'#8'TabOrder'#2#0#4 + +'Left'#2#9#6'Height'#2#25#3'Top'#3#241#0#5'Width'#2'K'#0#0#7'TBitBtn'#12'Bit' + +'BtnCancel'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#6'Cancel'#9#7'Caption'#6#6 + +'Cancel'#4'Kind'#7#8'bkCancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#4'Left'#2 + +'Y'#6'Height'#2#25#3'Top'#3#241#0#5'Width'#2'K'#0#0#8'TListBox'#8'ListBox1'#5 + +'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0 + +#14'ExtendedSelect'#9#11'MultiSelect'#9#8'TabOrder'#2#2#6'Height'#3#232#0#5 + +'Width'#3#173#0#0#0#0 +]); diff --git a/ideintf/fieldslist.pas b/ideintf/fieldslist.pas new file mode 100644 index 0000000000..0a6c09bf9d --- /dev/null +++ b/ideintf/fieldslist.pas @@ -0,0 +1,141 @@ +{ + + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + + author: Alexandru Alexandrov + date: 11.06.2005 + +} + +unit fieldslist; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, + Buttons, DB, StdCtrls, ComponentEditors, PropEdits; + +type + + { TFieldsListFrm } + + TFieldsListFrm = class(TForm) + BitBtnOk: TBitBtn; + BitBtnCancel: TBitBtn; + ListBox1: TListBox; + procedure BitBtnOkClick(Sender: TObject); + private + { private declarations } + FDesigner: TComponentEditorDesigner; + LinkDataset: TDataset; + procedure RefreshFieldsList; + public + { public declarations } + constructor Create(AOwner: TComponent; ADataset: TDataset; + ADesigner: TComponentEditorDesigner); + end; + +var + FieldsListFrm: TFieldsListFrm; + +implementation + +resourcestring + rsTitle = 'FieldDefs'; + +{ TFieldsListFrm } + +procedure TFieldsListFrm.BitBtnOkClick(Sender: TObject); +var i: integer; + NewField: TField; + fModified: boolean; +begin + LinkDataSet.Active := False; + fModified := False; + for i := 0 to ListBox1.Items.Count - 1 do begin + if ListBox1.Selected[i] And (LinkDataset.FindField(ListBox1.Items[i]) = Nil) then begin + NewField := TFieldDef(ListBox1.Items.Objects[i]).CreateField(LinkDataset.Owner); + NewField.Name := FDesigner.CreateUniqueComponentName(LinkDataset.Name + NewField.FieldName); + FDesigner.PropertyEditorHook.PersistentAdded(NewField, True); + fModified := True; + end; + end; + if fModified then FDesigner.Modified; +end; + +procedure TFieldsListFrm.RefreshFieldsList; + + function CheckField(f: TFieldDef): boolean; + begin + Result := Assigned(f) And (LinkDataSet.FindField(f.Name) = Nil); + end; + + function FillList: integer; + var + i: integer; + f: TFieldDef; + begin + Result := 0; + with LinkDataset do begin + for i := 0 to FieldDefs.Count - 1 do begin + f := FieldDefs.Items[i]; + if CheckField(f) then begin + ListBox1.Items.AddObject(f.Name, f); + inc(Result); + end; + end; + end; + end; + +var i: integer; +begin + i := 0; + ListBox1.Clear; + BitBtnOk.Enabled := False; + if Not Assigned(LinkDataset) then Exit; + with LinkDataset do begin + Active := False; + FieldDefs.Update; + end; + i := FillList; + BitBtnOk.Enabled := i > 0; +end; + +constructor TFieldsListFrm.Create(AOwner: TComponent; ADataset: TDataset; + ADesigner: TComponentEditorDesigner); +begin + inherited Create(AOwner); + LinkDataset := ADataset; + if Not Assigned(LinkDataset) then ShowMessage('LinkDataset = nil!') + else begin + FDesigner := ADesigner; + Caption := rsTitle + ' - ' + LinkDataset.Name; + end; + RefreshFieldsList; +end; + +initialization + {$I fieldslist.lrs} + +end. + diff --git a/ideintf/newfield.lfm b/ideintf/newfield.lfm new file mode 100644 index 0000000000..373ba61b8d --- /dev/null +++ b/ideintf/newfield.lfm @@ -0,0 +1,278 @@ +object NewFieldFrm: TNewFieldFrm + BorderStyle = bsDialog + Caption = 'Dialog' + ClientHeight = 376 + ClientWidth = 262 + OnCreate = FormCreate + ParentFont = True + PixelsPerInch = 96 + Position = poScreenCenter + TextHeight = 13 + HorzScrollBar.Page = 261 + VertScrollBar.Page = 375 + Left = 243 + Height = 376 + Top = 176 + Width = 262 + object Panel2: TPanel + Align = alTop + ClientHeight = 121 + ClientWidth = 262 + FullRepaint = False + TabOrder = 0 + Height = 121 + Top = 64 + Width = 262 + object GroupBox1: TGroupBox + Caption = 'Field properties' + ClientHeight = 87 + ClientWidth = 240 + ParentColor = True + TabOrder = 0 + Left = 8 + Height = 105 + Top = 8 + Width = 244 + object Label1: TLabel + Caption = '&Name:' + Color = clNone + FocusControl = EditName + Left = 15 + Height = 13 + Top = 11 + Width = 31 + end + object Label2: TLabel + Caption = '&Type:' + Color = clNone + FocusControl = SelectType + Left = 15 + Height = 13 + Top = 35 + Width = 27 + end + object Label3: TLabel + Caption = '&Size:' + Color = clNone + FocusControl = EditSize + Left = 15 + Height = 13 + Top = 59 + Width = 23 + end + object EditName: TEdit + OnChange = EditNameChange + ParentShowHint = False + ShowHint = True + TabOrder = 0 + Left = 79 + Height = 21 + Hint = 'Field name' + Top = 8 + Width = 145 + end + object SelectType: TComboBox + ItemHeight = 13 + Items.Strings = ( + 'String' + 'Integer' + 'SmallInt' + 'Word' + 'Float' + 'Currency' + 'Boolean' + 'Date' + 'Time' + 'DateTime' + 'Blob' + 'Memo' + 'Graphic' + 'LargeInt' + ) + MaxLength = 0 + OnChange = SelectTypeChange + Style = csDropDownList + TabOrder = 1 + Left = 79 + Height = 21 + Hint = 'Field type' + Top = 32 + Width = 145 + end + object EditSize: TEdit + Enabled = False + TabOrder = 2 + Left = 79 + Height = 21 + Hint = 'Field size' + Top = 56 + Width = 145 + end + end + end + object Panel3: TPanel + Align = alTop + ClientHeight = 144 + ClientWidth = 262 + FullRepaint = False + TabOrder = 1 + Visible = False + Height = 144 + Top = 185 + Width = 262 + object GroupBox2: TGroupBox + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = 'Lookup definition' + ClientHeight = 111 + ClientWidth = 240 + ParentColor = True + TabOrder = 0 + Left = 8 + Height = 129 + Top = 8 + Width = 244 + object Label4: TLabel + Caption = '&Key fields' + Color = clNone + FocusControl = SelectKeyFields + Left = 16 + Height = 13 + Top = 10 + Width = 45 + end + object Label5: TLabel + Caption = 'L&ookup keys' + Color = clNone + FocusControl = SelectLookupKeys + Left = 16 + Height = 13 + Top = 58 + Width = 61 + end + object Label6: TLabel + Caption = '&Result Fields' + Color = clNone + FocusControl = SelectResultField + Left = 16 + Height = 13 + Top = 82 + Width = 60 + end + object Label10: TLabel + Caption = 'Dataset' + Color = clNone + Left = 16 + Height = 13 + Top = 34 + Width = 37 + end + object SelectKeyFields: TComboBox + ItemHeight = 13 + MaxLength = 0 + OnChange = SelectKeyFieldsChange + ParentShowHint = False + ShowHint = True + TabOrder = 0 + Left = 80 + Height = 21 + Hint = 'Key fields' + Top = 7 + Width = 145 + end + object SelectLookupKeys: TComboBox + Enabled = False + ItemHeight = 13 + MaxLength = 0 + OnChange = SelectLookupKeysChange + TabOrder = 2 + Left = 80 + Height = 21 + Top = 55 + Width = 145 + end + object SelectResultField: TComboBox + Enabled = False + ItemHeight = 13 + MaxLength = 0 + OnChange = SelectResultFieldChange + TabOrder = 3 + Left = 80 + Height = 21 + Top = 79 + Width = 145 + end + object DataSetsCombo: TComboBox + ItemHeight = 13 + MaxLength = 0 + OnChange = DataSetsComboChange + ParentShowHint = False + ShowHint = True + Style = csDropDownList + TabOrder = 1 + Left = 80 + Height = 21 + Hint = 'Lookup dataset' + Top = 31 + Width = 145 + end + end + end + object Panel4: TPanel + Align = alBottom + ClientHeight = 47 + ClientWidth = 262 + FullRepaint = False + TabOrder = 2 + Height = 47 + Top = 329 + Width = 262 + object OKBtn: TButton + Anchors = [akLeft, akBottom] + Caption = 'OK' + Default = True + Enabled = False + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 0 + Left = 56 + Height = 25 + Top = 11 + Width = 75 + end + object CancelBtn: TButton + Anchors = [akLeft, akBottom] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + Left = 136 + Height = 25 + Top = 11 + Width = 75 + end + end + object Panel1: TPanel + Align = alTop + ClientHeight = 64 + ClientWidth = 262 + FullRepaint = False + TabOrder = 3 + Height = 64 + Width = 262 + object RadioGroup1: TRadioGroup + Caption = 'Field Type' + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + '&Calculated' + '&Lookup' + ) + OnClick = RadioGroup1Click + ParentColor = True + Left = 8 + Height = 48 + Top = 8 + Width = 244 + end + end +end diff --git a/ideintf/newfield.lrs b/ideintf/newfield.lrs new file mode 100644 index 0000000000..621e024075 --- /dev/null +++ b/ideintf/newfield.lrs @@ -0,0 +1,70 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TNewFieldFrm','FORMDATA',[ + 'TPF0'#12'TNewFieldFrm'#11'NewFieldFrm'#11'BorderStyle'#7#8'bsDialog'#7'Capti' + +'on'#6#6'Dialog'#12'ClientHeight'#3'x'#1#11'ClientWidth'#3#6#1#8'OnCreate'#7 + +#10'FormCreate'#10'ParentFont'#9#13'PixelsPerInch'#2'`'#8'Position'#7#14'poS' + +'creenCenter'#10'TextHeight'#2#13#18'HorzScrollBar.Page'#3#5#1#18'VertScroll' + +'Bar.Page'#3'w'#1#4'Left'#3#243#0#6'Height'#3'x'#1#3'Top'#3#176#0#5'Width'#3 + +#6#1#0#6'TPanel'#6'Panel2'#5'Align'#7#5'alTop'#12'ClientHeight'#2'y'#11'Clie' + +'ntWidth'#3#6#1#11'FullRepaint'#8#8'TabOrder'#2#0#6'Height'#2'y'#3'Top'#2'@' + +#5'Width'#3#6#1#0#9'TGroupBox'#9'GroupBox1'#7'Caption'#6#16'Field properties' + +#12'ClientHeight'#2'W'#11'ClientWidth'#3#240#0#11'ParentColor'#9#8'TabOrder' + +#2#0#4'Left'#2#8#6'Height'#2'i'#3'Top'#2#8#5'Width'#3#244#0#0#6'TLabel'#6'La' + +'bel1'#7'Caption'#6#6'&Name:'#5'Color'#7#6'clNone'#12'FocusControl'#7#8'Edit' + +'Name'#4'Left'#2#15#6'Height'#2#13#3'Top'#2#11#5'Width'#2#31#0#0#6'TLabel'#6 + +'Label2'#7'Caption'#6#6'&Type:'#5'Color'#7#6'clNone'#12'FocusControl'#7#10'S' + +'electType'#4'Left'#2#15#6'Height'#2#13#3'Top'#2'#'#5'Width'#2#27#0#0#6'TLab' + +'el'#6'Label3'#7'Caption'#6#6'&Size:'#5'Color'#7#6'clNone'#12'FocusControl'#7 + +#8'EditSize'#4'Left'#2#15#6'Height'#2#13#3'Top'#2';'#5'Width'#2#23#0#0#5'TEd' + +'it'#8'EditName'#8'OnChange'#7#14'EditNameChange'#14'ParentShowHint'#8#8'Sho' + +'wHint'#9#8'TabOrder'#2#0#4'Left'#2'O'#6'Height'#2#21#4'Hint'#6#10'Field nam' + +'e'#3'Top'#2#8#5'Width'#3#145#0#0#0#9'TComboBox'#10'SelectType'#10'ItemHeigh' + +'t'#2#13#13'Items.Strings'#1#6#6'String'#6#7'Integer'#6#8'SmallInt'#6#4'Word' + +#6#5'Float'#6#8'Currency'#6#7'Boolean'#6#4'Date'#6#4'Time'#6#8'DateTime'#6#4 + +'Blob'#6#4'Memo'#6#7'Graphic'#6#8'LargeInt'#0#9'MaxLength'#2#0#8'OnChange'#7 + +#16'SelectTypeChange'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#1#4'Left'#2 + +'O'#6'Height'#2#21#4'Hint'#6#10'Field type'#3'Top'#2' '#5'Width'#3#145#0#0#0 + +#5'TEdit'#8'EditSize'#7'Enabled'#8#8'TabOrder'#2#2#4'Left'#2'O'#6'Height'#2 + +#21#4'Hint'#6#10'Field size'#3'Top'#2'8'#5'Width'#3#145#0#0#0#0#0#6'TPanel'#6 + +'Panel3'#5'Align'#7#5'alTop'#12'ClientHeight'#3#144#0#11'ClientWidth'#3#6#1 + +#11'FullRepaint'#8#8'TabOrder'#2#1#7'Visible'#8#6'Height'#3#144#0#3'Top'#3 + +#185#0#5'Width'#3#6#1#0#9'TGroupBox'#9'GroupBox2'#7'Anchors'#11#5'akTop'#6'a' + +'kLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#17'Lookup definition'#12'Clien' + +'tHeight'#2'o'#11'ClientWidth'#3#240#0#11'ParentColor'#9#8'TabOrder'#2#0#4'L' + +'eft'#2#8#6'Height'#3#129#0#3'Top'#2#8#5'Width'#3#244#0#0#6'TLabel'#6'Label4' + +#7'Caption'#6#11'&Key fields'#5'Color'#7#6'clNone'#12'FocusControl'#7#15'Sel' + +'ectKeyFields'#4'Left'#2#16#6'Height'#2#13#3'Top'#2#10#5'Width'#2'-'#0#0#6'T' + +'Label'#6'Label5'#7'Caption'#6#12'L&ookup keys'#5'Color'#7#6'clNone'#12'Focu' + +'sControl'#7#16'SelectLookupKeys'#4'Left'#2#16#6'Height'#2#13#3'Top'#2':'#5 + +'Width'#2'='#0#0#6'TLabel'#6'Label6'#7'Caption'#6#14'&Result Fields'#5'Color' + +#7#6'clNone'#12'FocusControl'#7#17'SelectResultField'#4'Left'#2#16#6'Height' + +#2#13#3'Top'#2'R'#5'Width'#2'<'#0#0#6'TLabel'#7'Label10'#7'Caption'#6#7'Data' + +'set'#5'Color'#7#6'clNone'#4'Left'#2#16#6'Height'#2#13#3'Top'#2'"'#5'Width'#2 + +'%'#0#0#9'TComboBox'#15'SelectKeyFields'#10'ItemHeight'#2#13#9'MaxLength'#2#0 + +#8'OnChange'#7#21'SelectKeyFieldsChange'#14'ParentShowHint'#8#8'ShowHint'#9#8 + +'TabOrder'#2#0#4'Left'#2'P'#6'Height'#2#21#4'Hint'#6#10'Key fields'#3'Top'#2 + +#7#5'Width'#3#145#0#0#0#9'TComboBox'#16'SelectLookupKeys'#7'Enabled'#8#10'It' + +'emHeight'#2#13#9'MaxLength'#2#0#8'OnChange'#7#22'SelectLookupKeysChange'#8 + +'TabOrder'#2#2#4'Left'#2'P'#6'Height'#2#21#3'Top'#2'7'#5'Width'#3#145#0#0#0#9 + +'TComboBox'#17'SelectResultField'#7'Enabled'#8#10'ItemHeight'#2#13#9'MaxLeng' + +'th'#2#0#8'OnChange'#7#23'SelectResultFieldChange'#8'TabOrder'#2#3#4'Left'#2 + +'P'#6'Height'#2#21#3'Top'#2'O'#5'Width'#3#145#0#0#0#9'TComboBox'#13'DataSets' + +'Combo'#10'ItemHeight'#2#13#9'MaxLength'#2#0#8'OnChange'#7#19'DataSetsComboC' + +'hange'#14'ParentShowHint'#8#8'ShowHint'#9#5'Style'#7#14'csDropDownList'#8'T' + +'abOrder'#2#1#4'Left'#2'P'#6'Height'#2#21#4'Hint'#6#14'Lookup dataset'#3'Top' + +#2#31#5'Width'#3#145#0#0#0#0#0#6'TPanel'#6'Panel4'#5'Align'#7#8'alBottom'#12 + +'ClientHeight'#2'/'#11'ClientWidth'#3#6#1#11'FullRepaint'#8#8'TabOrder'#2#2#6 + +'Height'#2'/'#3'Top'#3'I'#1#5'Width'#3#6#1#0#7'TButton'#5'OKBtn'#7'Anchors' + +#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#2'OK'#7'Default'#9#7'Enabled'#8#11 + +'ModalResult'#2#1#7'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#0#4'Left'#2'8'#6 + +'Height'#2#25#3'Top'#2#11#5'Width'#2'K'#0#0#7'TButton'#9'CancelBtn'#7'Anchor' + +'s'#11#6'akLeft'#8'akBottom'#0#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalRe' + +'sult'#2#2#8'TabOrder'#2#1#4'Left'#3#136#0#6'Height'#2#25#3'Top'#2#11#5'Widt' + +'h'#2'K'#0#0#0#6'TPanel'#6'Panel1'#5'Align'#7#5'alTop'#12'ClientHeight'#2'@' + +#11'ClientWidth'#3#6#1#11'FullRepaint'#8#8'TabOrder'#2#3#6'Height'#2'@'#5'Wi' + +'dth'#3#6#1#0#11'TRadioGroup'#11'RadioGroup1'#7'Caption'#6#10'Field Type'#7 + +'Columns'#2#2#9'ItemIndex'#2#0#13'Items.Strings'#1#6#11'&Calculated'#6#7'&Lo' + ,'okup'#0#7'OnClick'#7#16'RadioGroup1Click'#11'ParentColor'#9#4'Left'#2#8#6'H' + +'eight'#2'0'#3'Top'#2#8#5'Width'#3#244#0#0#0#0#0 +]); diff --git a/ideintf/newfield.pas b/ideintf/newfield.pas new file mode 100644 index 0000000000..223fde8b6b --- /dev/null +++ b/ideintf/newfield.pas @@ -0,0 +1,364 @@ +{ Copyright (C) 2005 Alexandru Alexandrov + Date: 11.06.2005 + + ***************************************************************************** + * * + * See the file COPYING.modifiedLGPL, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** +} +unit newfield; + +{$mode Delphi} {$H+} + +interface + +uses + LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, StdCtrls, Buttons, DB, LResources, ComponentEditors, + PropEdits, TypInfo; + + +type + + { TNewFieldFrm } + + TNewFieldFrm=class(TForm) + Panel2: TPanel; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + EditName: TEdit; + Panel1: TPanel; + RadioGroup1: TRadioGroup; + SelectType: TComboBox; + EditSize: TEdit; + Panel3: TPanel; + GroupBox2: TGroupBox; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label10: TLabel; + SelectKeyFields: TComboBox; + SelectLookupKeys: TComboBox; + SelectResultField: TComboBox; + DataSetsCombo: TComboBox; + Panel4: TPanel; + OKBtn: TButton; + CancelBtn: TButton; + procedure DataSetsComboChange(Sender: TObject); + procedure EditNameChange(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure SelectKeyFieldsChange(Sender: TObject); + procedure SelectLookupKeysChange(Sender: TObject); + procedure SelectResultFieldChange(Sender: TObject); + procedure SelectTypeChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure UpdateLookupDatasets(Sender: TObject); + private + { Private declarations } + LinkDataSet: TDataSet; + FDesigner: TComponentEditorDesigner; + AddLookupDatasetProc: TGetStringProc; + function CreateField(fType: TFieldType; FName: string): TField; + procedure SetButtons; + procedure UpdateResultFields; + procedure UpdateFieldsTypes; + function GetLookupDataset: TDataset; + procedure AddLookupDataset(const s:ansistring); + public + { Public declarations } + constructor Create(AOwner: TComponent; ADataset: TDataset; + ADesigner: TComponentEditorDesigner); + destructor Destroy; override; + end ; + +var + NewFieldFrm: TNewFieldFrm; + +implementation + +uses dbconst; + +function min(i,j: integer): integer; +begin + Result := i; + if j 0) then begin + if Result < 1 then Result := j else + Result := Min(Result, j); + end; + end; + end; + +var i: integer; + f,s: string; +begin + f := FldList; + i := FirstPos(f); + while (i>0)do begin + s := Copy(F, 1, i-1); + Delete(F, 1, i); + AList.Add(s); + i := FirstPos(F); + end; + if F <> '' then AList.Add(F); +end; + +function TNewFieldFrm.CreateField(fType: TFieldType; FName: string): TField; +begin + Result := Nil; + {$IFNDEF VER2_0} + if DefaultFieldClasses[fType] <> Nil then begin + Result := DefaultFieldClasses[fType].Create(LinkDataSet.Owner); + Result.FieldName := fName; + Result.Name := FDesigner.CreateUniqueComponentName(LinkDataset.Name + FName); + Result.DataSet := LinkDataSet; + end; + {$ENDIF} +end; + +constructor TNewFieldFrm.Create(AOwner: TComponent; ADataset: TDataset; + ADesigner: TComponentEditorDesigner); +begin + LinkDataSet := ADataSet; + FDesigner := ADesigner; + inherited Create(AOwner); + AddLookupDatasetProc := AddLookupDataset; + UpdateFieldsTypes; + UpdateLookupDatasets(Self); +end; + +procedure TNewFieldFrm.DataSetsComboChange(Sender: TObject); +begin + UpdateResultFields; + SetButtons; +end ; + +procedure TNewFieldFrm.EditNameChange(Sender: TObject); +begin + SetButtons; +end ; + +procedure TNewFieldFrm.FormCreate(Sender: TObject); +var i: integer; +begin + if Assigned(LinkDataSet) then + LinkDataset.FieldDefs.Update; + for i := 0 to LinkDataSet.FieldDefs.Count - 1 do begin + SelectKeyFields.Items.Add(LinkDataSet.FieldDefs[i].Name); + end; + RadioGroup1.ItemIndex := 0; + RadioGroup1Click(Nil); +end; + +procedure TNewFieldFrm.UpdateLookupDatasets(Sender: TObject); +var + sText: string; +begin + sText := SelectLookupKeys.Text; + DataSetsCombo.Clear; + FDesigner.PropertyEditorHook.GetComponentNames(GetTypeData(TDataset.ClassInfo), + AddLookupDatasetProc); + SelectLookupKeys.Text := sText; +end; + +procedure TNewFieldFrm.OKBtnClick(Sender: TObject); + + function CheckName(FldName: string): string; + var i,j: integer; + begin + Result := FldName; + i := 0; + j := 0; + while (i < LinkDataSet.Fields.Count) do begin + if Result = LinkDataSet.Fields[i].FieldName then begin + inc(j); + Result := FldName + IntToStr(j); + end else Inc(i); + end; + end; + +var NewField: TField; + i: integer; + L: TStrings; + ADataset: TDataset; + sActive: boolean; + fldType: TFieldType; +begin + NewField := Nil; + sActive := LinkDataSet.Active; + LinkDataSet.Active := False; + try + case RadioGroup1.ItemIndex of + 0: begin //Create calc field + fldType := TFieldType(SelectType.Items.Objects[SelectType.ItemIndex]); + NewField := CreateField(fldType, CheckName(EditName.Text)); + NewField.Calculated := True; + NewField.FieldKind := fkCalculated; + + FDesigner.PropertyEditorHook.PersistentAdded(NewField, True); + FDesigner.Modified; + end; + else begin //Create lookup fields + L := TStringList.Create; + try + ADataset := GetLookupDataset; + SplitFieldsList(SelectResultField.Text, L); + for i := 0 to L.Count - 1 do begin + NewField := CreateField(ADataset.FieldByName(L[i]).DataType, CheckName(L[i])); + if NewField <> Nil then begin + if ADataset.FieldByName(L[i]).DataType = ftString then + NewField.Size := ADataset.FieldByName(L[i]).Size; + NewField.FieldKind := fkLookup; + NewField.KeyFields := SelectKeyFields.Text; + NewField.LookupDataSet := ADataset; + NewField.LookupResultField := L[i]; + NewField.LookupKeyFields := SelectLookupKeys.Text; + + FDesigner.PropertyEditorHook.PersistentAdded(NewField, True); + end else + ShowMessage('Field ''' + L[i] + ''' can''t be created!'); + end; + FDesigner.Modified; + finally + L.Free; + end; + end; + end; + except + if Assigned(NewField) then NewField.Free; + end; + if sActive then LinkDataSet.Active := True; +end; + +procedure TNewFieldFrm.RadioGroup1Click(Sender: TObject); +begin + case RadioGroup1.ItemIndex of + 0: begin //calculated field + Panel3.Visible := False; + Panel2.Visible := True; + ClientHeight := Panel1.Height + Panel2.Height + Panel4.Height; + end; + 1: begin //lookup field + Panel3.Visible := True; + Panel2.Visible := False; + ClientHeight := Panel1.Height + Panel3.Height + Panel4.Height; + end; + end; + SetButtons; +end ; + +procedure TNewFieldFrm.SelectKeyFieldsChange(Sender: TObject); +begin + UpdateResultFields; + SetButtons; +end; + +procedure TNewFieldFrm.SelectLookupKeysChange(Sender: TObject); +begin + SetButtons; +end ; + +procedure TNewFieldFrm.SelectResultFieldChange(Sender: TObject); +begin + SetButtons; +end ; + +procedure TNewFieldFrm.SelectTypeChange(Sender: TObject); +begin + UpdateResultFields; + SetButtons; +end ; + +procedure TNewFieldFrm.SetButtons; +begin + if SelectType.ItemIndex >= 0 then + case TFieldType(SelectType.Items.Objects[SelectType.ItemIndex]) of + ftString: EditSize.Enabled := True; + else EditSize.Enabled := False; + end + else EditSize.Enabled := False; + case RadioGroup1.ItemIndex of + 0: OkBtn.Enabled := (Length(EditName.Text) > 0) And + (SelectType.ItemIndex > -1); + 1: OkBtn.Enabled := (SelectKeyFields.Text <> '') And + (DataSetsCombo.ItemIndex > -1) And + (SelectLookupKeys.Text <> '') And + (SelectResultField.Text <> ''); + end; +end; + +procedure TNewFieldFrm.UpdateResultFields; +var i: integer; + ADataset: TDataset; +begin + SelectResultField.Clear; + SelectLookUpKeys.Clear; + if (DataSetsCombo.ItemIndex > -1) then begin + ADataset := GetLookupDataset; + if Assigned(ADataset) then begin + ADataset.FieldDefs.Update; + for i := 0 to ADataset.FieldDefs.Count - 1 do begin + SelectResultField.Items.Add(ADataset.FieldDefs[i].Name); + SelectLookUpKeys.Items.Add(ADataset.FieldDefs[i].Name); + end; + end; + end; + SelectLookUpKeys.Enabled := SelectLookUpKeys.Items.Count > 0; + SelectResultField.Enabled := SelectResultField.Items.Count > 0; +end; + + +procedure TNewFieldFrm.UpdateFieldsTypes; +var i: TFieldType; +begin + SelectType.Clear; + SelectType.Sorted := False; + for i := Low(Fieldtypenames) to High(Fieldtypenames) do begin + SelectType.Items.AddObject(Fieldtypenames[i], Tobject(i)); + end; + SelectType.Sorted := True; +end; + + +function TNewFieldFrm.GetLookupDataset: TDataset; +begin + Result := GlobalDesignHook.GetComponent( DataSetsCombo.Items[DataSetsCombo.ItemIndex] ) as TDataset; + if Not Result.InheritsFrom(TDataset) then Result := Nil; +end; + +procedure TNewFieldFrm.AddLookupDataset(const s: ansistring); +begin + if (AnsiCompareText(s, LinkDataSet.Name) <> 0) then + DataSetsCombo.Items.Add(s); +end; + +destructor TNewFieldFrm.Destroy; +begin + inherited Destroy; +end; + +initialization + {$i newfield.lrs} + +end. diff --git a/lcl/dbctrls.pp b/lcl/dbctrls.pp index 6a5a7d2699..d16e2ecf41 100644 --- a/lcl/dbctrls.pp +++ b/lcl/dbctrls.pp @@ -894,6 +894,24 @@ procedure Register; implementation +var + FieldClasses: TList; + +procedure RegFields(const AFieldClasses: array of TFieldClass); +var I: Integer; + FieldClass: TFieldClass; +begin + if FieldClasses = nil then FieldClasses := TList.Create; + for I := Low(AFieldClasses) to High(AFieldClasses) do begin + FieldClass := AFieldClasses[I]; + if (FieldClass <> Nil) And (FieldClasses.IndexOf(FieldClass) = -1) then + begin + FieldClasses.Add(FieldClass); + RegisterNoIcon([FieldClass]); + RegisterClass(FieldClass); + end; + end; +end; function ExtractFieldName(const Fields: string; var StartPos: Integer): string; var @@ -945,6 +963,9 @@ begin RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo, TDBImage,TDBListBox,TDBComboBox,TDBCheckBox,TDBRadioGroup,TDBCalendar, TDBGroupBox]); + {$IFNDEF VER2_0} + RegFields(DefaultFieldClasses); + {$ENDIF} end; @@ -1297,11 +1318,17 @@ end; {$Include dbcalendar.inc} {$Include dbcustomnavigator.inc} +finalization + FieldClasses.Free; + end. { ============================================================================= $Log$ + Revision 1.30 2005/06/13 18:34:21 mattias + added DB Fields Editor for the IDE from Alexandrov Alexandru - needs FPC 2.1 + Revision 1.29 2005/05/07 13:00:18 mattias fixed TDBComboBox update (bug 873) from Joost van der Sluis