1 unit opkman_intf_packagelistfrm;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8    SysUtils, Classes, laz.VirtualTrees,
9   // LCL
10   Forms, Controls, Buttons, Graphics, ExtCtrls, LCLType, ButtonPanel,
11   Menus,
12   //IDEIntf
13   PackageIntf,
14   // OpkMan
15   opkman_const, opkman_serializablepackages, opkman_options,
16   opkman_Common, opkman_maindm;
17 
18 type
19 
20   { TIntfPackageListFrm }
21 
22   TIntfPackageListFrm = class(TForm)
23     ButtonPanel1: TButtonPanel;
24     pnExpCol: TPanel;
25     pnInfo: TPanel;
26     spCollapse: TSpeedButton;
27     spExpand: TSpeedButton;
28     procedure FormCreate(Sender: TObject);
29     procedure FormDestroy(Sender: TObject);
30     procedure spCollapseClick(Sender: TObject);
31     procedure spExpandClick(Sender: TObject);
32   private
33     FVST: TLazVirtualStringTree;
34     FSortCol: Integer;
35     FSortDir: laz.VirtualTrees.TSortDirection;
36     procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
37       Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
38     procedure VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
39       {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
40       var ImageIndex: Integer);
41     procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
42       Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
43     procedure VSTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
44     procedure VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
45       var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
46     procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
47   public
48     procedure PopulateTree(APkgList: TList);
IsLazarusPackageCheckednull49     function IsLazarusPackageChecked(AName: String): Boolean;
50   end;
51 
52 var
53   IntfPackageListFrm: TIntfPackageListFrm;
54 
55 implementation
56 
57 {$R *.lfm}
58 
59 type
60   PData = ^TData;
61   TData = record
62     DataType: Integer;
63     LazarusPackageName: String;
64     Description: String;
65     Author: String;
66     LazCompatibility: String;
67     FPCCompatibility: String;
68     SupportedWidgetSet: String;
69     PackageType: TLazPackageType;
70     License: String;
71     Dependencies: String;
72     Version: String;
73     Button: TSpeedButton;
74   end;
75 
76 const
77   IMAGE_INDEX_MAP: array[0..9] of Integer = (
78     IMG_PKG_FILE, IMG_DESCRIPTION, IMG_AUTHOR,                   // 0..2
79     IMG_LAZ_COMPATIBILITY, IMG_FPC_COMPATIBILITY, IMG_WIDGETSET, // 3..5
80     IMG_PKG_TYPE, IMG_LICENSE, IMG_DEPENDENCIES,                 // 6..8
81     IMG_FILE_VERSION);                                           // 9
82 
83 { TIntfPackageListFrm }
84 
85 procedure TIntfPackageListFrm.FormCreate(Sender: TObject);
86 begin
87   Caption := rsOPMIntfPackageListFrm_Caption;
88   pnInfo.Caption := '  ' + rsOPMIntfPackageListFrm_pnInfo;
89   if not Options.UseDefaultTheme then
90     Self.Color := clBtnFace;
91   spExpand.Caption := '';
92   spExpand.Images := MainDM.Images;
93   spExpand.ImageIndex := IMG_EXPAND;
94   spCollapse.Caption := '';
95   spCollapse.Images := MainDM.Images;
96   spCollapse.ImageIndex := IMG_COLLAPSE;
97   ButtonPanel1.OKButton.Caption := rsMainFrm_TBInstall_Caption;
98   FVST := TLazVirtualStringTree.Create(nil);
99   with FVST do
100   begin
101     Parent := Self;
102     Align := alClient;
103     Anchors := [akLeft, akTop, akRight];
104     Images := MainDM.Images;
105     DefaultNodeHeight := Scale96ToForm(25);
106     Indent := Scale96ToForm(22);
107     TabOrder := 0;
108     DefaultText := '';
109     Header.AutoSizeIndex := 1;
110     Header.SortColumn := 0;
111     Header.Height := Scale96ToForm(25);
112     Colors.DisabledColor := clBlack;
113     with Header.Columns.Add do
114     begin
115       Position := 0;
116       Width := Scale96ToForm(200);
117       Text := rsOPMIntfPackageListFrm_VSTHeaderColumn_LazarusPackage;
118     end;
119     with Header.Columns.Add do
120     begin
121       Position := 1;
122       Width := Scale96ToForm(200);
123       Text := rsOPMIntfPackageListFrm_VSTHeaderColumn_Data;
124     end;
125     Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoShowSortGlyphs, hoVisible];
126     TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
127     TreeOptions.PaintOptions := [toHideFocusRect, toShowRoot, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
128     TreeOptions.SelectionOptions := [toFullRowSelect, toRightClickSelect];
129     TreeOptions.AutoOptions := [toAutoTristateTracking];
130     HintMode := hmHint;
131     ShowHint := True;
132     OnGetText := @VSTGetText;
133     OnGetImageIndex := @VSTGetImageIndex;
134     OnCompareNodes := @VSTCompareNodes;
135     OnHeaderClick := @VSTHeaderClick;
136     OnGetHint := @VSTGetHint;
137     OnFreeNode := @VSTFreeNode;
138   end;
139   FVST.NodeDataSize := SizeOf(TData);
140 end;
141 
142 procedure TIntfPackageListFrm.FormDestroy(Sender: TObject);
143 begin
144   FVST.Free;
145 end;
146 
147 procedure TIntfPackageListFrm.spCollapseClick(Sender: TObject);
148 begin
149   FVST.FullCollapse;
150 end;
151 
152 procedure TIntfPackageListFrm.spExpandClick(Sender: TObject);
153 begin
154   FVST.FullExpand;
155 end;
156 
157 procedure TIntfPackageListFrm.VSTGetText(Sender: TBaseVirtualTree;
158   Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
159   var CellText: String);
160 var
161   Data: PData;
162 begin
163   Data := FVST.GetNodeData(Node);
164   case Column of
165     0: case Data^.DataType of
166          0: CellText := Data^.LazarusPackageName;
167          1: CellText := rsMainFrm_VSTText_Description;
168          2: CellText := rsMainFrm_VSTText_Author;
169          3: CellText := rsMainFrm_VSTText_LazCompatibility;
170          4: CellText := rsMainFrm_VSTText_FPCCompatibility;
171          5: CellText := rsMainFrm_VSTText_SupportedWidgetsets;
172          6: CellText := rsMainFrm_VSTText_Packagetype;
173          7: CellText := rsMainFrm_VSTText_License;
174          8: CellText := rsMainFrm_VSTText_Dependecies;
175          9: CellText := rsMainFrm_VSTText_Version;
176        end;
177     1: case Data^.DataType of
178          0: CellText := '';
179          1: CellText := StringReplace(Data^.Description, sLineBreak, ' ', [rfReplaceAll]);
180          2: CellText := Data^.Author;
181          3: CellText := Data^.LazCompatibility;
182          4: CellText := Data^.FPCCompatibility;
183          5: CellText := Data^.SupportedWidgetSet;
184          6: CellText := GetPackageTypeString(Data^.PackageType);
185          7: CellText := StringReplace(Data^.License, sLineBreak, ' ', [rfReplaceAll]);
186          8: CellText := Data^.Dependencies;
187          9: CellText := Data^.Version;
188        end;
189   end;
190 end;
191 
192 procedure TIntfPackageListFrm.VSTGetImageIndex(Sender: TBaseVirtualTree;
193   Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
194   var Ghosted: Boolean; var ImageIndex: Integer);
195 var
196   Data: PData;
197 begin
198   Data := FVST.GetNodeData(Node);
199   if Column = 0 then
200     ImageIndex := IMAGE_INDEX_MAP[Data^.DataType];
201 end;
202 
203 procedure TIntfPackageListFrm.VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
204   Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
205 var
206   Data1: PData;
207   Data2: PData;
208 begin
209   Data1 := Sender.GetNodeData(Node1);
210   Data2 := Sender.GetNodeData(Node2);
211   if Column = 0 then
212     Result := CompareText(Data1^.LazarusPackageName, Data2^.LazarusPackageName);
213 end;
214 
215 procedure TIntfPackageListFrm.VSTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
216 begin
217   if (HitInfo.Column <> 0) and (HitInfo.Column <> 1) and (HitInfo.Column <> 3) then
218     Exit;
219   if HitInfo.Button = mbLeft then
220   begin
221     with Sender, Treeview do
222     begin
223       if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
224       begin
225         SortColumn    := HitInfo.Column;
226         SortDirection := laz.VirtualTrees.sdAscending;
227       end
228       else
229       begin
230         if SortDirection = laz.VirtualTrees.sdAscending then
231           SortDirection := laz.VirtualTrees.sdDescending
232         else
233           SortDirection := laz.VirtualTrees.sdAscending;
234         FSortDir := SortDirection;
235       end;
236       SortTree(SortColumn, SortDirection, False);
237       FSortCol := Sender.SortColumn;
238     end;
239   end;
240 end;
241 
242 procedure TIntfPackageListFrm.VSTGetHint(Sender: TBaseVirtualTree;
243   Node: PVirtualNode; Column: TColumnIndex;
244   var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
245 var
246   Data: PData;
247 begin
248   Data := FVST.GetNodeData(Node);
249   if (Column = 0) then
250     Exit;
251 
252   LineBreakStyle := hlbForceSingleLine;
253   case Data^.DataType of
254     1: HintText := Data^.Description;
255     7: HintText := Data^.License;
256    else
257      HintText := '';
258   end;
259 end;
260 
261 procedure TIntfPackageListFrm.VSTFreeNode(Sender: TBaseVirtualTree;
262   Node: PVirtualNode);
263 var
264   Data: PData;
265 begin
266   Data := FVST.GetNodeData(Node);
267   Finalize(Data^);
268 end;
269 
270 procedure TIntfPackageListFrm.PopulateTree(APkgList: TList);
271 var
272   I: Integer;
273   LazarusPkg: TLazarusPackage;
274   RootNode, Node: PVirtualNode;
275   RootData, Data: PData;
276 begin
277   for I := 0 to APkgList.Count - 1 do
278   begin
279     LazarusPkg := TLazarusPackage(APkgList.Items[I]);
280     //name
281     RootNode := FVST.AddChild(nil);
282     RootNode^.CheckType := ctTriStateCheckBox;
283     RootNode^.CheckState := csCheckedNormal;
284     RootData := FVST.GetNodeData(RootNode);
285     RootData^.LazarusPackageName := StringReplace(LazarusPkg.Name, '.lpk', '', [rfIgnoreCase, rfReplaceAll]);
286     RootData^.DataType := 0;
287 
288     //description
289     Node := FVST.AddChild(RootNode);
290     Data := FVST.GetNodeData(Node);
291     Data^.DataType :=  1;
292     Data^.Description := LazarusPkg.Description;
293 
294     //author
295     Node := FVST.AddChild(RootNode);
296     Data := FVST.GetNodeData(Node);
297     Data^.DataType :=  2;
298     Data^.Author := LazarusPkg.Author;
299 
300     //LazCompatibility
301     Node := FVST.AddChild(RootNode);
302     Data := FVST.GetNodeData(Node);
303     Data^.DataType :=  3;
304     Data^.LazCompatibility := LazarusPkg.LazCompatibility;
305 
306     //FPCCompatibility
307     Node := FVST.AddChild(RootNode);
308     Data := FVST.GetNodeData(Node);
309     Data^.DataType :=  4;
310     Data^.FPCCompatibility := LazarusPkg.FPCCompatibility;
311 
312     //SupportedWidgetSet
313     Node := FVST.AddChild(RootNode);
314     Data := FVST.GetNodeData(Node);
315     Data^.DataType :=  5;
316     Data^.SupportedWidgetSet := LazarusPkg.SupportedWidgetSet;
317 
318     //FPCCompatibility
319     Node := FVST.AddChild(RootNode);
320     Data := FVST.GetNodeData(Node);
321     Data^.DataType :=  6;
322     Data^.PackageType := LazarusPkg.PackageType;
323 
324     //License
325     Node := FVST.AddChild(RootNode);
326     Data := FVST.GetNodeData(Node);
327     Data^.DataType :=  7;
328     Data^.License := LazarusPkg.License;
329 
330     //Dependencies
331     Node := FVST.AddChild(RootNode);
332     Data := FVST.GetNodeData(Node);
333     Data^.DataType :=  8;
334     Data^.Dependencies := LazarusPkg.DependenciesAsString;
335 
336     //FPCCompatibility
337     Node := FVST.AddChild(RootNode);
338     Data := FVST.GetNodeData(Node);
339     Data^.DataType :=  9;
340     Data^.Version := LazarusPkg.VersionAsString;
341   end;
342   FVST.SortTree(0, sdAscending);
343   if FVST.RootNodeCount = 1 then
344     FVST.FullExpand
345   else
346     FVST.FullCollapse;
347 end;
348 
TIntfPackageListFrm.IsLazarusPackageCheckednull349 function TIntfPackageListFrm.IsLazarusPackageChecked(AName: String): Boolean;
350 var
351   Node: PVirtualNode;
352   Data: PData;
353 begin
354   Result := False;
355   Node := FVST.GetFirst;
356   while Assigned(Node) do
357   begin
358     Data := FVST.GetNodeData(Node);
359     if CompareText(Data^.LazarusPackageName + '.lpk', AName) = 0 then
360     begin
361       Result := Node^.CheckState = csCheckedNormal;
362       Break;
363     end;
364     Node := FVST.GetNextSibling(Node);
365   end;
366 end;
367 
368 end.
369 
370