mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-30 05:21:38 +01:00
527 lines
16 KiB
ObjectPascal
527 lines
16 KiB
ObjectPascal
{ Copyright (C) 2005 Alexandru Alexandrov
|
|
Date: 11.06.2005
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, 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. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Modified Date: 20.10.2010
|
|
By: Marcelo Borges de Paula
|
|
}
|
|
unit fieldseditor;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, TypInfo, LCLProc, Forms, Controls, Menus, Graphics,
|
|
Dialogs, ComCtrls, db, ActnList, StdCtrls, ObjInspStrConsts, ComponentEditors,
|
|
PropEdits, PropEditUtils, LCLType, ExtCtrls, NewField, FieldsList,
|
|
ComponentReg, types;
|
|
|
|
type
|
|
|
|
TFieldsComponentEditor = class;
|
|
|
|
{ TDSFieldsEditorFrm }
|
|
|
|
TDSFieldsEditorFrm = class(TForm)
|
|
Fields: TImageList;
|
|
MenuItem6: TMenuItem;
|
|
MenuItem7: TMenuItem;
|
|
tbCommands: TToolBar;
|
|
tbAddFld: TToolButton;
|
|
tbUnselect: TToolButton;
|
|
tbDeleteFld: TToolButton;
|
|
tbNewFld: TToolButton;
|
|
ToolButton4: TToolButton;
|
|
ToolButton5: TToolButton;
|
|
tbMoveUp: TToolButton;
|
|
tbMoveDown: TToolButton;
|
|
ToolButton8: TToolButton;
|
|
tbSelect: TToolButton;
|
|
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 ActionList1Update(AAction: TBasicAction; var Handled: Boolean);
|
|
procedure AddFieldsActnExecute(Sender: TObject);
|
|
procedure DeleteFieldsActnExecute(Sender: TObject);
|
|
procedure FieldsEditorFrmClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
procedure FieldsEditorFrmDestroy(Sender: TObject);
|
|
procedure FieldsListBoxDrawItem(Control: TWinControl; Index: Integer;
|
|
ARect: TRect; State: TOwnerDrawState);
|
|
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(AOrderChanged: Boolean = false);
|
|
procedure OnComponentRenamed(AComponent: TComponent);
|
|
procedure OnPersistentDeleting(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);
|
|
function FindChild(ACandidate: TPersistent; out AIndex: Integer): Boolean;
|
|
public
|
|
{ public declarations }
|
|
constructor Create(AOwner: TComponent; ADataset: TDataset;
|
|
ADesigner: TComponentEditorDesigner); reintroduce;
|
|
destructor Destroy; override;
|
|
property Designer: TComponentEditorDesigner read FDesigner write FDesigner;
|
|
property ComponentEditor: TFieldsComponentEditor write FComponentEditor;
|
|
end;
|
|
|
|
{ TActionListComponentEditor }
|
|
|
|
TFieldsComponentEditor = class(TComponentEditor)
|
|
public
|
|
function GetVerbCount: Integer; override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
IDEImagesIntf;
|
|
|
|
{ TDSFieldsEditorFrm }
|
|
|
|
procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject);
|
|
var FieldsList: TFieldsListFrm;
|
|
begin
|
|
try
|
|
FieldsList := TFieldsListFrm.Create(Self, LinkDataset, Designer);
|
|
except
|
|
on E:Exception do begin
|
|
ShowMessage(fesNoFields+^M+fesCheckDSet+^M^M+E.Message);
|
|
exit;
|
|
end;
|
|
end;
|
|
try
|
|
FieldsList.ShowModal;
|
|
finally
|
|
FieldsList.Free;
|
|
end;
|
|
SelectionChanged;
|
|
end;
|
|
|
|
constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset;
|
|
ADesigner: TComponentEditorDesigner);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
tbCommands.Images := IDEImages.Images_16;
|
|
tbAddFld.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
|
|
tbDeleteFld.ImageIndex := IDEImages.LoadImage(16, 'laz_delete');
|
|
tbNewFld.ImageIndex := IDEImages.LoadImage(16,'menu_new');
|
|
tbMoveDown.ImageIndex := IDEImages.LoadImage(16, 'arrow_down');
|
|
tbMoveUp.ImageIndex := IDEImages.LoadImage(16, 'arrow_up');
|
|
tbSelect.ImageIndex := IDEImages.LoadImage(16, 'menu_select_all');
|
|
tbUnselect.ImageIndex := IDEImages.LoadImage(16, 'menu_close_all');
|
|
|
|
LinkDataset := ADataset;
|
|
FDesigner := ADesigner;
|
|
Caption := fesFeTitle + ' - ' + LinkDataset.Name;
|
|
AddFieldsActn.Caption := oisAddFields;
|
|
AddFieldsActn.Hint := oisAddFieldsFromFieldDefs;
|
|
DeleteFieldsActn.Caption:=oisDeleteComponents;
|
|
DeleteFieldsActn.Hint:=oisDeleteSelectedFieldS;
|
|
NewActn.Caption:=oisNew;
|
|
NewActn.Hint:=oisCreateNewFieldAndAddItAtCurrentPosition;
|
|
MoveUpActn.Caption:=oisMoveUp;
|
|
MoveUpActn.Hint:=oisMoveUpHint;
|
|
MoveDownActn.Caption:=oisMoveDown;
|
|
MoveDownActn.Hint:=oisMoveDownHint;
|
|
SelectAllActn.Caption:=oisSelectAll;
|
|
SelectAllActn.Hint:=oisSelectAllHint;
|
|
UnselectAllActn.Caption:=oisUnselectAll;
|
|
UnselectAllActn.Hint:=oisUnselectAllHint;
|
|
|
|
FieldsListBox.Clear;
|
|
RefreshFieldsListBox(False);
|
|
|
|
GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
|
|
GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
|
|
GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
|
|
GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
|
|
GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
|
|
|
|
SelectionChanged;
|
|
end;
|
|
|
|
destructor TDSFieldsEditorFrm.Destroy;
|
|
begin
|
|
UnregisterEditorForm(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject);
|
|
var
|
|
PreActive: boolean;
|
|
begin
|
|
PreActive := LinkDataSet.Active;
|
|
LinkDataSet.Active := False;
|
|
if FieldsListBox.SelCount = 0 then
|
|
exit;
|
|
FDesigner.DeleteSelection;
|
|
SelectionChanged;
|
|
if PreActive then
|
|
LinkDataSet.Active := True;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
CloseAction := caFree;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject);
|
|
begin
|
|
if Assigned(FComponentEditor) then begin
|
|
if Assigned(LinkDataset) And (Not (csDestroying in LinkDataset.ComponentState)) And (FieldsListBox.SelCount > 0) then
|
|
GlobalDesignHook.SelectOnlyThis(LinkDataset);
|
|
end;
|
|
if Assigned(GlobalDesignHook) then
|
|
GlobalDesignHook.RemoveAllHandlersForObject(Self);
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.FieldsListBoxDrawItem(Control: TWinControl;
|
|
Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
var fld: TField;
|
|
begin
|
|
if Index < 0 then Exit;
|
|
if not Assigned(FieldsListBox.Items.Objects[Index]) then Exit;
|
|
//
|
|
FieldsListBox.Canvas.FillRect(ARect);
|
|
fld := TField(FieldsListBox.Items.Objects[Index]);
|
|
//
|
|
if pfinKey in fld.ProviderFlags then
|
|
Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,0)
|
|
else
|
|
case fld.FieldKind of
|
|
fkData : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,1);
|
|
fkCalculated : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,2);
|
|
fkLookup : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,3);
|
|
fkInternalCalc : Fields.Draw(FieldsListBox.Canvas,1,ARect.Top,4);
|
|
end;
|
|
//
|
|
FieldsListBox.Canvas.TextRect(ARect, ARect.Left + 20,ARect.Top,
|
|
FieldsListBox.Items[Index]);
|
|
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;
|
|
PreActive: boolean;
|
|
begin
|
|
PreActive := LinkDataSet.Active;
|
|
if PreActive And LinkDataset.DefaultFields then
|
|
LinkDataset.Close;
|
|
//Deselect & refresh all existing
|
|
FieldsListBox.ClearSelection;
|
|
//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;
|
|
if PreActive and not LinkDataset.Active then
|
|
LinkDataset.Active:=true;
|
|
end;
|
|
|
|
function TDSFieldsEditorFrm.FindChild(ACandidate: TPersistent; out
|
|
AIndex: Integer): Boolean;
|
|
begin
|
|
if ACandidate is TField then
|
|
AIndex := FieldsListBox.Items.IndexOfObject(ACandidate)
|
|
else
|
|
AIndex := -1;
|
|
Result := AIndex >= 0;
|
|
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(True);
|
|
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(True);
|
|
if bModified then fDesigner.Modified;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.ActionList1Update(AAction: TBasicAction;
|
|
var Handled: Boolean);
|
|
var
|
|
b: boolean;
|
|
i, SelectedCount: integer;
|
|
begin
|
|
b := FieldsListBox.Count > 0;
|
|
SelectedCount := 0;
|
|
for i:= 0 to FieldsListBox.Count-1 do
|
|
if FieldsListBox.Selected[i] then
|
|
Inc(SelectedCount);
|
|
|
|
DeleteFieldsActn.Enabled := b and (SelectedCount > 0);
|
|
MoveDownActn.Enabled := b and (SelectedCount > 0)
|
|
and (Not FieldsListBox.Selected[FieldsListBox.Items.Count - 1]);
|
|
MoveUpActn.Enabled := b and (SelectedCount > 0)
|
|
and (Not FieldsListBox.Selected[0]);
|
|
SelectAllActn.Enabled := b and (FieldsListBox.Count <> SelectedCount);
|
|
UnselectAllActn.Enabled := b and (SelectedCount > 0);
|
|
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(AOrderChanged: Boolean = false);
|
|
var SelList: TPersistentSelectionList;
|
|
begin
|
|
GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
|
|
try
|
|
SelList := TPersistentSelectionList.Create;
|
|
SelList.ForceUpdate := AOrderChanged;
|
|
try
|
|
OnGetSelection(SelList);
|
|
FDesigner.PropertyEditorHook.SetSelection(SelList) ;
|
|
finally
|
|
SelList.Free;
|
|
end;
|
|
finally
|
|
GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
|
|
end;
|
|
ActionList1.UpdateAction(nil);
|
|
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 := fesFeTitle + ' - ' + LinkDataset.Name;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.OnPersistentDeleting(APersistent: TPersistent);
|
|
var i: integer;
|
|
begin
|
|
if FindChild(APersistent, i) then
|
|
FieldsListBox.Items.Delete(i);
|
|
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
|
|
FieldsListBox.ClearSelection;
|
|
//select from list
|
|
for i := 0 to ASelection.Count - 1 do
|
|
if FindChild(ASelection.Items[i], j) then
|
|
FieldsListBox.Selected[j] := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent;
|
|
Select: boolean);
|
|
var fld: TField;
|
|
begin
|
|
if Assigned(APersistent) And
|
|
(APersistent is TField) And
|
|
((APersistent as TField).DataSet = LinkDataset) then begin
|
|
fld := APersistent as TField;
|
|
with FieldsListBox do
|
|
Selected[Items.AddObject(fld.FieldName, fld)] := Select;
|
|
end;
|
|
end;
|
|
|
|
{ TFieldsComponentEditor }
|
|
|
|
function TFieldsComponentEditor.GetVerbCount: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
function TFieldsComponentEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0: Result := fesFeTitle;
|
|
end;
|
|
end;
|
|
|
|
procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
ADataset: TDataset;
|
|
AEditor: TObject;
|
|
begin
|
|
case index of
|
|
0:
|
|
begin
|
|
ADataset := GetComponent as TDataset;
|
|
if ADataset=nil then
|
|
raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil');
|
|
|
|
AEditor := FindEditorForm(ADataset);
|
|
if AEditor=nil then begin
|
|
AEditor := TDSFieldsEditorFrm.Create(Application, ADataset, Designer);
|
|
RegisterEditorForm(AEditor, ADataset);
|
|
end;
|
|
|
|
if AEditor<>nil then
|
|
with TDsFieldsEditorFrm(AEditor) do begin
|
|
ComponentEditor := Self;
|
|
ShowOnTop;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterComponentEditor(TDataset, TFieldsComponentEditor);
|
|
end.
|