mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-28 19:40:53 +02:00
added DB Fields Editor for the IDE from Alexandrov Alexandru - needs FPC 2.1
git-svn-id: trunk@7238 -
This commit is contained in:
mattias
parent
4b51056801
commit
7e13a73664
9
.gitattributes
vendored
9
.gitattributes
vendored
@ -921,6 +921,12 @@ ideintf/componenttreeview.lrs svneol=native#text/pascal
|
|||||||
ideintf/componenttreeview.pas svneol=native#text/pascal
|
ideintf/componenttreeview.pas svneol=native#text/pascal
|
||||||
ideintf/configstorage.pas svneol=native#text/pascal
|
ideintf/configstorage.pas svneol=native#text/pascal
|
||||||
ideintf/dbpropedits.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/formeditingintf.pas svneol=native#text/pascal
|
||||||
ideintf/graphpropedits.pas svneol=native#text/pascal
|
ideintf/graphpropedits.pas svneol=native#text/pascal
|
||||||
ideintf/helpfpdoc.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/lazideintf.pas svneol=native#text/pascal
|
||||||
ideintf/listviewpropedit.pp svneol=native#text/pascal
|
ideintf/listviewpropedit.pp svneol=native#text/pascal
|
||||||
ideintf/macrointf.pas 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/newitemintf.pas svneol=native#text/pascal
|
||||||
ideintf/objectinspector.pp svneol=native#text/pascal
|
ideintf/objectinspector.pp svneol=native#text/pascal
|
||||||
ideintf/objinspstrconsts.pas svneol=native#text/pascal
|
ideintf/objinspstrconsts.pas svneol=native#text/pascal
|
||||||
|
|||||||
@ -7,8 +7,7 @@ unit Printer4Lazarus;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
PrintersDlgs, OSPrinters, uDlgSelectPrinter, cupsdyn, uDlgPropertiesPrinter,
|
PrintersDlgs, OSPrinters, LazarusPackageIntf;
|
||||||
LazarusPackageIntf;
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
@ -1,6 +1,7 @@
|
|||||||
The following people contributed to Lazarus:
|
The following people contributed to Lazarus:
|
||||||
|
|
||||||
Alexander Shiyan
|
Alexander Shiyan
|
||||||
|
Alexandru Alexandrov
|
||||||
Andreas Hausladen
|
Andreas Hausladen
|
||||||
Andrew Haines
|
Andrew Haines
|
||||||
Andrew Johnson
|
Andrew Johnson
|
||||||
|
|||||||
@ -17,6 +17,7 @@ Coding style:
|
|||||||
New files:
|
New files:
|
||||||
- Every file should start with a header containing the license and a few lines
|
- Every file should start with a header containing the license and a few lines
|
||||||
describing the content.
|
describing the content.
|
||||||
|
- pascal sources should have lowercase filenames (.pas, .pp, .inc, .lfm, .lrs)
|
||||||
|
|
||||||
Include files:
|
Include files:
|
||||||
- should start with the {%MainUnit } directive
|
- should start with the {%MainUnit } directive
|
||||||
|
|||||||
@ -22,6 +22,8 @@ implicitunits=actionseditor \
|
|||||||
componentreg \
|
componentreg \
|
||||||
componenttreeview \
|
componenttreeview \
|
||||||
configstorage \
|
configstorage \
|
||||||
|
fieldseditor \
|
||||||
|
fieldslist \
|
||||||
formeditingintf \
|
formeditingintf \
|
||||||
graphpropedits \
|
graphpropedits \
|
||||||
helpfpdoc \
|
helpfpdoc \
|
||||||
@ -30,6 +32,7 @@ implicitunits=actionseditor \
|
|||||||
idecommands \
|
idecommands \
|
||||||
imagelisteditor \
|
imagelisteditor \
|
||||||
listviewpropedit \
|
listviewpropedit \
|
||||||
|
newfield \
|
||||||
objectinspector \
|
objectinspector \
|
||||||
objinspstrconsts \
|
objinspstrconsts \
|
||||||
projectintf \
|
projectintf \
|
||||||
|
|||||||
@ -24,7 +24,8 @@ uses
|
|||||||
ComponentEditors, GraphPropEdits, DBPropEdits, ListViewPropEdit,
|
ComponentEditors, GraphPropEdits, DBPropEdits, ListViewPropEdit,
|
||||||
ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools,
|
ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools,
|
||||||
FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML,
|
FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML,
|
||||||
ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf, MacroIntf;
|
FieldsEditor, ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf,
|
||||||
|
MacroIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
103
ideintf/fieldseditor.lfm
Normal file
103
ideintf/fieldseditor.lfm
Normal file
@ -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
|
||||||
37
ideintf/fieldseditor.lrs
Normal file
37
ideintf/fieldseditor.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
471
ideintf/fieldseditor.pas
Normal file
471
ideintf/fieldseditor.pas
Normal file
@ -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.
|
||||||
46
ideintf/fieldslist.lfm
Normal file
46
ideintf/fieldslist.lfm
Normal file
@ -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
|
||||||
17
ideintf/fieldslist.lrs
Normal file
17
ideintf/fieldslist.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
141
ideintf/fieldslist.pas
Normal file
141
ideintf/fieldslist.pas
Normal file
@ -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 <http://www.gnu.org/copyleft/gpl.html>. 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.
|
||||||
|
|
||||||
278
ideintf/newfield.lfm
Normal file
278
ideintf/newfield.lfm
Normal file
@ -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
|
||||||
70
ideintf/newfield.lrs
Normal file
70
ideintf/newfield.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
364
ideintf/newfield.pas
Normal file
364
ideintf/newfield.pas
Normal file
@ -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<i then Result := j;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SplitFieldsList(FldList: string; AList: TStrings);
|
||||||
|
const
|
||||||
|
SplitChars: Array[0..2] of Char = ('+',';',':');
|
||||||
|
|
||||||
|
function FirstPos(AString: string): integer;
|
||||||
|
var i,j: integer;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
for i := Low(SplitChars) to High(SplitChars) do begin
|
||||||
|
j := Pos(SplitChars[i], AString);
|
||||||
|
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.
|
||||||
@ -894,6 +894,24 @@ procedure Register;
|
|||||||
|
|
||||||
implementation
|
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;
|
function ExtractFieldName(const Fields: string; var StartPos: Integer): string;
|
||||||
var
|
var
|
||||||
@ -945,6 +963,9 @@ begin
|
|||||||
RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
|
RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
|
||||||
TDBImage,TDBListBox,TDBComboBox,TDBCheckBox,TDBRadioGroup,TDBCalendar,
|
TDBImage,TDBListBox,TDBComboBox,TDBCheckBox,TDBRadioGroup,TDBCalendar,
|
||||||
TDBGroupBox]);
|
TDBGroupBox]);
|
||||||
|
{$IFNDEF VER2_0}
|
||||||
|
RegFields(DefaultFieldClasses);
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1297,11 +1318,17 @@ end;
|
|||||||
{$Include dbcalendar.inc}
|
{$Include dbcalendar.inc}
|
||||||
{$Include dbcustomnavigator.inc}
|
{$Include dbcustomnavigator.inc}
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FieldClasses.Free;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$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
|
Revision 1.29 2005/05/07 13:00:18 mattias
|
||||||
fixed TDBComboBox update (bug 873) from Joost van der Sluis
|
fixed TDBComboBox update (bug 873) from Joost van der Sluis
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user