1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 }
21 unit ComponentPalette_Options;
22 
23 {$mode objfpc}{$H+}
24 
25 interface
26 
27 uses
28   Classes, SysUtils,
29   // LCL
30   LCLProc, LCLType, Forms, Controls, StdCtrls, ComCtrls, ExtCtrls,
31   Dialogs, Buttons, Menus, Graphics,
32   // LazControls
33   DividerBevel,
34   // LazUtils
35   FileUtil, Laz2_XMLCfg, ImgList,
36   // IdeIntf
37   IDEOptionsIntf, IDEOptEditorIntf, IDEImagesIntf, FormEditingIntf, ComponentReg,
38   // IDE
39   EnvironmentOpts, LazarusIDEStrConsts, IDEOptionDefs, PackageDefs;
40 
41 type
42 
43   { TCompPaletteOptionsFrame }
44 
45   TCompPaletteOptionsFrame = class(TAbstractIDEOptionsEditor)
46     AddPageButton: TBitBtn;
47     cbPaletteVisible: TCheckBox;
48     ImportButton: TBitBtn;
49     ComponentsListView: TListView;
50     CompMoveDownBtn: TSpeedButton;
51     DeleteMenuItem: TMenuItem;
52     RenameMenuItem: TMenuItem;
53     PagesPopupMenu: TPopupMenu;
54     ExportButton: TBitBtn;
55     ImportDividerBevel: TDividerBevel;
56     ImportDialog: TOpenDialog;
57     PageMoveDownBtn: TSpeedButton;
58     CompMoveUpBtn: TSpeedButton;
59     PageMoveUpBtn: TSpeedButton;
60     PagesListBox: TListBox;
61     ComponentsGroupBox: TGroupBox;
62     PagesGroupBox: TGroupBox;
63     RestoreButton: TBitBtn;
64     ExportDialog: TSaveDialog;
65     Splitter1: TSplitter;
66     procedure AddPageButtonClick(Sender: TObject);
67     procedure ComponentsListViewChange(Sender: TObject; Item: TListItem;
68       {%H-}Change: TItemChange);
69     procedure ComponentsListViewClick(Sender: TObject);
70     procedure ComponentsListViewCustomDraw(Sender: TCustomListView;
71       const {%H-}ARect: TRect; var {%H-}DefaultDraw: Boolean);
72     procedure ComponentsListViewCustomDrawItem(Sender: TCustomListView;
73       Item: TListItem; {%H-}State: TCustomDrawState; var {%H-}DefaultDraw: Boolean);
74     procedure ComponentsListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
75     procedure ComponentsListViewDragOver(Sender, Source: TObject; {%H-}X, {%H-}Y: Integer;
76       {%H-}State: TDragState; var Accept: Boolean);
77     procedure ComponentsListViewItemChecked(Sender: TObject; {%H-}Item: TListItem);
78     procedure ComponentsListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
79     procedure CompMoveDownBtnClick(Sender: TObject);
80     procedure ImportButtonClick(Sender: TObject);
81     procedure ExportButtonClick(Sender: TObject);
82     procedure PageMoveDownBtnClick(Sender: TObject);
83     procedure CompMoveUpBtnClick(Sender: TObject);
84     procedure PageMoveUpBtnClick(Sender: TObject);
85     procedure PagesListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
86     procedure PagesListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
87       {%H-}State: TDragState; var Accept: Boolean);
88     procedure PagesListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
89     procedure PagesListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
90     procedure PagesPopupMenuPopup(Sender: TObject);
91     procedure RestoreButtonClick(Sender: TObject);
92     procedure DeleteMenuItemClick(Sender: TObject);
93     procedure RenameMenuItemClick(Sender: TObject);
94   private
95     fLocalOptions: TCompPaletteOptions;
96     fLocalUserOrder: TCompPaletteUserOrder;
97     fDialog: TAbstractOptionsEditorDialog;
98     fPrevPageIndex: Integer;
99     fConfigChanged: Boolean;
100     procedure ActualReadSettings;
101     procedure ActualWriteSettings(cpo: TCompPaletteOptions);
102     procedure AddOrRenamePage(aItemIndex: Integer);
OrigPageExistsnull103     function OrigPageExists(aStr: string): Boolean;
PageExistsnull104     function PageExists(aStr: string): Boolean;
105     procedure WritePages(cpo: TCompPaletteOptions);
106     procedure WriteComponents(cpo: TCompPaletteOptions);
107     procedure FillPages;
108     procedure InitialComps(aPageInd: Integer; aCompList: TStringList);
109     procedure FillComponents(aPageName: string);
110     procedure MarkAsChanged;
111     procedure UpdatePageMoveButtons(ListIndex: integer);
112     procedure UpdateCompMoveButtons(ListIndex: integer);
113   public
114     constructor Create(AOwner: TComponent); override;
115     destructor Destroy; override;
GetTitlenull116     function GetTitle: String; override;
117     procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
118     procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
119     procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
SupportedOptionsClassnull120     class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
121   public
122     property ConfigChanged: Boolean read fConfigChanged;
123   end;
124 
125 implementation
126 
127 uses MainBar;
128 
129 {$R *.lfm}
130 
131 { TCompPaletteOptionsFrame }
132 
TCompPaletteOptionsFrame.GetTitlenull133 function TCompPaletteOptionsFrame.GetTitle: String;
134 begin
135   Result := lisMenuViewComponentPalette;
136 end;
137 
138 constructor TCompPaletteOptionsFrame.Create(AOwner: TComponent);
139 begin
140   inherited Create(AOwner);
141   fLocalOptions:=TCompPaletteOptions.Create;
142   fLocalUserOrder:=TCompPaletteUserOrder.Create(IDEComponentPalette);
143 end;
144 
145 destructor TCompPaletteOptionsFrame.Destroy;
146 var
147   i: Integer;
148 begin
149   fLocalUserOrder.Free;
150   fLocalOptions.Free;
151   for i := 0 to PagesListBox.Count-1 do
152     PagesListBox.Items.Objects[i].Free;     // Free the contained StringList.
153   inherited Destroy;
154 end;
155 
156 procedure TCompPaletteOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
157 begin
158   fDialog := ADialog;
159   cbPaletteVisible.Caption := lisCmpPaletteVisible;
160   // Component pages
161   PagesGroupBox.Caption := lisCmpPages;
162   AddPageButton.Caption := lisBtnDlgAdd;
163   IDEImages.AssignImage(AddPageButton, 'laz_add');
164   RestoreButton.Caption := lisCmpRestoreDefaults;
165   IDEImages.AssignImage(RestoreButton, 'restore_defaults');
166   ImportDividerBevel.Caption := lisExportImport;
167   IDEImages.AssignImage(ImportButton, 'laz_open');
168   ImportButton.Caption := lisDlgImport;
169   IDEImages.AssignImage(ExportButton, 'laz_save');
170   ExportButton.Caption := lisDlgExport;
171   // File dialogs
172   ImportDialog.Title := lisImport;
173   ImportDialog.Filter := Format('%s|*.xml|%s|%s|', [dlgFilterXML, dlgFilterAll, GetAllFilesMask]);
174   ExportDialog.Title := lisExport;
175   ExportDialog.Filter := ImportDialog.Filter;
176   // Components in one page
177   ComponentsGroupBox.Caption := lisCmpLstComponents;
178   ComponentsListView.Column[1].Caption := lisName;
179   ComponentsListView.Column[2].Caption := lisPage;
180   ComponentsListView.Column[3].Caption := lisUnit;
181   ComponentsListView.SmallImages := IDEImages.Images_24;
182   // Arrow buttons for pages
183   IDEImages.AssignImage(PageMoveUpBtn, 'arrow_up');
184   IDEImages.AssignImage(PageMoveDownBtn, 'arrow_down');
185   PageMoveUpBtn.Hint := lisMoveSelectedUp;
186   PageMoveDownBtn.Hint := lisMoveSelectedDown;
187   // Arrow buttons for components
188   IDEImages.AssignImage(CompMoveUpBtn, 'arrow_up');
189   IDEImages.AssignImage(CompMoveDownBtn, 'arrow_down');
190   CompMoveUpBtn.Hint := lisMoveSelectedUp;
191   CompMoveDownBtn.Hint := lisMoveSelectedDown;
192 
193   fPrevPageIndex := -1;
194   UpdatePageMoveButtons(PagesListBox.ItemIndex);
195   UpdateCompMoveButtons(ComponentsListView.ItemIndex);
196 end;
197 
198 procedure TCompPaletteOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
199 var
200   Opts: TCompPaletteOptions;
201 begin
202   Opts := (AOptions as TEnvironmentOptions).Desktop.ComponentPaletteOptions;
203   fLocalOptions.Assign(Opts);
204   fLocalUserOrder.Options := fLocalOptions;
205   cbPaletteVisible.Checked := Opts.Visible;
206   ActualReadSettings;
207 end;
208 
209 procedure TCompPaletteOptionsFrame.ActualReadSettings;
210 begin
211   Assert(fLocalUserOrder.Options = fLocalOptions, 'fLocalUserOrder.Options <> fLocalOptions');
212   fLocalUserOrder.SortPagesAndCompsUserOrder;
213   FillPages;
214   // Initial enabled-state for buttons.
215   RestoreButton.Enabled := not fLocalOptions.IsDefault;
216   ExportButton.Enabled := RestoreButton.Enabled;
217 end;
218 
219 procedure TCompPaletteOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
220 var
221   Opts: TCompPaletteOptions;
222 begin
223   Opts := (AOptions as TEnvironmentOptions).Desktop.ComponentPaletteOptions;
224   Opts.Visible := cbPaletteVisible.Checked;
225   MainIDEBar.DoSetViewComponentPalette(cbPaletteVisible.Checked);
226   if not fConfigChanged then Exit;
227   ActualWriteSettings(Opts);
228   IDEComponentPalette.Update(True);
229   IDEComponentPalette.IncChangeStamp;
230 end;
231 
232 procedure TCompPaletteOptionsFrame.ActualWriteSettings(cpo: TCompPaletteOptions);
233 begin
234   WritePages(cpo);
235   WriteComponents(cpo);
236 end;
237 
238 procedure TCompPaletteOptionsFrame.WritePages(cpo: TCompPaletteOptions);
239 var
240   OrigPages, UserPages: TStringList;
241   i: Integer;
242 begin
243   Assert(Assigned(IDEComponentPalette),
244     'TCompPaletteOptionsFrame.WritePages: IDEComponentPalette is not assigned.');
245   OrigPages := TStringList.Create;
246   UserPages := TStringList.Create;
247   try
248     // Collect original page names
249     for i := 0 to IDEComponentPalette.OrigPagePriorities.Count-1 do
250       OrigPages.Add(IDEComponentPalette.OrigPagePriorities.Keys[i]);
251     // Collect user defined page names
252     for i := 1 to PagesListBox.Items.Count-1 do     // Skip "all components" page
253       UserPages.Add(PagesListBox.Items[i]);
254     // If user made changes, store all page names to options
255     if OrigPages.Equals(UserPages) then
256       cpo.PageNames.Clear
257     else
258       cpo.PageNames.Assign(UserPages);
259   finally
260     UserPages.Free;
261     OrigPages.Free;
262   end;
263 end;
264 
265 procedure TCompPaletteOptionsFrame.WriteComponents(cpo: TCompPaletteOptions);
266 var
267   UserComps, OrigComps: TStringList;
268   PgName: String;
269   i: Integer;
270 begin
271   OrigComps := TStringList.Create;
272   try
273     cpo.PageNamesCompNames.Clear;
274     for i := 1 to PagesListBox.Count-1 do      // Skip "all components" page
275     begin
276       PgName := PagesListBox.Items[i];
277       UserComps := PagesListBox.Items.Objects[i] as TStringList;
278       Assert(Assigned(UserComps), 'TCompPaletteOptionsFrame.WriteComponents: No UserComps for '+PgName);
279       // Collect original visible components from this page.
280       IDEComponentPalette.AssignOrigVisibleCompNames(PgName, OrigComps);
281       // Differs from original order -> add configuration for components.
282       if (OrigComps.Count=0) or not OrigComps.Equals(UserComps) then
283         cpo.AssignPageCompNames(PgName, UserComps);
284     end;
285   finally
286     OrigComps.Free;
287   end;
288 end;
289 
290 procedure TCompPaletteOptionsFrame.FillPages;
291 // Collect all available components (excluding hidden)
292 var
293   CompList: TStringList;
294   i: Integer;
295   PgName: String;
296 begin
297   // First clear existing items and add <All> page.
298   PagesListBox.Items.BeginUpdate;
299   for i := 0 to PagesListBox.Items.Count-1 do
300     PagesListBox.Items.Objects[i].Free;
301   PagesListBox.Clear;
302   PagesListBox.Items.Add(lis_All_);
303   // then add all pages
304   for i := 0 to fLocalUserOrder.ComponentPages.Count-1 do
305   begin
306     PgName := fLocalUserOrder.ComponentPages[i];
307     Assert(PgName<>'', 'TCompPaletteOptionsFrame.FillPages: PageName is empty.');
308     CompList := TStringList.Create; // StringList will hold components for this page.
309     InitialComps(i, CompList);
310     PagesListBox.AddItem(PgName, CompList);
311   end;
312   PagesListBox.ItemIndex := 0;     // Activate first item
313   PagesListBox.Items.EndUpdate;
314 end;
315 
316 procedure TCompPaletteOptionsFrame.InitialComps(aPageInd: Integer; aCompList: TStringList);
317 var
318   OrderedComps: TRegisteredCompList;
319   Comp: TRegisteredComponent;
320   i: Integer;
321 begin
322   OrderedComps := fLocalUserOrder.ComponentPages.Objects[aPageInd] as TRegisteredCompList;
323   for i := 0 to OrderedComps.Count-1 do
324   begin
325     Comp := OrderedComps[i];
326     if Assigned(Comp) and Comp.Visible then
327       aCompList.AddObject(Comp.ComponentClass.ClassName, Comp);
328   end;
329 end;
330 
331 procedure TCompPaletteOptionsFrame.FillComponents(aPageName: string);
332 var
333   Comp: TRegisteredComponent;
334   Item: TListItem;
335   CompList: TStringList;
336   PageCnt, CompCnt: Integer;
337   StartInd, EndInd: Integer;
338   RealPageName, CompName: String;
339   bListAll : Boolean;
340   TempWidth, NameWidth, PageWidth, UnitWidth : Integer;
341 begin
342   bListAll := aPageName = lis_All_;
343   if bListAll then
344   begin
345     NameWidth := 50;
346     PageWidth := 50;
347     UnitWidth := 50;
348     StartInd := 1;                // Skip the first entry for all components.
349     EndInd := PagesListBox.Count-1;
350   end
351   else begin
352     StartInd := PagesListBox.Items.IndexOf(aPageName);
353     EndInd := StartInd;
354   end;
355   ComponentsListView.Items.BeginUpdate;
356   ComponentsListView.Items.Clear;
357   for PageCnt := StartInd to EndInd do
358   begin
359     RealPageName := PagesListBox.Items[PageCnt];
360     CompList := PagesListBox.Items.Objects[PageCnt] as TStringList;
361     for CompCnt := 0 to CompList.Count-1 do
362     begin
363       CompName := CompList[CompCnt];
364       Comp := CompList.Objects[CompCnt] as TRegisteredComponent;
365       Item := ComponentsListView.Items.Add;
366       Item.SubItems.Add(CompName);
367       Item.SubItems.Add(RealPageName);
368       Item.SubItems.Add(Comp.GetUnitName);
369       Item.Data := Comp;
370       if bListAll then
371       begin
372         TempWidth := 20 + ComponentsListView.Canvas.GetTextWidth(CompName);
373         if TempWidth > NameWidth then NameWidth := TempWidth;
374         TempWidth := 20 + ComponentsListView.Canvas.GetTextWidth(RealPageName);
375         if TempWidth > PageWidth then PageWidth := TempWidth;
376         TempWidth := 20 + ComponentsListView.Canvas.GetTextWidth(Comp.GetUnitName);
377         if TempWidth > UnitWidth then UnitWidth := TempWidth;
378       end;
379     end;
380   end;
381   if bListAll then
382   begin
383     // Setting Width:=0 is needed at least on Windows. TListView refuses to set
384     // a column width which was set previously, even if user has adjusted it since.
385     ComponentsListView.Column[1].Width := 0;
386     ComponentsListView.Column[1].Width := NameWidth;
387     ComponentsListView.Column[2].Width := 0;
388     ComponentsListView.Column[2].Width := PageWidth;
389     ComponentsListView.Column[3].Width := 0;
390     ComponentsListView.Column[3].Width := UnitWidth;
391   end;
392   ComponentsListView.Items.EndUpdate;
393 end;
394 
395 procedure TCompPaletteOptionsFrame.PagesListBoxSelectionChange(Sender: TObject; User: boolean);
396 var
397   lb: TListBox;
398 begin
399   lb := Sender as TListBox;
400   if lb.ItemIndex = fPrevPageIndex then Exit;
401   FillComponents(lb.Items[lb.ItemIndex]);
402   UpdatePageMoveButtons(lb.ItemIndex);
403   UpdateCompMoveButtons(-1);
404   fPrevPageIndex := lb.ItemIndex;
405 end;
406 
TCompPaletteOptionsFrame.OrigPageExistsnull407 function TCompPaletteOptionsFrame.OrigPageExists(aStr: string): Boolean;
408 var
409   i: Integer;
410 begin
411   for i := 0 to IDEComponentPalette.OrigPagePriorities.Count-1 do
412     if SameText(aStr, IDEComponentPalette.OrigPagePriorities.Keys[i]) then
413       Exit(True);
414   Result := False;
415 end;
416 
PageExistsnull417 function TCompPaletteOptionsFrame.PageExists(aStr: string): Boolean;
418 var
419   i: Integer;
420 begin
421   for i := 0 to PagesListBox.Count-1 do
422     if SameText(aStr, PagesListBox.Items[i]) then
423       Exit(True);
424   Result := False;
425 end;
426 
427 procedure TCompPaletteOptionsFrame.AddOrRenamePage(aItemIndex: Integer);
428 var
429   Def, NewName: String;
430 begin
431   if aItemIndex = -1 then
432     Def := ''
433   else
434     Def := PagesListBox.Items[aItemIndex];
435   NewName := InputBox(lisNewPage, lisPageName, Def);
436   if NewName = Def then Exit;
437   if PageExists(NewName) then begin
438     ShowMessage(Format(lisPageNameAlreadyExists, [NewName]));
439     Exit;
440   end;
441   if aItemIndex = -1 then
442     PagesListBox.AddItem(NewName, TStringList.Create)  // Add a new page
443   else
444     PagesListBox.Items[aItemIndex] := NewName;         // Rename an existing page
445   MarkAsChanged;
446 end;
447 
448 procedure TCompPaletteOptionsFrame.AddPageButtonClick(Sender: TObject);
449 begin
450   AddOrRenamePage(-1);
451 end;
452 
453 procedure TCompPaletteOptionsFrame.RestoreButtonClick(Sender: TObject);
454 begin
455   fLocalOptions.Clear;
456   fLocalUserOrder.SortPagesAndCompsUserOrder; // Only updates data structure.
457   FillPages;
458   RestoreButton.Enabled := False;
459   ExportButton.Enabled := False;
460   fConfigChanged := True;
461 end;
462 
463 // Drag-drop PagesListBox
464 
465 procedure TCompPaletteOptionsFrame.PagesListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
466 var
467   lb: TListBox;
468   DestInd: integer;
469 
470   procedure DoInsideListBox;
471   begin
472     Assert(Source = Sender, 'TCompPaletteOptionsFrame.PagesListBoxDragDrop: Source and Sender ListBoxes differ.');
473     //DebugLn(['TCompPaletteOptionsFrame.PagesListBoxDragDrop: DestInd=',DestInd,', ItemIndex=',lb.ItemIndex]);
474     if lb.ItemIndex < DestInd then
475       Dec(DestInd);
476     if (lb.ItemIndex > 0) and (lb.ItemIndex <> DestInd) then
477     begin
478       lb.Items.Move(lb.ItemIndex, DestInd);
479       lb.ItemIndex := DestInd;
480       MarkAsChanged;
481     end;
482   end;
483 
484   procedure DoFromListView(aSrcView: TListView);
485   var
486     Item: TListItem;
487     SrcComps, DestComps: TStringList;
488     xComp: TObject; // Actually TRegisteredComponent;
489     CompName, SrcPage, DestPage: String;
490     OrigInd, Ind: integer;
491   begin
492     OrigInd := 0;
493     While OrigInd <= aSrcView.Items.Count-1 do
494     begin
495       // Move possibly many selected items
496       if aSrcView.Items[OrigInd].Selected then
497       begin
498         Item := aSrcView.Items[OrigInd];
499         CompName := Item.SubItems[0];
500         SrcPage := Item.SubItems[1];
501         DestPage := lb.Items[DestInd];
502         if SrcPage <> DestPage then
503         begin
504           // Source component
505           Ind := lb.Items.IndexOf(SrcPage);
506           Assert(Ind > -1, 'TCompPaletteOptionsFrame.PagesListBoxDragDrop: '
507                              +'source page index not found.');
508           SrcComps := lb.Items.Objects[Ind] as TStringList;
509           Ind := SrcComps.IndexOf(CompName);
510           Assert(Ind > -1, 'TCompPaletteOptionsFrame.PagesListBoxDragDrop: '
511                              +'source component index not found.');
512           xComp := SrcComps.Objects[Ind];
513           SrcComps.Delete(Ind);
514           // Destination component
515           Ind := lb.Items.IndexOf(DestPage);
516           Assert(Ind > -1, 'TCompPaletteOptionsFrame.PagesListBoxDragDrop: '
517                               +'destination page index not found.');
518           DestComps := lb.Items.Objects[Ind] as TStringList;
519           Ind := DestComps.IndexOf(CompName);
520           Assert(Ind = -1, 'TCompPaletteOptionsFrame.PagesListBoxDragDrop: '
521                              +'source component index already found.');
522           DestComps.AddObject(CompName, xComp);
523           // Delete the original item from ListView
524           aSrcView.Items.Delete(OrigInd);
525         end;
526         //DebugLn(['TCompPaletteOptionsFrame.PagesListBoxDragDrop: CompName=',
527         //         CompName, ', SrcPage=', SrcPage, ', DestPage=', DestPage]);
528       end;
529       inc(OrigInd);
530     end;
531     MarkAsChanged;
532   end;
533 
534 begin
535   lb := Sender as TListBox;
536   DestInd := lb.ItemAtPos(Point(X, Y), true);
537   if DestInd > 0 then
538   begin
539     if Source is TListBox then
540       DoInsideListBox
541     else if Source is TListView then
542       DoFromListView(TListView(Source));
543   end;
544 end;
545 
546 procedure TCompPaletteOptionsFrame.PagesListBoxDragOver(Sender,
547   Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
548 var
549   DestPt: TPoint;
550   DestInd: integer;
551   lb: TListBox;
552 begin
553   lb := Sender as TListBox;
554   DestPt := Point(X, Y);
555   DestInd := lb.ItemAtPos(DestPt, true);
556   Accept := (DestInd > 0)
557       and ( ( (Source is TListBox) and (Source = Sender) and (lb.ItemIndex > 0)
558             ) or (Source is TListView) );
559 end;
560 
561 // Drag-drop ComponentsListView
562 
563 procedure TCompPaletteOptionsFrame.ComponentsListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
564 var
565   lv: TListView;
566   SrcInd, DstInd: Integer;
567   SrcItem, DstItem: TListItem;
568   Comps: TStringList;
569 begin
570   lv := Sender as TListView;
571   DstItem := lv.GetItemAt(X, Y);
572   SrcItem := lv.Selected;
573   if (DstItem = nil) or (SrcItem = nil) then exit;
574   DstInd := DstItem.Index;
575   SrcInd := SrcItem.Index;
576   Assert(Source = Sender, 'TCompPaletteOptionsFrame.ComponentsListViewDragDrop: Source and Sender ListViews differ.');
577   //DebugLn(['TCompPaletteOptionsFrame.ComponentsListViewDragDrop: DestInd=',DstInd,', ItemIndex=',SrcInd]);
578   if SrcInd < DstInd then
579     Dec(DstInd);
580   if (SrcInd > -1) and (DstInd > -1) and (SrcInd <> DstInd) then
581   begin
582     // Move component names in ListView.
583     lv.Selected := Nil;
584     lv.Items.Move(SrcInd, DstInd);
585     lv.Selected := lv.Items[DstInd];
586     // Move component names inside a StringList, too.
587     Comps := PagesListBox.Items.Objects[PagesListBox.ItemIndex] as TStringList;
588     Comps.Move(SrcInd, DstInd);
589     //
590     UpdateCompMoveButtons(DstInd);
591     MarkAsChanged;
592   end;
593 end;
594 
595 procedure TCompPaletteOptionsFrame.ComponentsListViewDragOver(Sender,
596   Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
597 begin
598   Accept := (Source is TListView) and (Source = Sender)
599     and (PagesListBox.ItemIndex > 0);  // No dragging when <All> components is selected.
600 end;
601 
602 procedure TCompPaletteOptionsFrame.ComponentsListViewChange(Sender: TObject;
603   Item: TListItem; Change: TItemChange);
604 begin
605   if Item.Selected then
606     UpdateCompMoveButtons(ComponentsListView.Items.IndexOf(Item));
607 end;
608 
609 procedure TCompPaletteOptionsFrame.ComponentsListViewClick(Sender: TObject);
610 begin
611   //DebugLn(['TCompPaletteOptionsFrame.ComponentsListViewClick: ']);
612 end;
613 
614 procedure TCompPaletteOptionsFrame.ComponentsListViewItemChecked(Sender: TObject; Item: TListItem);
615 begin
616   ;
617 end;
618 
619 // Draw ComponentsListView
620 
621 procedure TCompPaletteOptionsFrame.ComponentsListViewCustomDraw(Sender: TCustomListView;
622   const ARect: TRect; var DefaultDraw: Boolean);
623 begin
624   //DebugLn(['TCompPaletteOptionsFrame.ComponentsListViewCustomDraw: DefaultDraw=', DefaultDraw]);
625 end;
626 
627 procedure TCompPaletteOptionsFrame.ComponentsListViewCustomDrawItem(Sender: TCustomListView;
628   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
629 var
630   Comp: TRegisteredComponent;
631   ARect: TRect;
632   IL: TCustomImageList;
633   II: TImageIndex;
634   Res: TScaledImageListResolution;
635 begin
636   Comp := TRegisteredComponent(Item.Data);
637   ARect := Item.DisplayRect(drIcon);
638   if Comp is TPkgComponent then begin
639     IL := TPkgComponent(Comp).Images;
640     II := TPkgComponent(Comp).ImageIndex;
641     if (IL<>nil) and (II>=0) then
642     begin
643       Res := IL.ResolutionForControl[0, Sender];
644       Res.Draw(Sender.Canvas,
645                ARect.Left,
646                ARect.Top+(ARect.Bottom-ARect.Top-Res.Height) div 2, II);
647     end;
648   end;
649 end;
650 
651 // Page move up / down
652 
653 procedure TCompPaletteOptionsFrame.PagesListBoxKeyDown(Sender: TObject;
654   var Key: Word; Shift: TShiftState);
655 begin
656   if (ssCtrl in Shift ) and ((Key = VK_UP) or (Key = VK_DOWN)) then begin
657     if Key = VK_UP then
658       PageMoveUpBtnClick(nil)
659     else
660       PageMoveDownBtnClick(nil);
661     Key:=VK_UNKNOWN;
662   end;
663 end;
664 
665 procedure TCompPaletteOptionsFrame.PageMoveUpBtnClick(Sender: TObject);
666 var
667   i: Integer;
668 begin
669   i := PagesListBox.ItemIndex;
670   if i > 1 then
671   begin
672     PagesListBox.Items.Exchange(i, i-1);
673     PagesListBox.ItemIndex := i-1;
674     UpdatePageMoveButtons(i-1);
675     MarkAsChanged;
676   end;
677 end;
678 
679 procedure TCompPaletteOptionsFrame.PageMoveDownBtnClick(Sender: TObject);
680 var
681   i: Integer;
682 begin
683   i := PagesListBox.ItemIndex;
684   if (i > 0) and (i < PagesListBox.Count-1) then
685   begin
686     PagesListBox.Items.Exchange(i, i+1);
687     PagesListBox.ItemIndex := i+1;
688     UpdatePageMoveButtons(i+1);
689     MarkAsChanged;
690   end;
691 end;
692 
693 // Component move up / down
694 
695 procedure TCompPaletteOptionsFrame.ComponentsListViewKeyDown(Sender: TObject;
696   var Key: Word; Shift: TShiftState);
697 begin
698   if (ssCtrl in Shift ) and ((Key = VK_UP) or (Key = VK_DOWN)) then begin
699     if Key = VK_UP then
700       CompMoveUpBtnClick(nil)
701     else
702       CompMoveDownBtnClick(nil);
703     Key:=VK_UNKNOWN;
704   end;
705 end;
706 
707 procedure TCompPaletteOptionsFrame.CompMoveUpBtnClick(Sender: TObject);
708 var
709   i: Integer;
710 begin
711   i := ComponentsListView.ItemIndex;
712   if i > 0 then
713   begin
714     ComponentsListView.Selected := Nil;
715     ComponentsListView.Items.Exchange(i, i-1);
716     ComponentsListView.Selected := ComponentsListView.Items[i-1];
717     UpdateCompMoveButtons(i-1);
718     MarkAsChanged;
719   end;
720 end;
721 
722 procedure TCompPaletteOptionsFrame.CompMoveDownBtnClick(Sender: TObject);
723 var
724   i: Integer;
725 begin
726   i := ComponentsListView.ItemIndex;
727   if (i > -1) and (i < ComponentsListView.Items.Count-1) then
728   begin
729     ComponentsListView.Selected := Nil;
730     ComponentsListView.Items.Exchange(i, i+1);
731     ComponentsListView.Selected := ComponentsListView.Items[i+1];
732     UpdateCompMoveButtons(i+1);
733     MarkAsChanged;
734   end;
735 end;
736 
737 procedure TCompPaletteOptionsFrame.MarkAsChanged;
738 begin
739   // ToDo: compare settings with original palette options after each change.
740   RestoreButton.Enabled := True;
741   ExportButton.Enabled := True;
742   fConfigChanged := True;
743 end;
744 
745 procedure TCompPaletteOptionsFrame.UpdatePageMoveButtons(ListIndex: integer);
746 begin
747   //DebugLn(['TCompPaletteOptionsFrame.UpdatePageMoveButtons: Page index=', ListIndex]);
748   if (ListIndex > 0) and (ListIndex < PagesListBox.Items.Count) then
749   begin
750     PageMoveUpBtn.Enabled := ListIndex > 1;
751     PageMoveDownBtn.Enabled := ListIndex < PagesListBox.Items.Count-1;
752   end
753   else begin
754     PageMoveUpBtn.Enabled := False;
755     PageMoveDownBtn.Enabled := False;
756   end;
757 end;
758 
759 procedure TCompPaletteOptionsFrame.UpdateCompMoveButtons(ListIndex: integer);
760 begin
761   //DebugLn(['TCompPaletteOptionsFrame.UpdateCompMoveButtons: Component index=', ListIndex]);
762   if (ListIndex > -1) and (ListIndex < ComponentsListView.Items.Count)
763   and (PagesListBox.ItemIndex > 0) then  // No moving when <All> components is selected.
764   begin
765     CompMoveUpBtn.Enabled := ListIndex > 0;
766     CompMoveDownBtn.Enabled := ListIndex < ComponentsListView.Items.Count-1;
767   end
768   else begin
769     CompMoveUpBtn.Enabled := False;
770     CompMoveDownBtn.Enabled := False;
771   end;
772 end;
773 
774 procedure TCompPaletteOptionsFrame.PagesPopupMenuPopup(Sender: TObject);
775 var
776   IsNew, IsEmpty: Boolean;
777 begin
778   if (PagesListBox.ItemIndex > 0) and (PagesListBox.ItemIndex < PagesListBox.Count) then
779     IsNew := not OrigPageExists(PagesListBox.Items[PagesListBox.ItemIndex])
780   else
781     IsNew := False;
782   if IsNew then
783     IsEmpty := (PagesListBox.Items.Objects[PagesListBox.ItemIndex] as TStringList).Count = 0
784   else
785     IsEmpty := False;
786   RenameMenuItem.Enabled := IsNew;
787   DeleteMenuItem.Enabled := IsEmpty;
788 end;
789 
790 procedure TCompPaletteOptionsFrame.DeleteMenuItemClick(Sender: TObject);
791 begin
792   PagesListBox.Items.Delete(PagesListBox.ItemIndex);
793 end;
794 
795 procedure TCompPaletteOptionsFrame.RenameMenuItemClick(Sender: TObject);
796 begin
797   Assert((PagesListBox.ItemIndex > 0) and (PagesListBox.ItemIndex < PagesListBox.Count));
798   AddOrRenamePage(PagesListBox.ItemIndex);
799 end;
800 
OpenXMLnull801 function OpenXML(const Filename: string): TXMLConfig;
802 begin
803   try
804     Result := TXMLConfig.Create(Filename);
805   except
806     on E: Exception do begin
807       MessageDlg(lisIECOErrorOpeningXml,
808         Format(lisIECOErrorOpeningXmlFile, [Filename, LineEnding, E.Message]),
809         mtError, [mbCancel], 0);
810       Result := Nil;
811     end;
812   end;
813 end;
814 
815 procedure TCompPaletteOptionsFrame.ImportButtonClick(Sender: TObject);
816 var
817   XMLConfig: TXMLConfig;
818 begin
819   if ImportDialog.Execute then
820   begin
821     XMLConfig := OpenXML(ImportDialog.Filename);
822     if Assigned(XMLConfig) then
823     try
824       fLocalOptions.Load(XMLConfig, '');
825       ActualReadSettings;                  // Read from options to GUI.
826       ShowMessageFmt(lisSuccessfullyImported, [ImportDialog.Filename]);
827       fConfigChanged := True;
828     finally
829       XMLConfig.Free;
830     end;
831   end;
832 end;
833 
834 procedure TCompPaletteOptionsFrame.ExportButtonClick(Sender: TObject);
835 var
836   XMLConfig: TXMLConfig;
837 begin
838   if ExportDialog.Execute then
839   begin
840     XMLConfig := OpenXML(ExportDialog.Filename);
841     if Assigned(XMLConfig) then
842     try
843       ActualWriteSettings(fLocalOptions);  // Write from GUI to options.
844       fLocalOptions.Save(XMLConfig, '');
845       ShowMessageFmt(lisSuccessfullyExported, [ExportDialog.Filename]);
846     finally
847       XMLConfig.Free;
848     end;
849   end;
850 end;
851 
TCompPaletteOptionsFrame.SupportedOptionsClassnull852 class function TCompPaletteOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
853 begin
854   Result := TEnvironmentOptions;
855 end;
856 
857 initialization
858   RegisterIDEOptionsEditor(GroupEnvironment, TCompPaletteOptionsFrame, EnvOptionsCompPalette);
859 
860 end.
861 
862