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 Author: Balázs Székely
22 Abstract:
23 Implementation of the visual tree, which displays the package sructure
24 downloaded from the remote repository.
25 }
26 unit opkman_visualtree;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, contnrs, Math, dateutils, laz.VirtualTrees,
34 // LCL
35 Controls, Graphics, Menus, Dialogs, Forms, LCLType, Buttons,
36 // LazUtils
37 LazStringUtils,
38 // IDEIntf
39 LCLIntf, PackageIntf,
40 // OpkMan
41 opkman_common, opkman_serializablepackages, opkman_const,
42 opkman_options, opkman_packagedetailsfrm, opkman_showhint;
43
44
45 type
46 PData = ^TData;
47 TData = record
48 DataType: Integer;
49 PID: Integer;
50 PFID: Integer;
51 Repository: String;
52 PackageState: TPackageState;
53 PackageName: String;
54 PackageDisplayName: String;
55 Category: String;
56 LazarusPackageName: String;
57 Version: String;
58 InstalledVersion: String;
59 UpdateVersion: String;
60 Description: String;
61 Author: String;
62 LazCompatibility: String;
63 FPCCompatibility: String;
64 SupportedWidgetSet: String;
65 PackageType: TLazPackageType;
66 Dependencies: String;
67 License: String;
68 RepositoryFileName: String;
69 RepositoryFileSize: Int64;
70 RepositoryFileHash: String;
71 RepositoryDate: TDateTime;
72 HomePageURL: String;
73 DownloadURL: String;
74 DownloadZipURL: String;
75 HasUpdate: Boolean;
76 DisableInOPM: Boolean;
77 IsUpdated: Boolean;
78 SVNURL: String;
79 CommunityDescription: String;
80 ExternalDependencies: String;
81 OrphanedPackage: Integer;
82 InstallState: Integer;
83 ButtonID: Integer;
84 Button: TSpeedButton;
85 Rating: Integer;
86 IsDependencyNode: Boolean;
87 end;
88
89 TFilterBy = (fbPackageName, fbLazarusPackageName, fbPackageCategory, fbPackageState,
90 fbVersion, fbDescription, fbAuthor, fbLazCompatibility, fbFPCCompatibility,
91 fbSupportedWidgetsets, fbPackageType, fbDependecies, fbLicense);
92
93 { TVisualTree }
94 TOnChecking = procedure(Sender: TObject; const AIsAllChecked: Boolean) of object;
95 TVisualTree = class
96 private
97 FVST: TLazVirtualStringTree;
98 FHoverNode: PVirtualNode;
99 FHoverNodeOld: PVirtualNode;
100 FHoverP: TPoint;
101 FHoverColumn: Integer;
102 FLink: String;
103 FLinkClicked: Boolean;
104 FSortCol: Integer;
105 FSortDir: laz.VirtualTrees.TSortDirection;
106 FCheckingNodes: Boolean;
107 FLeaving: Boolean;
108 FOnChecking: TOnChecking;
109 FOnChecked: TNotifyEvent;
110 FMouseEnter: Boolean;
111 FShowHintFrm: TShowHintFrm;
112 FOldButtonNode: PVirtualNode;
113 FStarSize: Integer;
114 procedure DoOpenPackage(const APackageName: String);
115 procedure VSTBeforeCellPaint(Sender: TBaseVirtualTree;
116 TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex;
117 {%H-}CellPaintMode: TVTCellPaintMode; CellRect: TRect; var {%H-}ContentRect: TRect);
118 procedure VSTChecking(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode;
119 var NewState: TCheckState; var {%H-}Allowed: Boolean);
120 procedure VSTChecked(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode);
121 procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
122 Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
123 procedure VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
124 {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
125 var ImageIndex: Integer);
126 procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
127 Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
128 procedure VSTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
129 procedure VSTPaintText(Sender: TBaseVirtualTree;
130 const TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex;
131 {%H-}TextType: TVSTTextType);
132 procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
133 procedure VSTMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer);
134 procedure VSTMouseEnter(Sender: TObject);
135 procedure VSTMouseLeave(Sender: TObject);
136 procedure VSTMouseDown(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer);
137 procedure VSTKeyDown(Sender: TObject; var {%H-}Key: Word; {%H-}Shift: TShiftState);
138 procedure VSTKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
139 procedure VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
140 var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
141 procedure VSTAfterCellPaint(Sender: TBaseVirtualTree; {%H-}TargetCanvas: TCanvas;
142 Node: PVirtualNode; Column: TColumnIndex; const {%H-}CellRect: TRect);
143 procedure VSTDblClick(Sender: TObject);
144 procedure VSTScroll(Sender: TBaseVirtualTree; {%H-}DeltaX, {%H-}DeltaY: Integer);
145 procedure VSTIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: String; var Result: Integer);
146 procedure VSTClick(Sender: TObject);
147 procedure VSTAfterPaint(Sender: TBaseVirtualTree; {%H-}TargetCanvas: TCanvas);
148 procedure VSTEnter(Sender: TObject);
IsAllCheckednull149 function IsAllChecked(const AChecking: PVirtualNode): Boolean;
150 procedure ButtonClick(Sender: TObject);
151 procedure DrawStars(ACanvas: TCanvas; AStartIndex: Integer; P: TPoint; AAvarage: Double);
GetColumnnull152 function GetColumn(const AX: Integer): Integer;
TranslateCategoriesnull153 function TranslateCategories(const AStr: String): String;
154 procedure SetButtonVisibility(Node: PVirtualNode; Column: TColumnIndex);
155 procedure CallBack(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Data: Pointer; var {%H-}Abort: Boolean);
156 procedure ShowDetails(const AButtonID: Integer);
157 procedure OpenPackage(const AButtonID: Integer);
158 procedure ResetDependencyNodes;
GetPackageAbsolutePathnull159 function GetPackageAbsolutePath(APackageName: String): String;
160 public
161 constructor Create(const AParent: TWinControl; const AImgList: TImageList;
162 APopupMenu: TPopupMenu);
163 destructor Destroy; override;
164 public
165 procedure PopulateTree;
166 procedure CheckNodes(const Checked: Boolean);
167 procedure FilterTree(const AFilterBy: TFilterBy; const AText: String; const AExtraParam: Integer = -1);
168 procedure ResetFilter;
169 procedure ExpandEx;
170 procedure CollapseEx;
171 procedure GetPackageList;
172 procedure UpdatePackageStates;
173 procedure UpdatePackageUStatus;
ResolveDependenciesnull174 function ResolveDependencies: TModalResult;
GetCheckedRepositoryPackagesnull175 function GetCheckedRepositoryPackages: Integer;
176 procedure SetupColors;
177 procedure AutoAdjustLayout(AXProportion, AYProportion: Double);
178 published
179 property OnChecking: TOnChecking read FOnChecking write FOnChecking;
180 property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
181 property VST: TLazVirtualStringTree read FVST;
182 property ShowHintFrm: TShowHintFrm read FShowHintFrm;
183 end;
184
185 var
186 VisualTree: TVisualTree = nil;
187
188 implementation
189
190 uses
191 imgList;
192
193 { TVisualTree }
194
195 constructor TVisualTree.Create(const AParent: TWinControl; const AImgList: TImageList;
196 APopupMenu: TPopupMenu);
197 begin
198 FVST := TLazVirtualStringTree.Create(nil);
199 with FVST do
200 begin
201 Parent := AParent;
202 Align := alClient;
203 Anchors := [akLeft, akTop, akRight];
204 Images := AImgList;
205 PopupMenu := APopupMenu;
206 DefaultNodeHeight := 25;
207 Indent := 22;
208 TabOrder := 1;
209 DefaultText := '';
210 Header.AutoSizeIndex := 4;
211 Header.Height := 25;
212 Colors.DisabledColor := clBlack;
213 with Header.Columns.Add do
214 begin
215 Position := 0;
216 Width := 270;
217 Text := rsMainFrm_VSTHeaderColumn_PackageName;
218 end;
219 with Header.Columns.Add do
220 begin
221 Position := 1;
222 Alignment := taCenter;
223 Width := 90;
224 {$IFDEF LCLCarbon}
225 Options := Options - [coResizable];
226 {$ENDIF}
227 Text := rsMainFrm_VSTHeaderColumn_Installed;
228 end;
229 with Header.Columns.Add do
230 begin
231 Position := 2;
232 Alignment := taCenter;
233 Width := 110;
234 {$IFDEF LCLCarbon}
235 Options := Options - [coResizable];
236 {$ENDIF}
237 Text := rsMainFrm_VSTHeaderColumn_Repository;
238 Hint := rsMainFrm_VSTHeaderColumn_Repository_Hint;
239 end;
240 with Header.Columns.Add do
241 begin
242 Position := 3;
243 Alignment := taCenter;
244 Width := 110;
245 {$IFDEF LCLCarbon}
246 Options := Options - [coResizable];
247 {$ENDIF}
248 Text := rsMainFrm_VSTHeaderColumn_Update;
249 Hint := rsMainFrm_VSTHeaderColumn_Update_Hint;
250 end;
251 with Header.Columns.Add do
252 begin
253 Position := 4;
254 Width := 280;
255 {$IFDEF LCLCarbon}
256 Options := Options - [coResizable];
257 {$ENDIF}
258 Text := rsMainFrm_VSTHeaderColumn_Data;
259 end;
260 with Header.Columns.Add do
261 begin
262 Position := 5;
263 Alignment := taCenter;
264 Width := 80;
265 Options := Options - [coResizable];
266 Text := rsMainFrm_VSTHeaderColumn_Rating;
267 end;
268 with Header.Columns.Add do
269 begin
270 Position := 6;
271 Alignment := taCenter;
272 Width := 20;
273 Options := Options - [coResizable];
274 end;
275 Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoShowSortGlyphs, hoVisible, hoShowHint];
276 {$IFDEF LCLCarbon}
277 Header.Options := Header.Options - [hoShowSortGlyphs];
278 {$ENDIF}
279 Header.SortColumn := 0;
280 HintMode := hmHint;
281 ShowHint := True;
282 TabOrder := 2;
283 IncrementalSearch := isVisibleOnly;
284 IncrementalSearchDirection := sdForward;
285 IncrementalSearchStart := ssFocusedNode;
286 IncrementalSearchTimeout := 3000;
287 TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toWheelPanning];
288 TreeOptions.PaintOptions := [toHideFocusRect, toAlwaysHideSelection, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware];
289 TreeOptions.SelectionOptions := [toFullRowSelect, toRightClickSelect];
290 TreeOptions.StringOptions := [toShowStaticText];
291 TreeOptions.AutoOptions := [toAutoTristateTracking];
292 OnBeforeCellPaint := @VSTBeforeCellPaint;
293 OnChecking := @VSTChecking;
294 OnChecked := @VSTChecked;
295 OnCompareNodes := @VSTCompareNodes;
296 OnGetText := @VSTGetText;
297 OnPaintText := @VSTPaintText;
298 OnGetImageIndex := @VSTGetImageIndex;
299 OnHeaderClick := @VSTHeaderClick;
300 OnMouseMove := @VSTMouseMove;
301 OnMouseLeave := @VSTMouseLeave;
302 OnMouseEnter := @VSTMouseEnter;
303 OnMouseDown := @VSTMouseDown;
304 OnKeyDown := @VSTKeyDown;
305 OnKeyUp := @VSTKeyUp;
306 OnDblClick := @VSTDblClick;
307 OnClick := @VSTClick;
308 OnGetHint := @VSTGetHint;
309 OnAfterCellPaint := @VSTAfterCellPaint;
310 OnAfterPaint := @VSTAfterPaint;
311 OnEnter := @VSTEnter;
312 OnFreeNode := @VSTFreeNode;
313 OnScroll := @VSTScroll;
314 OnIncrementalSearch := @VSTIncrementalSearch;
315 end;
316 FShowHintFrm := TShowHintFrm.Create(nil);
317 if AImgList <> nil then
318 FStarSize := AImgList.Width
319 else
320 FStarSize := 0;
321 end;
322
323 destructor TVisualTree.Destroy;
324 begin
325 FVST.Free;
326 FShowHintFrm.Free;
327 inherited Destroy;
328 end;
329
330 procedure TVisualTree.PopulateTree;
331 var
332 I, J: Integer;
333 RootNode, Node, ChildNode, GrandChildNode: PVirtualNode;
334 RootData, Data, ChildData, GrandChildData: PData;
335 LazarusPkg: TLazarusPackage;
336 UniqueID: Integer;
337 begin
338 FHoverNode := nil;
339 FHoverNodeOld := nil;
340 FOldButtonNode := nil;
341 FVST.Clear;
342 FVST.NodeDataSize := SizeOf(TData);
343 UniqueID := 0;
344 //add repository(DataType = 0)
345 FVST.BeginUpdate;
346 try
347 RootNode := FVST.AddChild(nil);
348 RootData := FVST.GetNodeData(RootNode);
349 RootData^.Repository := Options.RemoteRepository[Options.ActiveRepositoryIndex];
350 RootData^.DataType := 0;
351 for I := 0 to SerializablePackages.Count - 1 do
352 begin
353 //add package(DataType = 1)
354 Node := FVST.AddChild(RootNode);
355 Node^.CheckType := ctTriStateCheckBox;
356 Data := FVST.GetNodeData(Node);
357 Data^.PID := I;
358 Data^.PackageName := SerializablePackages.Items[I].Name;
359 Data^.PackageDisplayName := SerializablePackages.Items[I].DisplayName;
360 Data^.PackageState := SerializablePackages.Items[I].PackageState;
361 Data^.InstallState := SerializablePackages.GetPackageInstallState(SerializablePackages.Items[I]);
362 Data^.HasUpdate := SerializablePackages.Items[I].HasUpdate;
363 Data^.DisableInOPM := SerializablePackages.Items[I].DisableInOPM;
364 Data^.Rating := SerializablePackages.Items[I].Rating;
365 Data^.RepositoryDate := SerializablePackages.Items[I].RepositoryDate;
366 FVST.IsDisabled[Node] := Data^.DisableInOPM;
367 Data^.DataType := 1;
368 for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do
369 begin
370 //add LazarusPackages(DataType = 2)
371 LazarusPkg := TLazarusPackage(SerializablePackages.Items[I].LazarusPackages.Items[J]);
372 ChildNode := FVST.AddChild(Node);
373 ChildNode^.CheckType := ctTriStateCheckBox;
374 FVST.IsDisabled[ChildNode] := FVST.IsDisabled[ChildNode^.Parent];
375 ChildData := FVST.GetNodeData(ChildNode);
376 ChildData^.PID := I;
377 ChildData^.PFID := J;
378 ChildData^.LazarusPackageName := LazarusPkg.Name;
379 ChildData^.InstalledVersion := LazarusPkg.InstalledFileVersion;
380 ChildData^.UpdateVersion := LazarusPkg.UpdateVersion;
381 ChildData^.Version := LazarusPkg.VersionAsString;
382 ChildData^.PackageState := LazarusPkg.PackageState;
383 ChildData^.HasUpdate := LazarusPkg.HasUpdate;
384 ChildData^.DataType := 2;
385 Inc(UniqueID);
386 ChildData^.ButtonID := -UniqueID;
387 //add description(DataType = 3)
388 GrandChildNode := FVST.AddChild(ChildNode);
389 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
390 GrandChildData := FVST.GetNodeData(GrandChildNode);
391 if ChildData^.InstalledVersion <> '' then
392 GrandChildData^.Description := LazarusPkg.InstalledFileDescription
393 else
394 GrandChildData^.Description := LazarusPkg.Description;
395 GrandChildData^.DataType := 3;
396 Inc(UniqueID);
397 GrandChildData^.ButtonID := UniqueID;
398 //add author(DataType = 4)
399 GrandChildNode := FVST.AddChild(ChildNode);
400 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
401 GrandChildData := FVST.GetNodeData(GrandChildNode);
402 GrandChildData^.Author := LazarusPkg.Author;
403 GrandChildData^.DataType := 4;
404 //add lazcompatibility(DataType = 5)
405 GrandChildNode := FVST.AddChild(ChildNode);
406 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
407 GrandChildData := FVST.GetNodeData(GrandChildNode);
408 GrandChildData^.LazCompatibility := LazarusPkg.LazCompatibility;
409 GrandChildData^.DataType := 5;
410 //add fpccompatibility(DataType = 6)
411 GrandChildNode := FVST.AddChild(ChildNode);
412 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
413 GrandChildData := FVST.GetNodeData(GrandChildNode);
414 GrandChildData^.FPCCompatibility := LazarusPkg.FPCCompatibility;
415 GrandChildData^.DataType := 6;
416 //add widgetset(DataType = 7)
417 GrandChildNode := FVST.AddChild(ChildNode);
418 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
419 GrandChildData := FVST.GetNodeData(GrandChildNode);
420 GrandChildData^.SupportedWidgetSet := LazarusPkg.SupportedWidgetSet;
421 GrandChildData^.DataType := 7;
422 //add packagetype(DataType = 8)
423 GrandChildNode := FVST.AddChild(ChildNode);
424 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
425 GrandChildData := FVST.GetNodeData(GrandChildNode);
426 GrandChildData^.PackageType := LazarusPkg.PackageType;
427 GrandChildData^.DataType := 8;
428 //add license(DataType = 9)
429 GrandChildNode := FVST.AddChild(ChildNode);
430 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
431 GrandChildData := FVST.GetNodeData(GrandChildNode);
432 if ChildData^.InstalledVersion <> '' then
433 GrandChildData^.License := LazarusPkg.InstalledFileLincese
434 else
435 GrandChildData^.License := LazarusPkg.License;
436 GrandChildData^.DataType := 9;
437 Inc(UniqueID);
438 GrandChildData^.ButtonID := UniqueID;
439 //add dependencies(DataType = 10)
440 GrandChildNode := FVST.AddChild(ChildNode);
441 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
442 GrandChildData := FVST.GetNodeData(GrandChildNode);
443 GrandChildData^.Dependencies := LazarusPkg.DependenciesAsString;
444 GrandChildData^.DataType := 10;
445 end;
446 //add miscellaneous(DataType = 11)
447 ChildNode := FVST.AddChild(Node);
448 FVST.IsDisabled[ChildNode] := FVST.IsDisabled[ChildNode^.Parent];
449 ChildData := FVST.GetNodeData(ChildNode);
450 ChildData^.DataType := 11;
451 //add category(DataType = 12)
452 GrandChildNode := FVST.AddChild(ChildNode);
453 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
454 GrandChildData := FVST.GetNodeData(GrandChildNode);
455 GrandChildData^.Category := SerializablePackages.Items[I].Category;
456 GrandChildData^.DataType := 12;
457 //add Repository Filename(DataType = 13)
458 GrandChildNode := FVST.AddChild(ChildNode);
459 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
460 GrandChildData := FVST.GetNodeData(GrandChildNode);
461 GrandChildData^.RepositoryFileName := SerializablePackages.Items[I].RepositoryFileName;
462 GrandChildData^.DataType := 13;
463 //add Repository Filesize(DataType = 14)
464 GrandChildNode := FVST.AddChild(ChildNode);
465 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
466 GrandChildData := FVST.GetNodeData(GrandChildNode);
467 GrandChildData^.RepositoryFileSize := SerializablePackages.Items[I].RepositoryFileSize;
468 GrandChildData^.DataType := 14;
469 //add Repository Hash(DataType = 15)
470 GrandChildNode := FVST.AddChild(ChildNode);
471 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
472 GrandChildData := FVST.GetNodeData(GrandChildNode);
473 GrandChildData^.RepositoryFileHash := SerializablePackages.Items[I].RepositoryFileHash;
474 GrandChildData^.DataType := 15;
475 //add Repository Date(DataType = 16)
476 GrandChildNode := FVST.AddChild(ChildNode);
477 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
478 GrandChildData := FVST.GetNodeData(GrandChildNode);
479 GrandChildData^.RepositoryDate := SerializablePackages.Items[I].RepositoryDate;
480 GrandChildData^.DataType := 16;
481 FVST.Expanded[ChildNode] := True;
482 //add HomePageURL(DataType = 17)
483 GrandChildNode := FVST.AddChild(ChildNode);
484 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
485 GrandChildData := FVST.GetNodeData(GrandChildNode);
486 GrandChildData^.HomePageURL := SerializablePackages.Items[I].HomePageURL;
487 GrandChildData^.DataType := 17;
488 //add DownloadURL(DataType = 18)
489 GrandChildNode := FVST.AddChild(ChildNode);
490 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
491 GrandChildData := FVST.GetNodeData(GrandChildNode);
492 GrandChildData^.DownloadURL := SerializablePackages.Items[I].DownloadURL;
493 GrandChildData^.DataType := 18;
494 //add community description(DataType = 19) - added 2018.08.21
495 GrandChildNode := FVST.AddChild(ChildNode);
496 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
497 GrandChildData := FVST.GetNodeData(GrandChildNode);
498 GrandChildData^.CommunityDescription := SerializablePackages.Items[I].CommunityDescription;
499 GrandChildData^.DataType := 19;
500 Inc(UniqueID);
501 GrandChildData^.ButtonID := UniqueID;
502 Data^.CommunityDescription := SerializablePackages.Items[I].CommunityDescription;
503 //add external dependecies(DataType = 20) - added 2020.04.14
504 GrandChildNode := FVST.AddChild(ChildNode);
505 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
506 GrandChildData := FVST.GetNodeData(GrandChildNode);
507 GrandChildData^.ExternalDependencies := SerializablePackages.Items[I].ExternalDependecies;
508 GrandChildData^.DataType := 20;
509 Inc(UniqueID);
510 GrandChildData^.ButtonID := UniqueID;
511 Data^.ExternalDependencies := SerializablePackages.Items[I].ExternalDependecies;
512 //add orphaned package(DataType = 21) - added 2020.07.23
513 GrandChildNode := FVST.AddChild(ChildNode);
514 FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent];
515 GrandChildData := FVST.GetNodeData(GrandChildNode);
516 GrandChildData^.OrphanedPackage := SerializablePackages.Items[I].OrphanedPackage;
517 GrandChildData^.DataType := 21;
518 Data^.OrphanedPackage := SerializablePackages.Items[I].OrphanedPackage;
519 FVST.IsVisible[GrandChildNode] := False;
520 end;
521 FVST.SortTree(0, laz.VirtualTrees.sdAscending);
522 ExpandEx;
523 CollapseEx;
524 finally
525 FVST.EndUpdate;
526 end;
527 RootNode := VST.GetFirst;
528 if RootNode <> nil then
529 begin
530 FVST.Selected[RootNode] := True;
531 FVST.FocusedNode := RootNode;
532 end;
533 end;
534
TVisualTree.IsAllCheckednull535 function TVisualTree.IsAllChecked(const AChecking: PVirtualNode): Boolean;
536 var
537 Node: PVirtualNode;
538 begin
539 Result := True;
540 Node := FVST.GetFirst;
541 while Assigned(Node) do
542 begin
543 if (FVST.CheckState[Node] = csUncheckedNormal) and (Node <> AChecking) then
544 begin
545 Result := False;
546 Break;
547 end;
548 Node := FVST.GetNext(Node);
549 end;
550 end;
551
552 procedure TVisualTree.ShowDetails(const AButtonID: Integer);
553 var
554 Node, ParentNode, MetaPackageNode: PVirtualNode;
555 Data, ParentData, MetaPackageData: PData;
556 Text: String;
557 FrmCaption: String;
558 begin
559 if Assigned(PackageDetailsFrm) then
560 Exit;
561
562 Node := VST.GetFirst;
563 while Assigned(Node) do
564 begin
565 Data := VST.GetNodeData(Node);
566 if Data^.ButtonID = AButtonID then
567 begin
568 ParentNode := Node^.Parent;
569 ParentData := VST.GetNodeData(ParentNode);
570 case Data^.DataType of
571 3: begin
572 Text := Data^.Description;
573 FrmCaption := rsMainFrm_VSTText_Desc + ' "' + ParentData^.LazarusPackageName + '"';
574 end;
575 9: begin
576 Text := Data^.License;
577 FrmCaption := rsMainFrm_VSTText_Lic + ' "' + ParentData^.LazarusPackageName + '"';
578 end;
579 19: begin
580 MetaPackageNode := ParentNode^.Parent;
581 if MetaPackageNode <> nil then
582 begin
583 MetaPackageData := VST.GetNodeData(MetaPackageNode);
584 Text := Data^.CommunityDescription;
585 FrmCaption := rsMainFrm_VSTText_ComDesc + ' "' + MetaPackageData^.PackageDisplayName + '"';
586 end;
587 end;
588 20: begin
589 MetaPackageNode := ParentNode^.Parent;
590 if MetaPackageNode <> nil then
591 begin
592 MetaPackageData := VST.GetNodeData(MetaPackageNode);
593 Text := Data^.ExternalDependencies;
594 FrmCaption := rsMainFrm_VSTText_ExternalMetaPackageDeps + ' "' + MetaPackageData^.PackageDisplayName + '"';
595 end;
596 end;
597 end;
598 Break;
599 end;
600 Node := VST.GetNext(Node);
601 end;
602
603 PackageDetailsFrm := TPackageDetailsFrm.Create(TForm(FVST.Parent.Parent));
604 try
605 PackageDetailsFrm.Caption := FrmCaption;
606 PackageDetailsFrm.mDetails.Text := Text;
607 PackageDetailsFrm.ShowModal;
608 finally
609 FreeAndNil(PackageDetailsFrm);
610 end;
611 end;
612
613 procedure TVisualTree.DoOpenPackage(const APackageName: String);
614 var
615 PackageAbsolutePath: String;
616 begin
617 PackageAbsolutePath := GetPackageAbsolutePath(APackageName);
618 if PackageEditingInterface.DoOpenPackageFile(PackageAbsolutePath, [], True) <> mrOk then
619 MessageDlgEx(rsMainFrm_VSTText_Open_Error, mtError, [mbOk], TForm(FVST.Parent.Parent));
620 end;
621
622 procedure TVisualTree.OpenPackage(const AButtonID: Integer);
623 var
624 Node: PVirtualNode;
625 Data: PData;
626 begin
627 Node := VST.GetFirst;
628 while Assigned(Node) do
629 begin
630 Data := VST.GetNodeData(Node);
631 if Data^.ButtonID = AButtonID then
632 begin
633 DoOpenPackage(Data^.LazarusPackageName);
634 Break;
635 end;
636 Node := VST.GetNext(Node);
637 end;
638 end;
639
640 procedure TVisualTree.ButtonClick(Sender: TObject);
641 var
642 Tag: Integer;
643 begin
644 Tag := (Sender as TSpeedButton).Tag;
645 if Tag < 0 then
646 OpenPackage(Tag)
647 else
648 ShowDetails(Tag);
649 end;
650
TranslateCategoriesnull651 function TVisualTree.TranslateCategories(const AStr: String): String;
652 var
653 SL: TStringList;
654 I, J: Integer;
655 Str: String;
656 begin
657 if Categories[0] = CategoriesEng[0] then
658 begin
659 Result := AStr;
660 Exit;
661 end;
662 Result := '';
663 SL := TStringList.Create;
664 try
665 SL.Delimiter := ',';
666 SL.StrictDelimiter := True;
667 SL.DelimitedText := AStr;
668 for I := 0 to SL.Count - 1 do
669 begin
670 Str := Trim(SL.Strings[I]);
671 for J := 0 to MaxCategories - 1 do
672 begin
673 if Str = CategoriesEng[J] then
674 begin
675 if Result = '' then
676 Result := Categories[J]
677 else
678 Result := Result + ', ' + Categories[J];
679 Break;
680 end;
681 end;
682 end;
683 finally
684 SL.Free;
685 end;
686 if Result = '' then
687 Result := AStr;
688 end;
689
690 procedure TVisualTree.SetButtonVisibility(Node: PVirtualNode;
691 Column: TColumnIndex);
692 var
693 Data: PData;
694 R: TRect;
695 begin
696 Data := FVST.GetNodeData(Node);
697 if Assigned(Data^.Button) then
698 begin
699 R := FVST.GetDisplayRect(Node, Column, False);
700 Data^.Button.Left := R.Right - Data^.Button.Width - 1;
701 Data^.Button.Top := R.Top + 1;
702 Data^.Button.Height := R.Bottom - R.Top - 1;
703 Data^.Button.Visible := FVST.IsVisible[Node] and IntersectRect(R, FVST.GetDisplayRect(Node, Column, False), FVST.ClientRect);
704 Data^.Button.Enabled := not FVST.IsDisabled[Node];
705 end;
706 end;
707
708 procedure TVisualTree.CallBack(Sender: TBaseVirtualTree; Node: PVirtualNode;
709 Data: Pointer; var Abort: Boolean);
710 begin
711 SetButtonVisibility(Node, 4);
712 end;
713
714 procedure TVisualTree.VSTAfterPaint(Sender: TBaseVirtualTree;
715 TargetCanvas: TCanvas);
716 begin
717 Sender.IterateSubtree(nil, @CallBack, nil);
718 end;
719
720 procedure TVisualTree.VSTEnter(Sender: TObject);
721 var
722 Node: PVirtualNode;
723 begin
724 if FMouseEnter then
725 begin
726 FMouseEnter := False;
727 Exit;
728 end;
729 if FVST.SelectedCount = 0 then
730 begin
731 Node := FVST.GetFirst;
732 if Node <> nil then
733 begin
734 FVST.Selected[Node] := True;
735 FVST.FocusedNode := Node;
736 end;
737 end;
738 end;
739
740 procedure TVisualTree.DrawStars(ACanvas: TCanvas; AStartIndex: Integer;
741 P: TPoint; AAvarage: Double);
742 var
743 imgres: TScaledImageListResolution;
744
745 procedure Draw(const AX, AY: Integer; ATyp, ACnt, AWidth: Integer);
746 var
747 I: Integer;
748 begin
749 for I := 0 to ACnt - 1 do
750 imgres.Draw(ACanvas, AX + I*AWidth, AY, AStartIndex + ATyp);
751 end;
752
753 var
754 F: Double;
755 I, X, Y: Integer;
756 Stars, NoStars: Integer;
757 HalfStar: Boolean;
758 begin
759 imgres := FVST.Images.ResolutionForPPI[FVST.ImagesWidth, FVST.Font.PixelsPerInch, FVST.GetCanvasScaleFactor];
760
761 HalfStar := False;
762 F := Frac(AAvarage);
763 I := Trunc(AAvarage);
764 case CompareValue(F, 0.25, 0.005) of
765 -1:
766 begin
767 Stars := I;
768 NoStars := 5 - Stars;
769 end;
770 0, 1:
771 begin
772 if CompareValue(F, 0.75, 0.005) = -1 then
773 begin
774 Stars := I;
775 NoStars := 5 - Stars - 1;
776 HalfStar := True;
777 end
778 else
779 begin
780 Stars := I + 1;
781 NoStars := 5 - Stars;
782 end;
783 end;
784 end;
785 X := P.X;
786 Y := P.Y;
787 Draw(X, Y, 0, Stars, FStarSize);
788 Inc(X, Stars*FStarSize);
789 if HalfStar then
790 begin
791 Draw(X, Y, 2, 1, FStarSize);
792 Inc(X, FStarSize);
793 end;
794 Draw(X, Y, 1, NoStars, FStarSize);
795 end;
796
797 procedure TVisualTree.VSTAfterCellPaint(Sender: TBaseVirtualTree;
798 TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
799 const CellRect: TRect);
800 var
801 Data: PData;
802 R: TRect;
803 P: TPoint;
804 Stars: Integer;
805 begin
806 if Column = 5 then
807 begin
808 Data := FVST.GetNodeData(Node);
809 if Data^.DataType = 1 then
810 begin
811 R := FVST.GetDisplayRect(Node, Column, False);
812 P.X := R.Left + 1;
813 P.Y := ((R.Bottom - R.Top - FStarSize) div 2) + 1;
814 if (Node = FHoverNode) and (not FLeaving) and (FHoverP.X >= P.X + 1) and (Abs(FHoverP.X - P.X) <= R.Right - R.Bottom) then
815 begin
816 Stars := Trunc((FHoverP.X - P.X)/FStarSize) + 1;
817 if Stars > 5 then
818 Stars := 5;
819 DrawStars(TargetCanvas, 23, P, Stars)
820 end
821 else
822 DrawStars(TargetCanvas, 20, P, Data^.Rating);
823 end
824 end;
825 end;
826
827 procedure TVisualTree.CheckNodes(const Checked: Boolean);
828 var
829 Node: PVirtualNode;
830 begin
831 FCheckingNodes := True;
832 try
833 Node := FVST.GetFirst;
834 while Assigned(Node) do
835 begin
836 if Checked then
837 FVST.CheckState[Node] := csCheckedNormal
838 else
839 FVST.CheckState[Node] := csUncheckedNormal;
840 Node := FVST.GetNext(Node);
841 end;
842 finally
843 FCheckingNodes := False;
844 end;
845 end;
846
847 procedure TVisualTree.FilterTree(const AFilterBy: TFilterBy; const AText:
848 String; const AExtraParam: Integer = -1);
849
IsAtLeastOneChildVisiblenull850 function IsAtLeastOneChildVisible(const ANode: PVirtualNode): Boolean;
851 var
852 Level: Integer;
853 Node: PVirtualNode;
854 Data: PData;
855 begin
856 Result := False;
857 Level := FVST.GetNodeLevel(ANode);
858 Node := FVST.GetFirstChild(ANode);
859 while Assigned(Node) do
860 begin
861 Data := FVST.GetNodeData(Node);
862 case Level of
863 0: if (vsVisible in Node^.States) then
864 begin
865 Result := True;
866 Break;
867 end;
868 1: if (vsVisible in Node^.States) and (Data^.DataType = 2) then
869 begin
870 Result := True;
871 Break;
872 end;
873 end;
874 Node := FVST.GetNextSibling(Node);
875 end;
876 end;
877
878 procedure HideShowParentNodes(const ANode: PVirtualNode; AShow: Boolean);
879 var
880 Level: Integer;
881 RepositoryNode, PackageNode, LazarusPkgNode: PVirtualNode;
882 begin
883 RepositoryNode := nil;
884 PackageNode := nil;
885 LazarusPkgNode := nil;
886 Level := FVST.GetNodeLevel(ANode);
887 case Level of
888 1: begin
889 RepositoryNode := ANode^.Parent;
890 PackageNode := ANode;
891 end;
892 2: begin
893 RepositoryNode := ANode^.Parent^.Parent;
894 PackageNode := ANode^.Parent;
895 LazarusPkgNode := ANode;
896 end;
897 3: begin
898 RepositoryNode := ANode^.Parent^.Parent^.Parent;
899 PackageNode := ANode^.Parent^.Parent;
900 LazarusPkgNode := ANode^.Parent;
901 end;
902 end;
903 if Level = 1 then
904 begin
905 if AShow then
906 FVST.IsVisible[RepositoryNode] := True
907 else
908 if not IsAtLeastOneChildVisible(RepositoryNode) then
909 FVST.IsVisible[RepositoryNode] := False;
910 end
911 else if Level = 2 then
912 begin
913 if AShow then
914 begin
915 FVST.IsVisible[PackageNode] := True;
916 FVST.IsVisible[RepositoryNode] := True;
917 end
918 else
919 begin
920 if not IsAtLeastOneChildVisible(PackageNode) then
921 begin
922 FVST.IsVisible[PackageNode] := False;
923 HideShowParentNodes(PackageNode, AShow);
924 end;
925 end;
926 end
927 else if Level = 3 then
928 begin
929 if AShow then
930 begin
931 FVST.IsVisible[LazarusPkgNode] := True;
932 FVST.IsVisible[PackageNode] := True;
933 FVST.IsVisible[RepositoryNode] := True;
934 end
935 else
936 begin
937 FVST.IsVisible[LazarusPkgNode] := False;
938 HideShowParentNodes(LazarusPkgNode, AShow);
939 end;
940 end;
941 end;
942
943 procedure FilterNode(Node: PVirtualNode; ADataText: String);
944 var
945 P: Integer;
946 begin
947 P := PosI(AText, ADataText);
948 if P > 0 then
949 FVST.IsVisible[Node] := True
950 else
951 FVST.IsVisible[Node] := False;
952 if AText = 'PackageCategory' then //special case for categories
953 begin
954 if (P > 0) then
955 begin
956 FVST.IsVisible[Node^.Parent^.Parent] := True;
957 FVST.IsVisible[Node^.Parent^.Parent^.Parent] := True;
958 end
959 else
960 begin
961 FVST.IsVisible[Node^.Parent^.Parent] := False;
962 if not IsAtLeastOneChildVisible(Node^.Parent^.Parent^.Parent) then
963 FVST.IsVisible[Node^.Parent^.Parent^.Parent] := False
964 end;
965 end
966 else
967 HideShowParentNodes(Node, P > 0)
968 end;
969
970 var
971 Node: PVirtualNode;
972 Data: PData;
973 begin
974 Node := FVST.GetFirst;
975 while Assigned(Node) do
976 begin
977 Data := FVST.GetNodeData(Node);
978 case AFilterBy of
979 fbPackageName:
980 begin
981 if (Data^.DataType = 1) then
982 FilterNode(Node, Data^.PackageDisplayName);
983 end;
984 fbLazarusPackageName:
985 begin
986 if (Data^.DataType = 2) then
987 FilterNode(Node, Data^.LazarusPackageName);
988 end;
989 fbPackageCategory:
990 begin
991 if Data^.DataType = 12 then
992 begin
993 if PosI(CategoriesEng[AExtraParam], Data^.Category) > 0 then
994 FilterNode(Node, 'PackageCategory')
995 else
996 FilterNode(Node, '')
997 end;
998 end;
999 fbPackageState:
1000 begin
1001 if Data^.DataType = 2 then
1002 begin
1003 if Data^.PackageState = TPackageState(AExtraParam) then
1004 FilterNode(Node, 'PackageState')
1005 else
1006 FilterNode(Node, '');
1007 end;
1008 end;
1009 fbVersion:
1010 begin
1011 if Data^.DataType = 2 then
1012 FilterNode(Node, Data^.Version);
1013 end;
1014 fbDescription:
1015 begin
1016 if Data^.DataType = 3 then
1017 FilterNode(Node, Data^.Description);
1018 end;
1019 fbAuthor:
1020 begin
1021 if Data^.DataType = 4 then
1022 FilterNode(Node, Data^.Author);
1023 end;
1024 fbLazCompatibility:
1025 begin
1026 if Data^.DataType = 5 then
1027 FilterNode(Node, Data^.LazCompatibility);
1028 end;
1029 fbFPCCompatibility:
1030 begin
1031 if Data^.DataType = 6 then
1032 FilterNode(Node, Data^.FPCCompatibility);
1033 end;
1034 fbSupportedWidgetsets:
1035 begin
1036 if Data^.DataType = 7 then
1037 FilterNode(Node, Data^.SupportedWidgetSet);
1038 end;
1039 fbPackageType:
1040 begin
1041 if Data^.DataType = 8 then
1042 begin
1043 if Data^.PackageType = TLazPackageType(AExtraParam) then
1044 FilterNode(Node, 'PackageType')
1045 else
1046 FilterNode(Node, '');
1047 end;
1048 end;
1049 fbLicense:
1050 begin
1051 if Data^.DataType = 9 then
1052 FilterNode(Node, Data^.License);
1053 end;
1054 fbDependecies:
1055 begin
1056 if Data^.DataType = 10 then
1057 FilterNode(Node, Data^.Dependencies);
1058 end;
1059 end;
1060 Node := FVST.GetNext(Node);
1061 end;
1062 Node := FVST.GetFirst;
1063 if Node <> nil then
1064 FVST.TopNode := Node;
1065 end;
1066
1067 procedure TVisualTree.ResetFilter;
1068 var
1069 Node: PVirtualNode;
1070 begin
1071 Node := FVST.GetFirst;
1072 while Assigned(Node) do
1073 begin
1074 FVST.IsVisible[Node] := True;
1075 Node := FVST.GetNext(Node);
1076 end;
1077 Node := FVST.GetFirst;
1078 CollapseEx;
1079 if Node <> nil then
1080 FVST.TopNode := Node;
1081 end;
1082
1083 procedure TVisualTree.ExpandEx;
1084 var
1085 Node: PVirtualNode;
1086 Data: PData;
1087 begin
1088 Node := FVST.GetFirst;
1089 while Assigned(Node) do
1090 begin
1091 Data := FVST.GetNodeData(Node);
1092 if (Data^.DataType = 0) or (Data^.DataType = 1) or (Data^.DataType = 11) then
1093 VST.Expanded[Node] := True;
1094 Node := FVST.GetNext(Node);
1095 end;
1096 Node := FVST.GetFirst;
1097 if Node <> nil then
1098 FVST.TopNode := Node;
1099 end;
1100
1101 procedure TVisualTree.CollapseEx;
1102 var
1103 Node: PVirtualNode;
1104 Data: PData;
1105 begin
1106 FVST.FullCollapse;
1107 Node := FVST.GetFirst(True);
1108 while Assigned(Node) do
1109 begin
1110 Data := FVST.GetNodeData(Node);
1111 if (Data^.DataType = 0) or (Data^.DataType = 11) then
1112 VST.Expanded[Node] := True;
1113 Node := FVST.GetNext(Node);
1114 end;
1115 end;
1116
1117 procedure TVisualTree.GetPackageList;
1118 var
1119 Node: PVirtualNode;
1120 Data: PData;
1121 MetaPkg: TMetaPackage;
1122 LazarusPkg: TLazarusPackage;
1123 begin
1124 Node := FVST.GetFirst;
1125 while Assigned(Node) do
1126 begin
1127 Data := FVST.GetNodeData(Node);
1128 if Data^.DataType = 1 then
1129 begin
1130 MetaPkg := SerializablePackages.Items[Data^.PID];
1131 if MetaPkg <> nil then
1132 begin
1133 if (FVST.CheckState[Node] = csCheckedNormal) or (FVST.CheckState[Node] = csMixedNormal) then
1134 begin
1135 if (FVST.IsVisible[Node]) or (Data^.IsDependencyNode) then
1136 begin
1137 MetaPkg.Checked := True;
1138 if Data^.IsDependencyNode then
1139 MetaPkg.IsDependencyPackage := True;
1140 end
1141 else
1142 MetaPkg.Checked := False;
1143 end
1144 else if FVST.CheckState[Node] = csUncheckedNormal then
1145 MetaPkg.Checked := False
1146 end;
1147 end;
1148 if Data^.DataType = 2 then
1149 begin
1150 LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]);
1151 if LazarusPkg <> nil then
1152 begin
1153 if FVST.CheckState[Node] = csCheckedNormal then
1154 begin
1155 if (FVST.IsVisible[Node]) or (Data^.IsDependencyNode) then
1156 begin
1157 LazarusPkg.Checked := True;
1158 if Data^.IsDependencyNode then
1159 LazarusPkg.IsDependencyPackage:= True
1160 end
1161 else
1162 LazarusPkg.Checked := False;
1163 end
1164 else if FVST.CheckState[Node] = csUncheckedNormal then
1165 LazarusPkg.Checked := False
1166 end;
1167 end;
1168 Node := FVST.GetNext(Node);
1169 end;
1170 end;
1171
1172 procedure TVisualTree.UpdatePackageStates;
1173 var
1174 Node: PVirtualNode;
1175 Data: PData;
1176 MetaPkg: TMetaPackage;
1177 LazarusPkg: TLazarusPackage;
1178 begin
1179 SerializablePackages.GetPackageStates;
1180 Node := FVST.GetFirst;
1181 while Assigned(Node) do
1182 begin
1183 Data := FVST.GetNodeData(Node);
1184 if (Data^.DataType = 1) then
1185 begin
1186 MetaPkg := SerializablePackages.Items[Data^.PID];
1187 if MetaPkg <> nil then
1188 begin
1189 Data^.PackageState := MetaPkg.PackageState;
1190 Data^.InstallState := SerializablePackages.GetPackageInstallState(MetaPkg);
1191 FVST.ReinitNode(Node, False);
1192 FVST.RepaintNode(Node);
1193 end;
1194 end;
1195 if Data^.DataType = 2 then
1196 begin
1197 LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]);
1198 if LazarusPkg <> nil then
1199 begin
1200 Data^.InstalledVersion := LazarusPkg.InstalledFileVersion;
1201 Data^.PackageState := LazarusPkg.PackageState;
1202 FVST.ReinitNode(Node, False);
1203 FVST.RepaintNode(Node);
1204 end;
1205 end;
1206 Node := FVST.GetNext(Node);
1207 end;
1208 end;
1209
1210 procedure TVisualTree.UpdatePackageUStatus;
1211 var
1212 Node: PVirtualNode;
1213 Data, ParentData: PData;
1214 MetaPkg: TMetaPackage;
1215 LazarusPkg: TLazarusPackage;
1216 begin
1217 if VisualTree = nil then
1218 exit;
1219
1220 Node := FVST.GetFirst;
1221 while Assigned(Node) do
1222 begin
1223 Data := FVST.GetNodeData(Node);
1224 if (Data^.DataType = 1) then
1225 begin
1226 MetaPkg := SerializablePackages.Items[Data^.PID];
1227 if MetaPkg <> nil then
1228 begin
1229 Data^.DownloadZipURL := MetaPkg.DownloadZipURL;
1230 Data^.HasUpdate := MetaPkg.HasUpdate;
1231 Data^.DisableInOPM := MetaPkg.DisableInOPM;
1232 Data^.Rating := MetaPkg.Rating;
1233 FVST.IsDisabled[Node] := Data^.DisableInOPM;
1234 FVST.ReinitNode(Node, False);
1235 FVST.RepaintNode(Node);
1236 end;
1237 end;
1238 if Data^.DataType = 2 then
1239 begin
1240 LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]);
1241 if LazarusPkg <> nil then
1242 begin
1243 Data^.UpdateVersion := LazarusPkg.UpdateVersion;
1244 Data^.HasUpdate := LazarusPkg.HasUpdate;
1245 FVST.IsDisabled[Node] := FVST.IsDisabled[Node^.Parent];
1246 FVST.ReinitNode(Node, False);
1247 FVST.RepaintNode(Node);
1248 end;
1249 end;
1250 if Data^.DataType in [3..20] then
1251 begin
1252 FVST.IsDisabled[Node] := FVST.IsDisabled[Node^.Parent];
1253 ParentData := FVST.GetNodeData(Node^.Parent);
1254 if (Data^.DataType = 3) or (Data^.DataType = 9) then
1255 begin
1256 case Data^.DataType of
1257 3: if ParentData^.InstalledVersion <> '' then
1258 Data^.Description := LazarusPkg.InstalledFileDescription
1259 else
1260 Data^.Description := LazarusPkg.Description;
1261 9: if ParentData^.InstalledVersion <> '' then
1262 Data^.License := LazarusPkg.InstalledFileLincese
1263 else
1264 Data^.License := LazarusPkg.License;
1265 end;
1266 if Assigned(Data^.Button) then
1267 Data^.Button.Enabled := not FVST.IsDisabled[Node];
1268 end;
1269 FVST.ReinitNode(Node, False);
1270 FVST.RepaintNode(Node);
1271 end;
1272 Node := FVST.GetNext(Node);
1273 end;
1274 end;
1275
1276 procedure TVisualTree.VSTBeforeCellPaint(Sender: TBaseVirtualTree;
1277 TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
1278 CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
1279 var
1280 Data: PData;
1281 begin
1282 if Options.UseDefaultTheme then
1283 Exit;
1284 if CellPaintMode = cpmPaint then
1285 begin
1286 Data := Sender.GetNodeData(Node);
1287
1288 if (Data^.DataType = 0) or (Data^.DataType = 1) or (Data^.DataType = 2) then
1289 TargetCanvas.Brush.Color := $00E5E5E5
1290 else
1291 TargetCanvas.Brush.Color := clBtnFace;
1292 TargetCanvas.FillRect(CellRect);
1293 if (Node = Sender.FocusedNode) then
1294 begin
1295 TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor;
1296 if Column = 0 then
1297 TargetCanvas.FillRect(ContentRect)
1298 else
1299 TargetCanvas.FillRect(CellRect);
1300 end
1301 end;
1302 end;
1303
1304 procedure TVisualTree.VSTChecking(Sender: TBaseVirtualTree; Node: PVirtualNode;
1305 var NewState: TCheckState; var Allowed: Boolean);
1306 begin
1307 if FCheckingNodes then
1308 Exit;
1309 if NewState = csUncheckedNormal then
1310 begin
1311 if Assigned(FOnChecking) then
1312 FOnChecking(Self, False);
1313 end
1314 else if NewState = csCheckedNormal then
1315 begin
1316 if IsAllChecked(Node) then
1317 FOnChecking(Self, True);
1318 end;
1319 end;
1320
1321 procedure TVisualTree.VSTChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
1322 begin
1323 if FCheckingNodes then
1324 Exit;
1325 if Assigned(FOnChecked) then
1326 FOnChecked(Self);
1327 end;
1328
1329 procedure TVisualTree.ResetDependencyNodes;
1330 var
1331 Node: PVirtualNode;
1332 Data: PData;
1333 begin
1334 Node := FVST.GetFirst;
1335 while Assigned(Node) do
1336 begin
1337 Data := FVST.GetNodeData(Node);
1338 Data^.IsDependencyNode := False;
1339 Node := FVST.GetNext(Node);
1340 end;
1341 end;
1342
TVisualTree.ResolveDependenciesnull1343 function TVisualTree.ResolveDependencies: TModalResult;
1344 var
1345 Parent, Node, NodeSearch: PVirtualNode;
1346 ParentData, Data, DataSearch: PData;
1347 Msg: String;
1348 PackageList: TObjectList;
1349 PkgFileName: String;
1350 DependencyPkg: TLazarusPackage;
1351 I: Integer;
1352 begin
1353 Result := mrNone;
1354 ResetDependencyNodes;
1355 Node := FVST.GetFirst;
1356 while Assigned(Node) do
1357 begin
1358 if VST.CheckState[Node] = csCheckedNormal then
1359 begin
1360 Data := FVST.GetNodeData(Node);
1361 if Data^.DataType = 2 then
1362 begin
1363 PackageList := TObjectList.Create(True);
1364 try
1365 SerializablePackages.GetPackageDependencies(Data^.LazarusPackageName, PackageList, True, True);
1366 for I := 0 to PackageList.Count - 1 do
1367 begin
1368 PkgFileName := TPackageDependency(PackageList.Items[I]).PkgFileName + '.lpk';
1369 NodeSearch := VST.GetFirst;
1370 while Assigned(NodeSearch) do
1371 begin
1372 if NodeSearch <> Node then
1373 begin
1374 DataSearch := FVST.GetNodeData(NodeSearch);
1375 if DataSearch^.DataType = 2 then
1376 begin
1377 DependencyPkg := TLazarusPackage(SerializablePackages.Items[DataSearch^.PID].LazarusPackages.Items[DataSearch^.PFID]);
1378 if (FVST.CheckState[NodeSearch] <> csCheckedNormal) and
1379 (CompareText(DataSearch^.LazarusPackageName, PkgFileName) = 0) and
1380 ((SerializablePackages.IsDependencyOk(TPackageDependency(PackageList.Items[I]), DependencyPkg)) and
1381 ((not (DependencyPkg.PackageState = psInstalled)) or ((DependencyPkg.PackageState = psInstalled) and (not (SerializablePackages.IsInstalledVersionOk(TPackageDependency(PackageList.Items[I]), DataSearch^.InstalledVersion)))))) then
1382 begin
1383 if (Result = mrNone) or (Result = mrYes) then
1384 begin
1385 Msg := Format(rsMainFrm_rsPackageDependency0, [Data^.LazarusPackageName, DataSearch^.LazarusPackageName]);
1386 Result := MessageDlgEx(Msg, mtConfirmation, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel], TForm(FVST.Parent.Parent));
1387 if Result in [mrNo, mrNoToAll] then
1388 if MessageDlgEx(rsMainFrm_rsPackageDependency1, mtInformation, [mbYes, mbNo], TForm(FVST.Parent.Parent)) <> mrYes then
1389 Exit(mrCancel);
1390 if (Result = mrNoToAll) or (Result = mrCancel) then
1391 Exit(mrCancel);
1392 end;
1393 if Result in [mrYes, mrYesToAll] then
1394 begin
1395 FVST.CheckState[NodeSearch] := csCheckedNormal;
1396 FVST.ReinitNode(NodeSearch, False);
1397 FVST.RepaintNode(NodeSearch);
1398 DataSearch^.IsDependencyNode := True;
1399 Parent := NodeSearch^.Parent;
1400 if Parent <> nil then
1401 begin
1402 ParentData := FVST.GetNodeData(Parent);
1403 ParentData^.IsDependencyNode := True;
1404 end;
1405 end;
1406 end;
1407 end;
1408 end;
1409 NodeSearch := FVST.GetNext(NodeSearch);
1410 end;
1411 end;
1412 finally
1413 PackageList.Free;
1414 end;
1415 end;
1416 end;
1417 Node := FVST.GetNext(Node);
1418 end;
1419 end;
1420
TVisualTree.GetCheckedRepositoryPackagesnull1421 function TVisualTree.GetCheckedRepositoryPackages: Integer;
1422 var
1423 Node: PVirtualNode;
1424 Data: PData;
1425 begin
1426 Result := 0;
1427 Node := FVST.GetFirst;
1428 while Assigned(Node) do
1429 begin
1430 Data := FVST.GetNodeData(Node);
1431 if (Data^.DataType = 1) and ((FVST.CheckState[Node] = csCheckedNormal) or (FVST.CheckState[Node] = csMixedNormal)) then
1432 Inc(Result);
1433 if Result > 1 then
1434 Break;
1435 Node := FVST.GetNext(Node);
1436 end;
1437 end;
1438
1439 procedure TVisualTree.SetupColors;
1440 begin
1441 if not Options.UseDefaultTheme then
1442 begin
1443 FVST.Color := clBtnFace;
1444 FVST.TreeOptions.PaintOptions := FVST.TreeOptions.PaintOptions + [toAlwaysHideSelection];
1445 end else
1446 begin
1447 FVST.Color := clDefault;
1448 FVST.TreeOptions.PaintOptions := FVST.TreeOptions.PaintOptions - [toAlwaysHideSelection];
1449 end;
1450 end;
1451
1452 procedure TVisualTree.AutoAdjustLayout(AXProportion, AYProportion: Double);
1453 begin
1454 FStarSize := round(FStarSize * AXProportion);
1455 end;
1456
1457 procedure TVisualTree.VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
1458 Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
1459 var
1460 Data1: PData;
1461 Data2: PData;
1462 begin
1463 Data1 := Sender.GetNodeData(Node1);
1464 Data2 := Sender.GetNodeData(Node2);
1465 case Column of
1466 0: begin
1467 if (Data1^.DataType = 1) and (Data1^.DataType = 1) then
1468 begin
1469 if (Trim(Data1^.PackageDisplayName) <> '') and (Trim(Data2^.PackageDisplayName) <> '') then
1470 Result := CompareText(Data1^.PackageDisplayName, Data2^.PackageDisplayName)
1471 else
1472 Result := CompareText(Data1^.PackageName, Data2^.PackageName);
1473 end;
1474 if (Data1^.DataType < Data2^.DataType) then
1475 Result := 0
1476 else if (Data1^.DataType > Data2^.DataType) then
1477 Result := 1
1478 else if (Data1^.DataType = 2) and (Data1^.DataType = 2) then
1479 Result := CompareText(Data1^.LazarusPackageName, Data2^.LazarusPackageName);
1480 end;
1481 1: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then
1482 Result := Data2^.InstallState - Data1^.InstallState;
1483 3: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then
1484 Result := Ord(Data2^.HasUpdate) - Ord(Data1^.HasUpdate);
1485 end;
1486 end;
1487
1488 procedure TVisualTree.VSTGetImageIndex(Sender: TBaseVirtualTree;
1489 Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
1490 var Ghosted: Boolean; var ImageIndex: Integer);
1491 var
1492 Data: PData;
1493 begin
1494 Data := FVST.GetNodeData(Node);
1495 if Column = 0 then
1496 begin
1497 case Data^.DataType of
1498 1: if ((Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages)) and
1499 ((not Options.ShowRegularIcons) or ((Options.ShowRegularIcons) and (Data^.InstallState = 0))) then
1500 ImageIndex := 25
1501 else
1502 begin
1503 if Data^.OrphanedPackage = 0 then
1504 ImageIndex := 1
1505 else
1506 ImageIndex := 36;
1507 end;
1508 20: ImageIndex := 10;
1509 21: ImageIndex := 36;
1510 else
1511 ImageIndex := Data^.DataType
1512 end;
1513 end;
1514 end;
1515
GetDisplayStringnull1516 function GetDisplayString(const AStr: String): String;
1517 var
1518 SL: TStringList;
1519 I: Integer;
1520 begin
1521 Result := '';
1522 SL := TStringList.Create;
1523 try
1524 SL.Text := AStr;
1525 for I := 0 to SL.Count - 1 do
1526 if Result = '' then
1527 Result := SL.Strings[I]
1528 else
1529 Result := Result + ' ' + SL.Strings[I];
1530 finally
1531 SL.Free;
1532 end;
1533 end;
1534
1535 procedure TVisualTree.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
1536 Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
1537 var
1538 Data: PData;
1539 begin
1540 Data := FVST.GetNodeData(Node);
1541 if TextType = ttStatic then
1542 begin
1543 if Column = 0 then
1544 begin
1545 if ((Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages)) and
1546 ((not Options.ShowRegularIcons) or ((Options.ShowRegularIcons) and (Data^.InstallState = 0))) and (Data^.DataType = 1) then
1547 CellText := '- ' + FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate)
1548 else
1549 CellText := '';
1550 end
1551 else
1552 CellText := '';
1553 end
1554 else if TextType = ttNormal then
1555 begin
1556 if Column = 0 then
1557 begin
1558 case Data^.DataType of
1559 0: CellText := Data^.Repository;
1560 1: if Trim(Data^.PackageDisplayName) = '' then
1561 CellText := Data^.PackageName
1562 else
1563 CellText := Data^.PackageDisplayName;
1564 2: CellText := Data^.LazarusPackageName;
1565 3: CellText := rsMainFrm_VSTText_Description;
1566 4: CellText := rsMainFrm_VSTText_Author;
1567 5: CellText := rsMainFrm_VSTText_LazCompatibility;
1568 6: CellText := rsMainFrm_VSTText_FPCCompatibility;
1569 7: CellText := rsMainFrm_VSTText_SupportedWidgetsets;
1570 8: CellText := rsMainFrm_VSTText_Packagetype;
1571 9: CellText := rsMainFrm_VSTText_License;
1572 10: CellText := rsMainFrm_VSTText_Dependecies;
1573 11: CellText := rsMainFrm_VSTText_PackageInfo;
1574 12: CellText := rsMainFrm_VSTText_Category;
1575 13: CellText := rsMainFrm_VSTText_RepositoryFilename;
1576 14: CellText := rsMainFrm_VSTText_RepositoryFileSize;
1577 15: CellText := rsMainFrm_VSTText_RepositoryFileHash;
1578 16: CellText := rsMainFrm_VSTText_RepositoryFileDate;
1579 17: CellText := rsMainFrm_VSTText_HomePageURL;
1580 18: CellText := rsMainFrm_VSTText_DownloadURL;
1581 19: CellText := rsMainFrm_VSTText_CommunityDescription;
1582 20: CellText := rsMainFrm_VSTText_ExternalDeps;
1583 21: CellText := rsMainFrm_VSTText_OrphanedPackage1;
1584 end;
1585 end
1586 else if Column = 1 then
1587 begin
1588 case Data^.DataType of
1589 1: case Data^.InstallState of
1590 //0: CellText := rsMainFrm_VSTText_Install0;
1591 1: CellText := rsMainFrm_VSTText_Install1;
1592 2: CellText := rsMainFrm_VSTText_Install2;
1593 end;
1594 2: begin
1595 if Data^.InstalledVersion <> '' then
1596 CellText := Data^.InstalledVersion
1597 else
1598 CellText := '-';
1599 end
1600 else
1601 CellText := '';
1602 end
1603 end
1604 else if Column = 2 then
1605 begin
1606 if Data^.DataType = 2 then
1607 CellText := Data^.Version
1608 else
1609 CellText := '';
1610 end
1611 else if Column = 3 then
1612 begin
1613 case Data^.DataType of
1614 1: if Data^.HasUpdate then
1615 CellText := 'NEW';
1616 2: begin
1617 if (Data^.UpdateVersion <> '') then
1618 CellText := Data^.UpdateVersion
1619 else
1620 CellText := '-';
1621 end
1622 else
1623 CellText := '';
1624 end
1625 end
1626 else if Column = 4 then
1627 begin
1628 case Data^.DataType of
1629 0: CellText := '';
1630 1: CellText := '';
1631 2: case Ord(Data^.PackageState) of
1632 0: CellText := rsMainFrm_VSTText_PackageState0;
1633 1: CellText := rsMainFrm_VSTText_PackageState1;
1634 2: CellText := rsMainFrm_VSTText_PackageState2;
1635 3: begin
1636 if not Data^.HasUpdate then
1637 begin
1638 if (Data^.UpdateVersion = '') then
1639 begin
1640 if Data^.InstalledVersion < Data^.Version then
1641 CellText := rsMainFrm_VSTText_PackageState6
1642 else if Data^.InstalledVersion = Data^.Version then
1643 CellText := rsMainFrm_VSTText_PackageState4
1644 else if Data^.InstalledVersion > Data^.Version then
1645 CellText := rsMainFrm_VSTText_PackageState7
1646 end
1647 else
1648 begin
1649 if Data^.InstalledVersion < Data^.UpdateVersion then
1650 CellText := rsMainFrm_VSTText_PackageState6
1651 else if (Data^.InstalledVersion = Data^.UpdateVersion) then
1652 CellText := rsMainFrm_VSTText_PackageState4
1653 else if (Data^.InstalledVersion > Data^.UpdateVersion) then
1654 CellText := rsMainFrm_VSTText_PackageState7
1655 end;
1656 end
1657 else
1658 begin
1659 if Data^.InstalledVersion < Data^.UpdateVersion then
1660 CellText := rsMainFrm_VSTText_PackageState6
1661 else if Data^.InstalledVersion = Data^.UpdateVersion then
1662 CellText := rsMainFrm_VSTText_PackageState4
1663 else if Data^.InstalledVersion > Data^.UpdateVersion then
1664 CellText := rsMainFrm_VSTText_PackageState7
1665 end;
1666 Data^.IsUpdated := CellText = rsMainFrm_VSTText_PackageState4;
1667 end;
1668 end;
1669 3: CellText := GetDisplayString(Data^.Description);
1670 4: CellText := Data^.Author;
1671 5: CellText := Data^.LazCompatibility;
1672 6: CellText := Data^.FPCCompatibility;
1673 7: CellText := Data^.SupportedWidgetSet;
1674 8: CellText := GetPackageTypeString(Data^.PackageType);
1675 9: CellText := GetDisplayString(Data^.License);
1676 10: CellText := Data^.Dependencies;
1677 11: CellText := '';
1678 12: CellText := TranslateCategories(Data^.Category);
1679 13: CellText := Data^.RepositoryFileName;
1680 14: CellText := FormatSize(Data^.RepositoryFileSize);
1681 15: CellText := Data^.RepositoryFileHash;
1682 16: CellText := FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate);
1683 17: CellText := Data^.HomePageURL;
1684 18: CellText := Data^.DownloadURL;
1685 19: CellText := GetDisplayString(Data^.CommunityDescription);
1686 20: CellText := GetDisplayString(Data^.ExternalDependencies);
1687 21: case Data^.OrphanedPackage of
1688 0: CellText := rsMainFrm_VSTText_Install0;
1689 1: CellText := rsMainFrm_VSTText_Install1;
1690 end;
1691 end;
1692 end
1693 else if Column = 5 then
1694 begin
1695 CellText := '';
1696 end
1697 end;
1698 end;
1699
1700 procedure TVisualTree.VSTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
1701 begin
1702 if (HitInfo.Column <> 0) and (HitInfo.Column <> 1) and (HitInfo.Column <> 3) then
1703 Exit;
1704 if HitInfo.Button = mbLeft then
1705 begin
1706 with Sender, Treeview do
1707 begin
1708 if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
1709 begin
1710 SortColumn := HitInfo.Column;
1711 SortDirection := laz.VirtualTrees.sdAscending;
1712 end
1713 else
1714 begin
1715 if SortDirection = laz.VirtualTrees.sdAscending then
1716 SortDirection := laz.VirtualTrees.sdDescending
1717 else
1718 SortDirection := laz.VirtualTrees.sdAscending;
1719 FSortDir := SortDirection;
1720 end;
1721 SortTree(SortColumn, SortDirection, False);
1722 FSortCol := Sender.SortColumn;
1723 end;
1724 end;
1725 end;
1726
1727 procedure TVisualTree.VSTPaintText(Sender: TBaseVirtualTree;
1728 const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
1729 TextType: TVSTTextType);
1730
GetTextColornull1731 function GetTextColor(const ADefColor: TColor; AIsFocusedNode: Boolean): TColor;
1732 begin
1733 Result := ADefColor;
1734 if Result = clDefault then
1735 Result := Sender.GetDefaultColor(dctFont);
1736 if AIsFocusedNode then
1737 {$IFDEF WINDOWS}
1738 Result := clWhite;
1739 {$ENDIF}
1740 end;
1741
1742 var
1743 Data: PData;
1744 begin
1745 Data := FVST.GetNodeData(Node);
1746 if TextType = ttStatic then
1747 begin
1748 if Column = 0 then
1749 begin
1750 if ((Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages)) and
1751 ((not Options.ShowRegularIcons) or ((Options.ShowRegularIcons) and (Data^.InstallState = 0))) then
1752 TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
1753 TargetCanvas.Font.Color := GetTextColor(FVST.Font.Color, Node = Sender.FocusedNode);
1754 end
1755 end
1756 else if TextType = ttNormal then
1757 begin
1758 case column of
1759 2: begin
1760 if Data^.DataType = 2 then
1761 begin
1762 if (Data^.InstalledVersion = '') or ((Data^.InstalledVersion <> '') and (Data^.InstalledVersion < Data^.Version)) then
1763 TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]
1764 else
1765 TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
1766 end;
1767 TargetCanvas.Font.Color := GetTextColor(FVST.Font.Color, Node = Sender.FocusedNode);
1768 end;
1769 3: begin
1770 case Data^.DataType of
1771 1: TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
1772 2: if (Data^.HasUpdate) and (Data^.UpdateVersion > Data^.InstalledVersion) then
1773 TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]
1774 else
1775 TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
1776 end;
1777 TargetCanvas.Font.Color := GetTextColor(FVST.Font.Color, Node = Sender.FocusedNode);
1778 end;
1779 4: begin
1780 if (FHoverNode = Node) and (FHoverColumn = Column) and ((Data^.DataType = 17) or (Data^.DataType = 18)) then
1781 begin
1782 TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsUnderline];
1783 TargetCanvas.Font.Color := GetTextColor(clBlue, Node = Sender.FocusedNode);
1784 end
1785 else if (Data^.DataType = 2) and (Data^.IsUpdated) then
1786 begin
1787 TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
1788 TargetCanvas.Font.Color := GetTextColor(clGreen, Node = Sender.FocusedNode);
1789 end
1790 else
1791 TargetCanvas.Font.Color := GetTextColor(FVST.Font.Color, Node = Sender.FocusedNode);
1792 end
1793 else
1794 TargetCanvas.Font.Color := GetTextColor(FVST.Font.Color, Node = Sender.FocusedNode);
1795 end;
1796 end
1797 end;
1798
1799 procedure TVisualTree.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
1800 var
1801 Data: PData;
1802 begin
1803 Data := FVST.GetNodeData(Node);
1804 if Assigned(Data^.Button) then
1805 Data^.Button.Visible := False;
1806 Finalize(Data^);
1807 end;
1808
GetColumnnull1809 function TVisualTree.GetColumn(const AX: Integer): Integer;
1810 var
1811 I: Integer;
1812 L, R: Integer;
1813 begin
1814 Result := -1;
1815 for I := 0 to VST.Header.Columns.Count - 1 do
1816 begin
1817 VST.Header.Columns.GetColumnBounds(I, L, R);
1818 if (AX >= L) and (AX <= R) then
1819 begin
1820 Result := I;
1821 Break;
1822 end;
1823 end;
1824 end;
1825
TVisualTree.GetPackageAbsolutePathnull1826 function TVisualTree.GetPackageAbsolutePath(APackageName: String): String;
1827 var
1828 LazarusPkg: TLazarusPackage;
1829 begin
1830 Result := '';
1831 LazarusPkg := SerializablePackages.FindLazarusPackage(APackageName);
1832 if (LazarusPkg <> nil) and (FileExists(LazarusPkg.PackageAbsolutePath)) then
1833 Result := LazarusPkg.PackageAbsolutePath;
1834 end;
1835
1836 procedure TVisualTree.VSTMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1837 var
1838 Data: PData;
1839 ContRect: TRect;
1840 P: TPoint;
1841 Level: Integer;
1842 begin
1843 FHoverColumn := -1;
1844 FHoverP.X := X;
1845 FHoverP.Y := Y;
1846 FHoverNode:= VST.GetNodeAt(X, Y);
1847 FHoverColumn := GetColumn(X);
1848
1849 if (FOldButtonNode <> nil) and (FOldButtonNode <> FHoverNode) then
1850 begin
1851 Data := FVST.GetNodeData(FOldButtonNode);
1852 if Data^.Button <> nil then
1853 begin
1854 Data^.Button.Free;
1855 Data^.Button := nil;
1856 end;
1857 end;
1858
1859 if ((FHoverColumn = 0) or (FShowHintFrm.Visible)) and (FHoverNode <> nil) then
1860 begin
1861 case Options.HintFormOption of
1862 0: begin
1863 if FShowHintFrm.Visible then
1864 FShowHintFrm.SetupTimer(300);
1865 Exit;
1866 end;
1867 1: begin
1868 P.X := X;
1869 P.Y := Y;
1870 ContRect := FVST.GetDisplayRect(FHoverNode, FHoverColumn, False);
1871 Level := FVST.GetNodeLevel(FHoverNode);
1872 if (ssShift in Shift) and PtInRect(ContRect, P) and (Level > 0) then
1873 begin
1874 P := FVST.ClientToScreen(P);
1875 if FShowHintFrm.Visible then
1876 FShowHintFrm.MoveFormTo(P.X, P.Y)
1877 else
1878 FShowHintFrm.ShowFormAt(P.X, P.Y);
1879 case Level of
1880 2: FHoverNode := FHoverNode^.Parent;
1881 3: FHoverNode := FHoverNode^.Parent^.Parent;
1882 end;
1883 if FHoverNode <> FHoverNodeOld then
1884 begin
1885 FShowHintFrm.UpdateInfo(FHoverNode);
1886 FHoverNodeOld := FHoverNode;
1887 end;
1888 end
1889 end;
1890 2: Exit;
1891 end;
1892 end;
1893 if (FHoverColumn = 5) and (FHoverNode <> nil) then
1894 begin
1895 FVST.ReinitNode(FHoverNode, False);
1896 FVST.RepaintNode(FHoverNode);
1897 end
1898 else if (FHoverColumn = 4) and (FHoverNode <> nil) then
1899 begin
1900 Data := VST.GetNodeData(FHoverNode);
1901 if ((Data^.DataType = 17) and (Trim(Data^.HomePageURL) <> '')) or
1902 ((Data^.DataType = 18) and (Trim(Data^.DownloadURL) <> '')) then
1903 FVST.Cursor := crHandPoint;
1904
1905 if (Data^.Button = nil) and
1906 (
1907 ((Data^.DataType = 2) and (Data^.PackageState in [psExtracted, psInstalled]) and (GetPackageAbsolutePath(Data^.LazarusPackageName) <> '')) or
1908 ((Data^.DataType = 3) and (Trim(Data^.Description) <> '')) or
1909 ((Data^.DataType = 9) and (Trim(Data^.License) <> '')) or
1910 ((Data^.DataType = 19) and (Trim(Data^.CommunityDescription) <> '')) or
1911 ((Data^.DataType = 20) and (Trim(Data^.ExternalDependencies) <> ''))
1912 ) then
1913 begin
1914 Data := FVST.GetNodeData(FHoverNode);
1915 Data^.Button := TSpeedButton.Create(VST);
1916 with Data^.Button do
1917 begin
1918 if Data^.DataType = 2 then
1919 begin
1920 Width := 75;
1921 Caption := rsMainFrm_VSTText_Open;
1922 end
1923 else
1924 Caption := '...';
1925 Parent := FVST;
1926 Tag := Data^.ButtonID;
1927 Visible := True;
1928 OnClick := @ButtonClick;
1929 end;
1930 FOldButtonNode := FHoverNode;
1931 end;
1932 end
1933 end;
1934
1935 procedure TVisualTree.VSTMouseEnter(Sender: TObject);
1936 begin
1937 FLeaving := False;
1938 end;
1939
1940 procedure TVisualTree.VSTMouseLeave(Sender: TObject);
1941 begin
1942 if Assigned(FHoverNode) then
1943 begin
1944 FLeaving := True;
1945 FVST.ReinitNode(FHoverNode, False);
1946 FVST.RepaintNode(FHoverNode)
1947 end;
1948 end;
1949
1950 procedure TVisualTree.VSTMouseDown(Sender: TObject; Button: TMouseButton;
1951 Shift: TShiftState; X, Y: Integer);
1952 var
1953 Node: PVirtualNode;
1954 Data: PData;
1955 MenuItem: TMenuItem;
1956 DownColumn: Integer;
1957 R: TRect;
1958 PackageName: String;
1959 MetaPkg: TMetaPackage;
1960 begin
1961 FMouseEnter := True;
1962 Node := FVST.GetNodeAt(X, Y);
1963 if Node <> nil then
1964 begin
1965 DownColumn := GetColumn(X);
1966 Data := FVST.GetNodeData(Node);
1967 if Button = mbLeft then
1968 begin
1969 case DownColumn of
1970 4: if (Data^.DataType = 17) or (Data^.DataType = 18) and (DownColumn = 4) then
1971 begin
1972 FLinkClicked := True;
1973 if (Data^.DataType = 17) and (Trim(Data^.HomePageURL) <> '') then
1974 FLink := Data^.HomePageURL
1975 else if (Data^.DataType = 18) and (Trim(Data^.DownloadURL) <> '') then
1976 FLink := Data^.DownloadURL;
1977 end;
1978 5: begin
1979 if Data^.DataType = 1 then
1980 begin
1981 R := FVST.GetDisplayRect(Node, DownColumn, False);
1982 Data^.Rating := Trunc((FHoverP.X - R.Left - 1)/FStarSize) + 1;
1983 if Data^.Rating > 5 then
1984 Data^.Rating := 5;
1985 MetaPkg := SerializablePackages.Items[Data^.PID];
1986 if MetaPkg <> nil then
1987 MetaPkg.Rating := Data^.Rating;
1988 if Data^.PackageDisplayName <> '' then
1989 PackageName := Data^.PackageDisplayName
1990 else
1991 PackageName := Data^.PackageName;
1992 MessageDlgEx(Format(rsMainFrm_rsPackageRating, [PackageName, InttoStr(Data^.Rating)]), mtInformation, [mbOk], TForm(FVST.Parent.Parent));
1993 end;
1994 end;
1995 end;
1996 end
1997 else if Button = mbRight then
1998 begin
1999 MenuItem := FVST.PopupMenu.Items.Find(rsMainFrm_miCopyToClpBrd);
2000 if MenuItem <> nil then
2001 MenuItem.Enabled := ((Data^.DataType = 17) and (Trim(Data^.HomePageURL) <> '')) or
2002 ((Data^.DataType = 18) and (Trim(Data^.DownloadURL) <> ''));
2003 MenuItem := FVST.PopupMenu.Items.Find(rsMainFrm_miResetRating);
2004 if MenuItem <> nil then
2005 MenuItem.Enabled := (DownColumn = 5) and (Data^.Rating <> 0);
2006 end;
2007 end
2008 end;
2009
2010 procedure TVisualTree.VSTKeyDown(Sender: TObject; var Key: Word;
2011 Shift: TShiftState);
2012 begin
2013 //
2014 end;
2015
2016 procedure TVisualTree.VSTKeyUp(Sender: TObject; var Key: Word;
2017 Shift: TShiftState);
2018 begin
2019 if Key = VK_SHIFT then
2020 if Assigned(FShowHintFrm) and FShowHintFrm.Visible and (Options.HintFormOption = 1) then
2021 FShowHintFrm.SetupTimer(300);
2022 end;
2023
2024 procedure TVisualTree.VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
2025 Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
2026 var HintText: String);
2027 var
2028 Data: PData;
2029 P1, P2: TPoint;
2030 Level: Integer;
2031 begin
2032 Data := FVST.GetNodeData(Node);
2033 if (Column <> 4) and (Column <> 0) then
2034 Exit;
2035 LineBreakStyle := hlbForceSingleLine;
2036 case Data^.DataType of
2037 1: if Options.HintFormOption = 0 then
2038 begin
2039 HintText := '';
2040 P1.X := 0;
2041 P1.Y := 0;
2042 GetCursorPos(P1);
2043 P2 := FVST.ScreenToClient(P1);
2044 Level := FVST.GetNodeLevel(FHoverNode);
2045 if PtInRect(FVST.GetDisplayRect(Node, Column, True), P2) and (Level > 0) then
2046 begin
2047 FShowHintFrm.ShowFormAt(P1.X, P1.Y);
2048 FShowHintFrm.SetupTimer(Application.HintHidePause);
2049 case Level of
2050 2: FHoverNode := FHoverNode^.Parent;
2051 3: FHoverNode := FHoverNode^.Parent^.Parent;
2052 end;
2053 if FHoverNode <> FHoverNodeOld then
2054 begin
2055 FShowHintFrm.UpdateInfo(FHoverNode);
2056 FHoverNodeOld := FHoverNode;
2057 end;
2058 end;
2059 end;
2060 3: HintText := Data^.Description;
2061 4: HintText := Data^.Author;
2062 5: HintText := Data^.LazCompatibility;
2063 6: HintText := Data^.FPCCompatibility;
2064 7: HintText := Data^.SupportedWidgetSet;
2065 8: HintText := GetPackageTypeString(Data^.PackageType);
2066 9: HintText := GetDisplayString(Data^.License);
2067 10: HintText := Data^.Dependencies;
2068 11: HintText := '';
2069 12: HintText := TranslateCategories(Data^.Category);
2070 13: HintText := Data^.RepositoryFileName;
2071 14: HintText := FormatSize(Data^.RepositoryFileSize);
2072 15: HintText := Data^.RepositoryFileHash;
2073 16: HintText := FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate);
2074 17: HintText := Data^.HomePageURL;
2075 18: HintText := Data^.DownloadURL;
2076 19: HintText := Data^.CommunityDescription;
2077 20: HintText := Data^.ExternalDependencies;
2078 else
2079 HintText := '';
2080 end;
2081 end;
2082
2083 procedure TVisualTree.VSTDblClick(Sender: TObject);
2084 var
2085 Data: PData;
2086 Node: PVirtualNode;
2087 begin
2088 Node := FVST.GetFirstSelected;
2089 if (Node <> nil) and (FVST.GetNodeLevel(Node) = 2) then
2090 begin
2091 Data := FVST.GetNodeData(Node);
2092 if (Data^.DataType = 2) and (Data^.PackageState in [psExtracted, psInstalled]) then
2093 DoOpenPackage(Data^.LazarusPackageName);
2094 end;
2095 end;
2096
2097 procedure TVisualTree.VSTScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
2098 begin
2099 if FShowHintFrm.Visible then
2100 FShowHintFrm.Hide;
2101 end;
2102
2103 procedure TVisualTree.VSTIncrementalSearch(Sender: TBaseVirtualTree;
2104 Node: PVirtualNode; const SearchText: String; var Result: Integer);
2105 var
2106 Data: PData;
2107 begin
2108 Data := FVST.GetNodeData(Node);
2109 if FVST.GetNodeLevel(Node) = 1 then
2110 Result := StrLIComp(PChar(SearchText), PChar(Data^.PackageDisplayName), Min(Length(SearchText), Length(Data^.PackageDisplayName)))
2111 else
2112 Result := -1;
2113 end;
2114
2115 procedure TVisualTree.VSTClick(Sender: TObject);
2116 begin
2117 if FLinkClicked then
2118 begin
2119 FLinkClicked := False;
2120 FHoverColumn := -1;
2121 FHoverNode := nil;
2122 if Trim(FLink) <> '' then
2123 OpenURL(FLink);
2124 FLink := '';
2125 end;
2126 end;
2127
2128
2129 end.
2130
2131