/ideintf/fieldseditor.pas

http://github.com/graemeg/lazarus · Pascal · 461 lines · 381 code · 46 blank · 34 comment · 40 complexity · 391575a2fda2b25a51be6c385ff0a940 MD5 · raw file

  1. { Copyright (C) 2005 Alexandru Alexandrov
  2. Date: 11.06.2005
  3. *****************************************************************************
  4. * *
  5. * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
  6. * for details about the copyright. *
  7. * *
  8. * This program is distributed in the hope that it will be useful, *
  9. * but WITHOUT ANY WARRANTY; without even the implied warranty of *
  10. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
  11. * *
  12. *****************************************************************************
  13. }
  14. unit fieldseditor;
  15. {$mode objfpc}{$H+}
  16. interface
  17. {$IFNDEF VER2_0}
  18. uses
  19. Classes, SysUtils, LResources, TypInfo, LCLProc, Forms,
  20. Controls, Menus, Graphics, Dialogs, ComCtrls,
  21. db, ActnList, StdCtrls, ObjInspStrConsts, ComponentEditors,
  22. PropEdits, LCLType, NewField, FieldsList, ComponentReg;
  23. type
  24. TFieldsComponentEditor = class;
  25. { TDSFieldsEditorFrm }
  26. TDSFieldsEditorFrm = class(TForm)
  27. MenuItem6: TMenuItem;
  28. MenuItem7: TMenuItem;
  29. UnselectAllActn: TAction;
  30. SelectAllActn: TAction;
  31. FieldsListBox: TListBox;
  32. MoveDownActn: TAction;
  33. MoveUpActn: TAction;
  34. NewActn: TAction;
  35. DeleteFieldsActn: TAction;
  36. AddFieldsActn: TAction;
  37. ActionList1: TActionList;
  38. MenuItem1: TMenuItem;
  39. MenuItem2: TMenuItem;
  40. MenuItem3: TMenuItem;
  41. MenuItem4: TMenuItem;
  42. MenuItem5: TMenuItem;
  43. PopupMenu1: TPopupMenu;
  44. procedure AddFieldsActnExecute(Sender: TObject);
  45. procedure DeleteFieldsActnExecute(Sender: TObject);
  46. procedure FieldsEditorFrmClose(Sender: TObject;
  47. var CloseAction: TCloseAction);
  48. procedure FieldsEditorFrmDestroy(Sender: TObject);
  49. procedure FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
  50. Shift: TShiftState);
  51. procedure NewActnExecute(Sender: TObject);
  52. procedure ListBox1Click(Sender: TObject);
  53. procedure MoveDownActnExecute(Sender: TObject);
  54. procedure MoveUpActnExecute(Sender: TObject);
  55. procedure SelectAllActnExecute(Sender: TObject);
  56. procedure UnselectAllActnExecute(Sender: TObject);
  57. protected
  58. { protected declarations }
  59. procedure DoSelected(All: boolean);
  60. procedure SelectionChanged;
  61. procedure OnComponentRenamed(AComponent: TComponent);
  62. procedure OnPersistentDeleting(APersistent: TPersistent);
  63. procedure OnGetSelection(const ASelection: TPersistentSelectionList);
  64. procedure OnSetSelection(const ASelection: TPersistentSelectionList);
  65. procedure OnPersistentAdded(APersistent: TPersistent; Select: boolean);
  66. private
  67. { private declarations }
  68. LinkDataset: TDataset;
  69. FDesigner: TComponentEditorDesigner;
  70. FComponentEditor: TFieldsComponentEditor;
  71. procedure ExchangeItems(const fFirst, fSecond: integer);
  72. procedure RefreshFieldsListBox(SelectAllNew: boolean);
  73. public
  74. { public declarations }
  75. constructor Create(AOwner: TComponent; ADataset: TDataset;
  76. ADesigner: TComponentEditorDesigner); reintroduce;
  77. property Designer: TComponentEditorDesigner read FDesigner write FDesigner;
  78. property ComponentEditor: TFieldsComponentEditor write FComponentEditor;
  79. end;
  80. { TActionListComponentEditor }
  81. TFieldsComponentEditor = class(TComponentEditor)
  82. private
  83. FDataSet: TDataset;
  84. FFieldsEditorForm: TDSFieldsEditorFrm;
  85. fWindowClosed: Boolean;
  86. protected
  87. public
  88. constructor Create(AComponent: TComponent;
  89. ADesigner: TComponentEditorDesigner); override;
  90. destructor Destroy; override;
  91. function GetVerbCount: Integer; override;
  92. function GetVerb(Index: Integer): string; override;
  93. procedure ExecuteVerb(Index: Integer); override;
  94. procedure EditorWindowClose;
  95. property LinkDataset: TDataset read FDataSet write FDataSet;
  96. end;
  97. implementation
  98. { TDSFieldsEditorFrm }
  99. procedure TDSFieldsEditorFrm.AddFieldsActnExecute(Sender: TObject);
  100. var FieldsList: TFieldsListFrm;
  101. begin
  102. try
  103. FieldsList := TFieldsListFrm.Create(Self, LinkDataset, Designer);
  104. except
  105. on E:Exception do begin
  106. ShowMessage(fesNoFields+^M+fesCheckDSet+^M^M+E.Message);
  107. exit;
  108. end;
  109. end;
  110. try
  111. FieldsList.ShowModal;
  112. finally
  113. FieldsList.Free;
  114. end;
  115. SelectionChanged;
  116. end;
  117. constructor TDSFieldsEditorFrm.Create(AOwner: TComponent; ADataset: TDataset;
  118. ADesigner: TComponentEditorDesigner);
  119. begin
  120. inherited Create(AOwner);
  121. LinkDataset := ADataset;
  122. FDesigner := ADesigner;
  123. Caption := fesFeTitle + ' - ' + LinkDataset.Name;
  124. FieldsListBox.Clear;
  125. RefreshFieldsListBox(False);
  126. GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
  127. GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
  128. GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
  129. GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
  130. GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
  131. SelectionChanged;
  132. end;
  133. procedure TDSFieldsEditorFrm.DeleteFieldsActnExecute(Sender: TObject);
  134. var i: integer;
  135. PreActive: boolean;
  136. bModified: boolean;
  137. fld: TField;
  138. begin
  139. PreActive := LinkDataSet.Active;
  140. LinkDataSet.Active := False;
  141. bModified := False;
  142. for i := FieldsListBox.Items.Count - 1 downto 0 do
  143. if FieldsListBox.Selected[i] then begin
  144. fld := TField(FieldsListBox.Items.Objects[i]);
  145. FieldsListBox.Items.Delete(i);
  146. FDesigner.PropertyEditorHook.PersistentDeleting(fld);
  147. fld.Free;
  148. bModified := True;
  149. end;
  150. if bModified then
  151. fDesigner.Modified;
  152. if PreActive then
  153. LinkDataSet.Active := True;
  154. SelectionChanged;
  155. end;
  156. procedure TDSFieldsEditorFrm.FieldsEditorFrmClose(Sender: TObject;
  157. var CloseAction: TCloseAction);
  158. begin
  159. CloseAction := caFree;
  160. end;
  161. procedure TDSFieldsEditorFrm.FieldsEditorFrmDestroy(Sender: TObject);
  162. begin
  163. if Assigned(FComponentEditor) then begin
  164. if Assigned(LinkDataset) And (Not (csDestroying in LinkDataset.ComponentState)) And (FieldsListBox.SelCount > 0) then
  165. GlobalDesignHook.SelectOnlyThis(LinkDataset);
  166. FComponentEditor.EditorWindowClose;
  167. end;
  168. if Assigned(GlobalDesignHook) then
  169. GlobalDesignHook.RemoveAllHandlersForObject(Self);
  170. end;
  171. procedure TDSFieldsEditorFrm.FieldsListBoxKeyDown(Sender: TObject; var Key: Word;
  172. Shift: TShiftState);
  173. begin
  174. if ssCtrl in Shift then
  175. case Key of
  176. VK_UP: begin
  177. MoveUpActn.Execute;
  178. Key := 0;
  179. end;
  180. VK_DOWN: begin
  181. MoveDownActn.Execute;
  182. Key := 0;
  183. end;
  184. end;
  185. end;
  186. procedure TDSFieldsEditorFrm.ExchangeItems(const fFirst, fSecond: integer);
  187. var SelFirst,
  188. SelSecond: boolean;
  189. begin
  190. with FieldsListBox do begin
  191. // save selected
  192. SelFirst := Selected[fFirst];
  193. SelSecond := Selected[fSecond];
  194. // exchange items
  195. FieldsListBox.Items.Exchange(fFirst,fSecond);
  196. // restore selected
  197. Selected[fFirst] := SelSecond;
  198. Selected[fSecond] := SelFirst;
  199. TField(Items.Objects[fFirst]).Index := fFirst;
  200. end;
  201. end;
  202. procedure TDSFieldsEditorFrm.RefreshFieldsListBox(SelectAllNew: boolean);
  203. var i, j: integer;
  204. fld: TField;
  205. PreActive: boolean;
  206. begin
  207. PreActive := LinkDataSet.Active;
  208. if PreActive And LinkDataset.DefaultFields then
  209. LinkDataset.Close;
  210. //Deselect & refresh all existing
  211. DoSelected(False);
  212. //Add new fields
  213. for i := 0 to LinkDataset.Fields.Count - 1 do begin
  214. fld := LinkDataset.Fields[i];
  215. if FieldsListBox.Items.IndexOfObject(fld) < 0 then begin
  216. j := FieldsListBox.Items.AddObject(fld.FieldName, fld);
  217. FieldsListBox.Selected[j] := SelectAllNew;
  218. end;
  219. end;
  220. if PreActive and not LinkDataset.Active then
  221. LinkDataset.Active:=true;
  222. end;
  223. procedure TDSFieldsEditorFrm.NewActnExecute(Sender: TObject);
  224. var nf: TNewFieldFrm;
  225. begin
  226. nf := TNewFieldFrm.Create(Self, LinkDataset, Designer);
  227. try
  228. nf.ShowModal;
  229. finally
  230. nf.Free;
  231. end;
  232. SelectionChanged;
  233. end;
  234. procedure TDSFieldsEditorFrm.ListBox1Click(Sender: TObject);
  235. begin
  236. SelectionChanged;
  237. end;
  238. procedure TDSFieldsEditorFrm.MoveDownActnExecute(Sender: TObject);
  239. var i: integer;
  240. bModified: boolean;
  241. begin
  242. if FieldsListBox.Selected[FieldsListBox.Items.Count - 1] then exit;
  243. bModified := False;
  244. for i := FieldsListBox.Items.Count - 2 downto 0 do
  245. if FieldsListBox.Selected[i] then begin
  246. ExchangeItems(i, i + 1);
  247. bModified := True;
  248. end;
  249. SelectionChanged;
  250. if bModified then fDesigner.Modified;
  251. end;
  252. procedure TDSFieldsEditorFrm.MoveUpActnExecute(Sender: TObject);
  253. var i: integer;
  254. bModified: boolean;
  255. begin
  256. if FieldsListBox.Selected[0] then exit;
  257. bModified := False;
  258. for i := 1 to FieldsListBox.Items.Count - 1 do
  259. if FieldsListBox.Selected[i] then begin
  260. ExchangeItems(i - 1, i);
  261. bModified := True;
  262. end;
  263. SelectionChanged;
  264. if bModified then fDesigner.Modified;
  265. end;
  266. procedure TDSFieldsEditorFrm.SelectAllActnExecute(Sender: TObject);
  267. begin
  268. DoSelected(True);
  269. SelectionChanged;
  270. end;
  271. procedure TDSFieldsEditorFrm.UnselectAllActnExecute(Sender: TObject);
  272. begin
  273. DoSelected(False);
  274. SelectionChanged;
  275. end;
  276. procedure TDSFieldsEditorFrm.DoSelected(All: boolean);
  277. var i: integer;
  278. begin
  279. for i := 0 to FieldsListBox.Items.Count - 1 do begin
  280. FieldsListBox.Items[i] := (FieldsListBox.Items.Objects[i] as TField).FieldName;
  281. FieldsListBox.Selected[i] := All;
  282. end;
  283. end;
  284. procedure TDSFieldsEditorFrm.SelectionChanged;
  285. var SelList: TPersistentSelectionList;
  286. begin
  287. GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
  288. try
  289. SelList := TPersistentSelectionList.Create;
  290. try
  291. OnGetSelection(SelList);
  292. FDesigner.PropertyEditorHook.SetSelection(SelList) ;
  293. finally
  294. SelList.Free;
  295. end;
  296. finally
  297. GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
  298. end;
  299. end;
  300. procedure TDSFieldsEditorFrm.OnComponentRenamed(AComponent: TComponent);
  301. var Field: TField;
  302. i: integer;
  303. begin
  304. if AComponent is TField then begin
  305. Field := TField(AComponent);
  306. if not Assigned( Field ) then Exit;
  307. i := FieldsListBox.Items.IndexOfObject(Field);
  308. if i >= 0 then
  309. FieldsListBox.Items[i] := Field.FieldName;
  310. end else
  311. if AComponent is TDataset And (AComponent = LinkDataset) then
  312. Caption := fesFeTitle + ' - ' + LinkDataset.Name;
  313. end;
  314. procedure TDSFieldsEditorFrm.OnPersistentDeleting(APersistent: TPersistent);
  315. var i: integer;
  316. begin
  317. if APersistent = LinkDataset then begin
  318. // removing all fields here ?
  319. end else begin
  320. i := FieldsListBox.Items.IndexOfObject(APersistent as TObject);
  321. if i >= 0 then FieldsListBox.Items.Delete( i );
  322. end;
  323. end;
  324. procedure TDSFieldsEditorFrm.OnGetSelection(
  325. const ASelection: TPersistentSelectionList);
  326. var i: integer;
  327. begin
  328. if Not Assigned(ASelection) then exit;
  329. if ASelection.Count > 0 then ASelection.Clear;
  330. for i := 0 to FieldsListBox.Items.Count - 1 do
  331. if FieldsListBox.Selected[i] then
  332. ASelection.Add(TPersistent(FieldsListBox.Items.Objects[i]));
  333. end;
  334. procedure TDSFieldsEditorFrm.OnSetSelection(
  335. const ASelection: TPersistentSelectionList);
  336. var i, j: integer;
  337. begin
  338. if Assigned(ASelection) then begin
  339. //Unselect all
  340. DoSelected(False);
  341. //select from list
  342. for i := 0 to ASelection.Count - 1 do
  343. if ASelection.Items[i] is TField then begin
  344. j := FieldsListBox.Items.IndexOfObject(ASelection.Items[i]);
  345. if j >= 0 then FieldsListBox.Selected[j] := True;
  346. end;
  347. end;
  348. end;
  349. procedure TDSFieldsEditorFrm.OnPersistentAdded(APersistent: TPersistent;
  350. Select: boolean);
  351. var i: integer;
  352. begin
  353. if Assigned(APersistent) And
  354. (APersistent is TField) And
  355. ((APersistent as TField).DataSet = LinkDataset) then begin
  356. i := FieldsListBox.Items.AddObject( TField(APersistent).FieldName, APersistent );
  357. FieldsListBox.Selected[i] := Select;
  358. TField(APersistent).Index := i;
  359. end;
  360. end;
  361. { TFieldsComponentEditor }
  362. constructor TFieldsComponentEditor.Create(AComponent: TComponent;
  363. ADesigner: TComponentEditorDesigner);
  364. begin
  365. inherited Create(AComponent, ADesigner);
  366. fWindowClosed := True;
  367. end;
  368. destructor TFieldsComponentEditor.Destroy;
  369. begin
  370. if not fWindowClosed
  371. then FreeThenNil(FFieldsEditorForm);
  372. inherited Destroy;
  373. end;
  374. function TFieldsComponentEditor.GetVerbCount: Integer;
  375. begin
  376. Result := 1;
  377. end;
  378. function TFieldsComponentEditor.GetVerb(Index: Integer): string;
  379. begin
  380. case Index of
  381. 0: Result := fesFeTitle;
  382. end;
  383. end;
  384. procedure TFieldsComponentEditor.ExecuteVerb(Index: Integer);
  385. var ADataset: TDataset;
  386. begin
  387. case index of
  388. 0: begin
  389. ADataset := GetComponent as TDataset;
  390. if ADataset = nil
  391. then raise Exception.Create('TFieldsComponentEditor.Edit LinkDataset=nil');
  392. if fWindowClosed then begin
  393. FFieldsEditorForm := TDSFieldsEditorFrm.Create(Application, ADataset, Designer);
  394. fWindowClosed := False;
  395. end;
  396. with FFieldsEditorForm do begin
  397. ComponentEditor := Self;
  398. ShowOnTop;
  399. end;
  400. end;
  401. end;
  402. end;
  403. procedure TFieldsComponentEditor.EditorWindowClose;
  404. begin
  405. fWindowClosed := True;
  406. FFieldsEditorForm:=nil;
  407. end;
  408. initialization
  409. {$I fieldseditor.lrs}
  410. RegisterComponentEditor(TDataset, TFieldsComponentEditor);
  411. {$ELSE The FCL of FPC 2.0 does not support this}
  412. implementation
  413. {$ENDIF}
  414. end.