mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 12:18:03 +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/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
|
||||
|
||||
@ -7,8 +7,7 @@ unit Printer4Lazarus;
|
||||
interface
|
||||
|
||||
uses
|
||||
PrintersDlgs, OSPrinters, uDlgSelectPrinter, cupsdyn, uDlgPropertiesPrinter,
|
||||
LazarusPackageIntf;
|
||||
PrintersDlgs, OSPrinters, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
The following people contributed to Lazarus:
|
||||
|
||||
Alexander Shiyan
|
||||
Alexandru Alexandrov
|
||||
Andreas Hausladen
|
||||
Andrew Haines
|
||||
Andrew Johnson
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 \
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user