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