{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Balázs Székely Abstract: Implementation of the visual tree, which displays the package sructure downloaded from the remote repository. } unit opkman_visualtree; {$mode objfpc}{$H+} interface uses Classes, SysUtils, contnrs, Math, dateutils, // LCL Controls, Graphics, Menus, Dialogs, Forms, LCLIntf, Buttons, // OpkMan opkman_VirtualTrees, opkman_common, opkman_serializablepackages, opkman_const, opkman_options, opkman_packagedetailsfrm; type PData = ^TData; TData = record DataType: Integer; PID: Integer; PFID: Integer; Repository: String; PackageState: TPackageState; PackageName: String; PackageDisplayName: String; Category: String; LazarusPackageName: String; Version: String; InstalledVersion: String; UpdateVersion: String; Description: String; Author: String; LazCompatibility: String; FPCCompatibility: String; SupportedWidgetSet: String; PackageType: TPackageType; Dependencies: String; License: String; RepositoryFileName: String; RepositoryFileSize: Int64; RepositoryFileHash: String; RepositoryDate: TDate; HomePageURL: String; DownloadURL: String; DownloadZipURL: String; HasUpdate: Boolean; DisableInOPM: Boolean; IsUpdated: Boolean; SVNURL: String; InstallState: Integer; ButtonID: Integer; Button: TSpeedButton; Rating: Integer; end; TFilterBy = (fbPackageName, fbLazarusPackageName, fbPackageCategory, fbPackageState, fbVersion, fbDescription, fbAuthor, fbLazCompatibility, fbFPCCompatibility, fbSupportedWidgetsets, fbPackageType, fbDependecies, fbLicense); { TVisualTree } TOnChecking = procedure(Sender: TObject; const AIsAllChecked: Boolean) of object; TVisualTree = class private FVST: TVirtualStringTree; FHoverNode: PVirtualNode; FHoverP: TPoint; FHoverColumn: Integer; FLink: String; FLinkClicked: Boolean; FSortCol: Integer; FSortDir: opkman_VirtualTrees.TSortDirection; FCheckingNodes: Boolean; FLeaving: Boolean; FOnChecking: TOnChecking; FOnChecked: TNotifyEvent; procedure VSTBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex; {%H-}CellPaintMode: TVTCellPaintMode; CellRect: TRect; var {%H-}ContentRect: TRect); procedure VSTChecking(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode; var NewState: TCheckState; var {%H-}Allowed: Boolean); procedure VSTChecked(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode); procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); procedure VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; {%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean; var ImageIndex: Integer); procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String); procedure VSTHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); procedure VSTPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex; {%H-}TextType: TVSTTextType); procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VSTMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer); procedure VSTMouseEnter(Sender: TObject); procedure VSTMouseLeave(Sender: TObject); procedure VSTMouseDown(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer); procedure VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); procedure VSTAfterCellPaint(Sender: TBaseVirtualTree; {%H-}TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const {%H-}CellRect: TRect); procedure VSTCollapsed(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode); procedure VSTExpanding(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode; var {%H-}Allowed: Boolean); procedure VSTCollapsing(Sender: TBaseVirtualTree; {%H-}Node: PVirtualNode; var {%H-}Allowed: Boolean); procedure VSTDblClick(Sender: TObject); procedure VSTScroll(Sender: TBaseVirtualTree; {%H-}DeltaX, {%H-}DeltaY: Integer); function GetDisplayString(const AStr: String): String; function IsAllChecked(const AChecking: PVirtualNode): Boolean; procedure ButtonClick(Sender: TObject); procedure ShowButtons; procedure HideButtons; procedure DrawStars(ACanvas: TCanvas; AStartIndex: Integer; P: TPoint; AAvarage: Double); function GetColumn(const AX: Integer): Integer; function TranslateCategories(const AStr: String): String; public constructor Create(const AParent: TWinControl; const AImgList: TImageList; APopupMenu: TPopupMenu); destructor Destroy; override; public procedure PopulateTree; procedure CheckNodes(const Checked: Boolean); procedure FilterTree(const AFilterBy: TFilterBy; const AText: String; const AExtraParam: Integer = -1); procedure ResetFilter; procedure ExpandEx; procedure CollapseEx; procedure GetPackageList; procedure UpdatePackageStates; procedure UpdatePackageUStatus; function ResolveDependencies: TModalResult; function GetCheckedRepositoryPackages: Integer; published property OnChecking: TOnChecking read FOnChecking write FOnChecking; property OnChecked: TNotifyEvent read FOnChecked write FOnChecked; property VST: TVirtualStringTree read FVST; end; var VisualTree: TVisualTree = nil; implementation { TVisualTree } constructor TVisualTree.Create(const AParent: TWinControl; const AImgList: TImageList; APopupMenu: TPopupMenu); begin FVST := TVirtualStringTree.Create(nil); with FVST do begin Parent := AParent; Align := alClient; Anchors := [akLeft, akTop, akRight]; Images := AImgList; PopupMenu := APopupMenu; Color := clBtnFace; DefaultNodeHeight := 25; Indent := 22; TabOrder := 1; DefaultText := ''; Header.AutoSizeIndex := 4; Header.Height := 25; with Header.Columns.Add do begin Position := 0; Width := 270; Text := rsMainFrm_VSTHeaderColumn_PackageName; end; with Header.Columns.Add do begin Position := 1; Alignment := taCenter; Width := 90; Options := Options - [coResizable]; Text := rsMainFrm_VSTHeaderColumn_Installed; end; with Header.Columns.Add do begin Position := 2; Alignment := taCenter; Width := 90; Options := Options - [coResizable]; Text := rsMainFrm_VSTHeaderColumn_Repository; end; with Header.Columns.Add do begin Position := 3; Alignment := taCenter; Width := 90; Options := Options - [coResizable]; Text := rsMainFrm_VSTHeaderColumn_Update; end; with Header.Columns.Add do begin Position := 4; Width := 280; Options := Options - [coResizable]; Text := rsMainFrm_VSTHeaderColumn_Data; end; with Header.Columns.Add do begin Position := 5; Alignment := taCenter; Width := 88; Options := Options - [coResizable]; Text := rsMainFrm_VSTHeaderColumn_Rating; end; with Header.Columns.Add do begin Position := 6; Alignment := taCenter; Width := 20; Options := Options - [coResizable]; end; Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoShowSortGlyphs, hoVisible, hoAutoSpring]; {$IFDEF LCLCarbon} Header.Options := Header.Options - [hoShowSortGlyphs]; {$ENDIF} Header.SortColumn := 0; HintMode := hmHint; ShowHint := True; TabOrder := 2; TreeOptions.MiscOptions := [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toWheelPanning]; TreeOptions.PaintOptions := [toHideFocusRect, toAlwaysHideSelection, toPopupMode, toShowButtons, toShowDropmark, toShowRoot, toThemeAware]; TreeOptions.SelectionOptions := [toFullRowSelect, toRightClickSelect]; TreeOptions.StringOptions := [toShowStaticText]; TreeOptions.AutoOptions := [toAutoTristateTracking]; OnBeforeCellPaint := @VSTBeforeCellPaint; OnChecking := @VSTChecking; OnChecked := @VSTChecked; OnCompareNodes := @VSTCompareNodes; OnGetText := @VSTGetText; OnPaintText := @VSTPaintText; OnGetImageIndex := @VSTGetImageIndex; OnHeaderClick := @VSTHeaderClick; OnMouseMove := @VSTMouseMove; OnMouseLeave := @VSTMouseLeave; OnMouseEnter := @VSTMouseEnter; OnMouseDown := @VSTMouseDown; OnDblClick := @VSTDblClick; OnGetHint := @VSTGetHint; OnAfterCellPaint := @VSTAfterCellPaint; OnCollapsed := @VSTCollapsed; OnExpanding := @VSTExpanding; OnCollapsing := @VSTCollapsing; OnScroll := @VSTScroll; OnFreeNode := @VSTFreeNode; end; end; destructor TVisualTree.Destroy; begin FVST.Free; inherited Destroy; end; procedure TVisualTree.PopulateTree; procedure CreateButton(AUniqueID: Integer; AData: PData); begin AData^.Button := TSpeedButton.Create(FVST); AData^.Button.Caption := '...'; AData^.Button.Parent := FVST; AData^.Button.Visible := True; AData^.Button.Tag := AUniqueID; AData^.Button.OnClick := @ButtonClick; AData^.ButtonID := AUniqueID; end; var I, J: Integer; RootNode, Node, ChildNode, GrandChildNode: PVirtualNode; RootData, Data, ChildData, GrandChildData: PData; LazarusPkg: TLazarusPackage; UniqueID: Integer; begin FVST.OnExpanding := nil; FVST.OnCollapsed := nil; FVST.OnCollapsing := nil; try FVST.Clear; FVST.NodeDataSize := SizeOf(TData); UniqueID := 0; //add repository(DataType = 0) RootNode := FVST.AddChild(nil); RootData := FVST.GetNodeData(RootNode); RootData^.Repository := Options.RemoteRepository[Options.ActiveRepositoryIndex]; RootData^.DataType := 0; for I := 0 to SerializablePackages.Count - 1 do begin //add package(DataType = 1) Node := FVST.AddChild(RootNode); Node^.CheckType := ctTriStateCheckBox; Data := FVST.GetNodeData(Node); Data^.PID := I; Data^.PackageName := SerializablePackages.Items[I].Name; Data^.PackageDisplayName := SerializablePackages.Items[I].DisplayName; Data^.PackageState := SerializablePackages.Items[I].PackageState; Data^.InstallState := SerializablePackages.GetPackageInstallState(SerializablePackages.Items[I]); Data^.HasUpdate := SerializablePackages.Items[I].HasUpdate; Data^.DisableInOPM := SerializablePackages.Items[I].DisableInOPM; Data^.Rating := SerializablePackages.Items[I].Rating; Data^.RepositoryDate := SerializablePackages.Items[I].RepositoryDate; FVST.IsDisabled[Node] := Data^.DisableInOPM; Data^.DataType := 1; for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do begin //add LazarusPackages(DataType = 2) LazarusPkg := TLazarusPackage(SerializablePackages.Items[I].LazarusPackages.Items[J]); ChildNode := FVST.AddChild(Node); ChildNode^.CheckType := ctTriStateCheckBox; FVST.IsDisabled[ChildNode] := FVST.IsDisabled[ChildNode^.Parent]; ChildData := FVST.GetNodeData(ChildNode); ChildData^.PID := I; ChildData^.PFID := J; ChildData^.LazarusPackageName := LazarusPkg.Name; ChildData^.InstalledVersion := LazarusPkg.InstalledFileVersion; ChildData^.UpdateVersion := LazarusPkg.UpdateVersion; ChildData^.Version := LazarusPkg.VersionAsString; ChildData^.PackageState := LazarusPkg.PackageState; ChildData^.HasUpdate := LazarusPkg.HasUpdate; ChildData^.DataType := 2; //add description(DataType = 3) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); if ChildData^.InstalledVersion <> '' then GrandChildData^.Description := LazarusPkg.InstalledFileDescription else GrandChildData^.Description := LazarusPkg.Description; GrandChildData^.DataType := 3; Inc(UniqueID); CreateButton(UniqueID, GrandChildData); GrandChildData^.Button.Enabled := not FVST.IsDisabled[GrandChildNode]; //add author(DataType = 4) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.Author := LazarusPkg.Author; GrandChildData^.DataType := 4; //add lazcompatibility(DataType = 5) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.LazCompatibility := LazarusPkg.LazCompatibility; GrandChildData^.DataType := 5; //add fpccompatibility(DataType = 6) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.FPCCompatibility := LazarusPkg.FPCCompatibility; GrandChildData^.DataType := 6; //add widgetset(DataType = 7) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.SupportedWidgetSet := LazarusPkg.SupportedWidgetSet; GrandChildData^.DataType := 7; //add packagetype(DataType = 8) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.PackageType := LazarusPkg.PackageType; GrandChildData^.DataType := 8; //add license(DataType = 9) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); if ChildData^.InstalledVersion <> '' then GrandChildData^.License := LazarusPkg.InstalledFileLincese else GrandChildData^.License := LazarusPkg.License; GrandChildData^.DataType := 9; Inc(UniqueID); CreateButton(UniqueID, GrandChildData); GrandChildData^.Button.Enabled := not FVST.IsDisabled[GrandChildNode]; //add dependencies(DataType = 10) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.Dependencies := LazarusPkg.DependenciesAsString; GrandChildData^.DataType := 10; end; //add miscellaneous(DataType = 11) ChildNode := FVST.AddChild(Node); FVST.IsDisabled[ChildNode] := FVST.IsDisabled[ChildNode^.Parent]; ChildData := FVST.GetNodeData(ChildNode); ChildData^.DataType := 11; //add category(DataType = 12) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.Category := SerializablePackages.Items[I].Category; GrandChildData^.DataType := 12; //add Repository Filename(DataType = 13) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.RepositoryFileName := SerializablePackages.Items[I].RepositoryFileName; GrandChildData^.DataType := 13; //add Repository Filesize(DataType = 14) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.RepositoryFileSize := SerializablePackages.Items[I].RepositoryFileSize; GrandChildData^.DataType := 14; //add Repository Hash(DataType = 15) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.RepositoryFileHash := SerializablePackages.Items[I].RepositoryFileHash; GrandChildData^.DataType := 15; //add Repository Date(DataType = 16) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.RepositoryDate := SerializablePackages.Items[I].RepositoryDate; GrandChildData^.DataType := 16; FVST.Expanded[ChildNode] := True; //add HomePageURL(DataType = 17) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.HomePageURL := SerializablePackages.Items[I].HomePageURL; GrandChildData^.DataType := 17; //add DownloadURL(DataType = 18) GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.DownloadURL := SerializablePackages.Items[I].DownloadURL; GrandChildData^.DataType := 18; //add SVNURL(DataType = 19) {GrandChildNode := FVST.AddChild(ChildNode); FVST.IsDisabled[GrandChildNode] := FVST.IsDisabled[GrandChildNode^.Parent]; GrandChildData := FVST.GetNodeData(GrandChildNode); GrandChildData^.SVNURL := SerializablePackages.Items[I].SVNURL; GrandChildData^.DataType := 19;} end; FVST.SortTree(0, opkman_VirtualTrees.sdAscending); ExpandEx; CollapseEx; finally FVST.OnCollapsing := @VSTCollapsing; FVST.OnCollapsed := @VSTCollapsed; FVST.OnExpanding := @VSTExpanding; end; HideButtons; end; function TVisualTree.IsAllChecked(const AChecking: PVirtualNode): Boolean; var Node: PVirtualNode; begin Result := True; Node := FVST.GetFirst; while Assigned(Node) do begin if (FVST.CheckState[Node] = csUncheckedNormal) and (Node <> AChecking) then begin Result := False; Break; end; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.ButtonClick(Sender: TObject); var Node, ParentNode: PVirtualNode; Data, ParentData: PData; ButtonID: Integer; Text: String; FrmCaption: String; begin ButtonID := (Sender as TSpeedButton).Tag; Node := VST.GetFirst; while Assigned(Node) do begin Data := VST.GetNodeData(Node); if Data^.ButtonID = ButtonID then begin ParentNode := Node^.Parent; ParentData := VST.GetNodeData(ParentNode); case Data^.DataType of 3: begin Text := Data^.Description; FrmCaption := rsMainFrm_VSTText_Desc + ' "' + ParentData^.LazarusPackageName + '"'; end; 9: begin Text := Data^.License; FrmCaption := rsMainFrm_VSTText_Lic + ' "' + ParentData^.LazarusPackageName + '"'; end; end; Break; end; Node := VST.GetNext(Node); end; PackageDetailsFrm := TPackageDetailsFrm.Create(TForm(FVST.Parent.Parent)); try PackageDetailsFrm.Caption := FrmCaption; PackageDetailsFrm.mDetails.Text := Text; PackageDetailsFrm.ShowModal; finally PackageDetailsFrm.Free; end; end; procedure TVisualTree.ShowButtons; var Node: PVirtualNode; Data: PData; R: TRect; Text: String; begin Node := VST.GetFirst; while Assigned(Node) do begin Data := VST.GetNodeData(Node); if Assigned(Data^.Button) then begin case Data^.DataType of 3: Text := Data^.Description; 9: Text := Data^.License; end; R := FVST.GetDisplayRect(Node, 5, false); Data^.Button.Visible := ((R.Bottom > FVST.Top) and (R.Bottom < FVST.Top + FVST.Height)) and (vsVisible in Node^.States) and (Trim(Text) <> ''); FVST.InvalidateNode(Node); end; Node := VST.GetNext(Node); end; end; procedure TVisualTree.HideButtons; var Node: PVirtualNode; Data: PData; begin Node := VST.GetFirst; while Assigned(Node) do begin Data := VST.GetNodeData(Node); if Assigned(Data^.Button) then Data^.Button.Visible := False; Node := VST.GetNext(Node); end; end; function TVisualTree.TranslateCategories(const AStr: String): String; var SL: TStringList; I, J: Integer; Str: String; begin if Categories[0] = CategoriesEng[0] then begin Result := AStr; Exit; end; Result := ''; SL := TStringList.Create; try SL.Delimiter := ','; SL.StrictDelimiter := True; SL.DelimitedText := AStr; for I := 0 to SL.Count - 1 do begin Str := Trim(SL.Strings[I]); for J := 0 to MaxCategories - 1 do begin if Str = CategoriesEng[J] then begin if Result = '' then Result := Categories[J] else Result := Result + ', ' + Categories[J]; Break; end; end; end; finally SL.Free; end; if Result = '' then Result := AStr; end; procedure TVisualTree.VSTScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); begin ShowButtons; end; procedure TVisualTree.VSTCollapsed(Sender: TBaseVirtualTree; Node: PVirtualNode); begin ShowButtons; end; procedure TVisualTree.VSTExpanding(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean); begin HideButtons; end; procedure TVisualTree.VSTCollapsing(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean); begin HideButtons; end; procedure TVisualTree.DrawStars(ACanvas: TCanvas; AStartIndex: Integer; P: TPoint; AAvarage: Double); procedure Draw(const AX, AY: Integer; ATyp, ACnt: Integer); var Bmp: TBitMap; I: Integer; begin Bmp := TBitmap.Create; try Bmp.Width := 16; Bmp.Height := 16; if AStartIndex + ATyp > 25 then ShowMessage('crap'); TImageList(FVST.Images).GetBitmap(AStartIndex + ATyp, Bmp); for I := 0 to ACnt - 1 do ACanvas.Draw(AX + I*16 + 5, AY, Bmp); finally Bmp.Free; end; end; var F: Double; I, X, Y: Integer; Stars, NoStars: Integer; HalfStar: Boolean; begin HalfStar := False; F := Frac(AAvarage); I := Trunc(AAvarage); case CompareValue(F, 0.25, 0.005) of -1: begin Stars := I; NoStars := 5 - Stars; end; 0, 1: begin if CompareValue(F, 0.75, 0.005) = -1 then begin Stars := I; NoStars := 5 - Stars - 1; HalfStar := True; end else begin Stars := I + 1; NoStars := 5 - Stars; end; end; end; X := P.X; Y := P.Y; Draw(X, Y, 0, Stars); Inc(X, Stars*16); if HalfStar then begin Draw(X, Y, 2, 1); Inc(X, 16); end; Draw(X, Y, 1, NoStars); end; procedure TVisualTree.VSTAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const CellRect: TRect); var Data: PData; R: TRect; Text: String; P: TPoint; Stars: Integer; begin if Column = 4 then begin Data := FVST.GetNodeData(Node); if Assigned(Data^.Button) then begin R := FVST.GetDisplayRect(Node, Column, False); Data^.Button.Width := 25; Data^.Button.Left := R.Right - Data^.Button.Width - 1; Data^.Button.Top := R.Top + 1; Data^.Button.Height := R.Bottom - R.Top - 1; case Data^.DataType of 3: Text := Data^.Description; 9: Text := Data^.License; end; Data^.Button.Visible := ((R.Bottom > FVST.Top) and (R.Bottom < FVST.Top + FVST.Height)) and (Trim(Text) <> ''); Data^.Button.Enabled := not FVST.IsDisabled[Node]; end; end else if Column = 5 then begin Data := FVST.GetNodeData(Node); if Data^.DataType = 1 then begin R := FVST.GetDisplayRect(Node, Column, False); P.X := R.Left + 1; P.Y := ((R.Bottom - R.Top - 16) div 2) + 1; if (Node = FHoverNode) and (not FLeaving) and (FHoverP.X >= P.X + 1) and (Abs(FHoverP.X - P.X) <= R.Right - R.Bottom) then begin Stars := Trunc((FHoverP.X - P.X)/16) + 1; if Stars > 5 then Stars := 5; DrawStars(TargetCanvas, 23, P, Stars) end else DrawStars(TargetCanvas, 20, P, Data^.Rating); end end; end; procedure TVisualTree.CheckNodes(const Checked: Boolean); var Node: PVirtualNode; begin FCheckingNodes := True; try Node := FVST.GetFirst; while Assigned(Node) do begin if Checked then FVST.CheckState[Node] := csCheckedNormal else FVST.CheckState[Node] := csUncheckedNormal; Node := FVST.GetNext(Node); end; finally FCheckingNodes := False; end; end; procedure TVisualTree.FilterTree(const AFilterBy: TFilterBy; const AText: String; const AExtraParam: Integer = -1); function IsAtLeastOneChildVisible(const ANode: PVirtualNode): Boolean; var Level: Integer; Node: PVirtualNode; Data: PData; begin Result := False; Level := FVST.GetNodeLevel(ANode); Node := FVST.GetFirstChild(ANode); while Assigned(Node) do begin Data := FVST.GetNodeData(Node); case Level of 0: if (vsVisible in Node^.States) then begin Result := True; Break; end; 1: if (vsVisible in Node^.States) and (Data^.DataType = 2) then begin Result := True; Break; end; end; Node := FVST.GetNextSibling(Node); end; end; procedure HideShowParentNodes(const ANode: PVirtualNode; AShow: Boolean); var Level: Integer; RepositoryNode, PackageNode, LazarusPkgNode: PVirtualNode; begin RepositoryNode := nil; PackageNode := nil; LazarusPkgNode := nil; Level := FVST.GetNodeLevel(ANode); case Level of 1: begin RepositoryNode := ANode^.Parent; PackageNode := ANode; end; 2: begin RepositoryNode := ANode^.Parent^.Parent; PackageNode := ANode^.Parent; LazarusPkgNode := ANode; end; 3: begin RepositoryNode := ANode^.Parent^.Parent^.Parent; PackageNode := ANode^.Parent^.Parent; LazarusPkgNode := ANode^.Parent; end; end; if Level = 1 then begin if AShow then FVST.IsVisible[RepositoryNode] := True else if not IsAtLeastOneChildVisible(RepositoryNode) then FVST.IsVisible[RepositoryNode] := False; end else if Level = 2 then begin if AShow then begin FVST.IsVisible[PackageNode] := True; FVST.IsVisible[RepositoryNode] := True; end else begin if not IsAtLeastOneChildVisible(PackageNode) then begin FVST.IsVisible[PackageNode] := False; HideShowParentNodes(PackageNode, AShow); end; end; end else if Level = 3 then begin if AShow then begin FVST.IsVisible[LazarusPkgNode] := True; FVST.IsVisible[PackageNode] := True; FVST.IsVisible[RepositoryNode] := True; end else begin FVST.IsVisible[LazarusPkgNode] := False; HideShowParentNodes(LazarusPkgNode, AShow); end; end; end; procedure FilterNode(Node: PVirtualNode; ADataText: String); var P: Integer; begin P := Pos(UpperCase(AText), UpperCase(ADataText)); if P > 0 then FVST.IsVisible[Node] := True else FVST.IsVisible[Node] := False; if AText = 'PackageCategory' then //special case for categories begin if (P > 0) then begin FVST.IsVisible[Node^.Parent^.Parent] := True; FVST.IsVisible[Node^.Parent^.Parent^.Parent] := True; end else begin FVST.IsVisible[Node^.Parent^.Parent] := False; if not IsAtLeastOneChildVisible(Node^.Parent^.Parent^.Parent) then FVST.IsVisible[Node^.Parent^.Parent^.Parent] := False end; end else HideShowParentNodes(Node, P > 0) end; var Node: PVirtualNode; Data: PData; begin Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); case AFilterBy of fbPackageName: begin if (Data^.DataType = 1) then FilterNode(Node, Data^.PackageName); end; fbLazarusPackageName: begin if (Data^.DataType = 2) then FilterNode(Node, Data^.LazarusPackageName); end; fbPackageCategory: begin if Data^.DataType = 12 then begin if Pos(UpperCase(CategoriesEng[AExtraParam]), UpperCase(Data^.Category)) > 0 then FilterNode(Node, 'PackageCategory') else FilterNode(Node, '') end; end; fbPackageState: begin if Data^.DataType = 2 then begin if Data^.PackageState = TPackageState(AExtraParam) then FilterNode(Node, 'PackageState') else FilterNode(Node, ''); end; end; fbVersion: begin if Data^.DataType = 2 then FilterNode(Node, Data^.Version); end; fbDescription: begin if Data^.DataType = 3 then FilterNode(Node, Data^.Description); end; fbAuthor: begin if Data^.DataType = 4 then FilterNode(Node, Data^.Author); end; fbLazCompatibility: begin if Data^.DataType = 5 then FilterNode(Node, Data^.LazCompatibility); end; fbFPCCompatibility: begin if Data^.DataType = 6 then FilterNode(Node, Data^.FPCCompatibility); end; fbSupportedWidgetsets: begin if Data^.DataType = 7 then FilterNode(Node, Data^.SupportedWidgetSet); end; fbPackageType: begin if Data^.DataType = 8 then begin if Data^.PackageType = TPackageType(AExtraParam) then FilterNode(Node, 'PackageType') else FilterNode(Node, ''); end; end; fbLicense: begin if Data^.DataType = 9 then FilterNode(Node, Data^.License); end; fbDependecies: begin if Data^.DataType = 10 then FilterNode(Node, Data^.Dependencies); end; end; Node := FVST.GetNext(Node); end; HideButtons; Node := FVST.GetFirst; if Node <> nil then FVST.TopNode := Node; end; procedure TVisualTree.ResetFilter; var Node: PVirtualNode; begin Node := FVST.GetFirst; while Assigned(Node) do begin FVST.IsVisible[Node] := True; Node := FVST.GetNext(Node); end; Node := FVST.GetFirst; HideButtons; CollapseEx; if Node <> nil then FVST.TopNode := Node; end; procedure TVisualTree.ExpandEx; var Node: PVirtualNode; Data: PData; begin Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if (Data^.DataType = 0) or (Data^.DataType = 1) or (Data^.DataType = 11) then VST.Expanded[Node] := True; Node := FVST.GetNext(Node); end; Node := FVST.GetFirst; if Node <> nil then FVST.TopNode := Node; end; procedure TVisualTree.CollapseEx; var Node: PVirtualNode; Data: PData; begin FVST.FullCollapse; Node := FVST.GetFirst(True); while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if (Data^.DataType = 0) or (Data^.DataType = 11) then VST.Expanded[Node] := True; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.GetPackageList; var Node: PVirtualNode; Data: PData; Package: TPackage; LazarusPkg: TLazarusPackage; begin Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if Data^.DataType = 1 then begin Package := SerializablePackages.Items[Data^.PID]; if Package <> nil then begin if (FVST.CheckState[Node] = csCheckedNormal) or (FVST.CheckState[Node] = csMixedNormal) then Package.Checked := True else if FVST.CheckState[Node] = csUncheckedNormal then Package.Checked := False end; end; if Data^.DataType = 2 then begin LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]); if LazarusPkg <> nil then begin if FVST.CheckState[Node] = csCheckedNormal then LazarusPkg.Checked := True else if FVST.CheckState[Node] = csUncheckedNormal then LazarusPkg.Checked := False end; end; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.UpdatePackageStates; var Node: PVirtualNode; Data: PData; Package: TPackage; LazarusPkg: TLazarusPackage; begin SerializablePackages.GetPackageStates; Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if (Data^.DataType = 1) then begin Package := SerializablePackages.Items[Data^.PID]; if Package <> nil then begin Data^.PackageState := Package.PackageState; Data^.InstallState := SerializablePackages.GetPackageInstallState(Package); FVST.ReinitNode(Node, False); FVST.RepaintNode(Node); end; end; if Data^.DataType = 2 then begin LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]); if LazarusPkg <> nil then begin Data^.InstalledVersion := LazarusPkg.InstalledFileVersion; Data^.PackageState := LazarusPkg.PackageState; FVST.ReinitNode(Node, False); FVST.RepaintNode(Node); end; end; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.UpdatePackageUStatus; var Node: PVirtualNode; Data, ParentData: PData; Package: TPackage; LazarusPkg: TLazarusPackage; begin Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if (Data^.DataType = 1) then begin Package := SerializablePackages.Items[Data^.PID]; if Package <> nil then begin Data^.DownloadZipURL := Package.DownloadZipURL; Data^.HasUpdate := Package.HasUpdate; Data^.DisableInOPM := Package.DisableInOPM; Data^.Rating := Package.Rating; FVST.IsDisabled[Node] := Data^.DisableInOPM; FVST.ReinitNode(Node, False); FVST.RepaintNode(Node); end; end; if Data^.DataType = 2 then begin LazarusPkg := TLazarusPackage(SerializablePackages.Items[Data^.PID].LazarusPackages.Items[Data^.PFID]); if LazarusPkg <> nil then begin Data^.UpdateVersion := LazarusPkg.UpdateVersion; Data^.HasUpdate := LazarusPkg.HasUpdate; FVST.IsDisabled[Node] := FVST.IsDisabled[Node^.Parent]; FVST.ReinitNode(Node, False); FVST.RepaintNode(Node); end; end; if Data^.DataType in [3..19] then begin FVST.IsDisabled[Node] := FVST.IsDisabled[Node^.Parent]; ParentData := FVST.GetNodeData(Node^.Parent); if (Data^.DataType = 3) or (Data^.DataType = 9) then begin case Data^.DataType of 3: if ParentData^.InstalledVersion <> '' then Data^.Description := LazarusPkg.InstalledFileDescription else Data^.Description := LazarusPkg.Description; 9: if ParentData^.InstalledVersion <> '' then Data^.License := LazarusPkg.InstalledFileLincese else Data^.License := LazarusPkg.License; end; if Assigned(Data^.Button) then Data^.Button.Enabled := not FVST.IsDisabled[Node]; end; FVST.ReinitNode(Node, False); FVST.RepaintNode(Node); end; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.VSTBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); var Data: PData; begin if CellPaintMode = cpmPaint then begin Data := Sender.GetNodeData(Node); if (Data^.DataType = 0) or (Data^.DataType = 1) or (Data^.DataType = 2) then TargetCanvas.Brush.Color := $00E5E5E5 else TargetCanvas.Brush.Color := clBtnFace; TargetCanvas.FillRect(CellRect); if (Node = Sender.FocusedNode) then begin TargetCanvas.Brush.Color := FVST.Colors.FocusedSelectionColor; if Column = 0 then TargetCanvas.FillRect(ContentRect) else TargetCanvas.FillRect(CellRect); end end; end; procedure TVisualTree.VSTChecking(Sender: TBaseVirtualTree; Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean); begin if FCheckingNodes then Exit; if NewState = csUncheckedNormal then begin if Assigned(FOnChecking) then FOnChecking(Self, False); end else if NewState = csCheckedNormal then begin if IsAllChecked(Node) then FOnChecking(Self, True); end; end; procedure TVisualTree.VSTChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); begin if FCheckingNodes then Exit; if Assigned(FOnChecked) then FOnChecked(Self); end; function TVisualTree.ResolveDependencies: TModalResult; var Node, NodeSearch: PVirtualNode; Data, DataSearch: PData; Msg: String; PackageList: TObjectList; PkgFileName: String; DependencyPkg: TLazarusPackage; I: Integer; begin Result := mrNone; Node := FVST.GetFirst; while Assigned(Node) do begin if VST.CheckState[Node] = csCheckedNormal then begin Data := FVST.GetNodeData(Node); if Data^.DataType = 2 then begin PackageList := TObjectList.Create(True); try SerializablePackages.GetPackageDependencies(Data^.LazarusPackageName, PackageList, True, True); for I := 0 to PackageList.Count - 1 do begin PkgFileName := TPackageDependency(PackageList.Items[I]).PkgFileName + '.lpk'; NodeSearch := VST.GetFirst; while Assigned(NodeSearch) do begin if NodeSearch <> Node then begin DataSearch := FVST.GetNodeData(NodeSearch); if DataSearch^.DataType = 2 then begin DependencyPkg := TLazarusPackage(SerializablePackages.Items[DataSearch^.PID].LazarusPackages.Items[DataSearch^.PFID]); if (FVST.CheckState[NodeSearch] <> csCheckedNormal) and (UpperCase(DataSearch^.LazarusPackageName) = UpperCase(PkgFileName)) and ((SerializablePackages.IsDependencyOk(TPackageDependency(PackageList.Items[I]), DependencyPkg)) and ((not (DependencyPkg.PackageState = psInstalled)) or ((DependencyPkg.PackageState = psInstalled) and (not (SerializablePackages.IsInstalledVersionOk(TPackageDependency(PackageList.Items[I]), DataSearch^.InstalledVersion)))))) then begin if (Result = mrNone) or (Result = mrYes) then begin Msg := Format(rsMainFrm_rsPackageDependency0, [Data^.LazarusPackageName, DataSearch^.LazarusPackageName]); Result := MessageDlgEx(Msg, mtConfirmation, [mbYes, mbYesToAll, mbNo, mbNoToAll, mbCancel], TForm(FVST.Parent.Parent)); if Result in [mrNo, mrNoToAll] then MessageDlgEx(rsMainFrm_rsPackageDependency1, mtInformation, [mbOk], TForm(FVST.Parent.Parent)); if (Result = mrNoToAll) or (Result = mrCancel) then Exit; end; if Result in [mrYes, mrYesToAll] then begin FVST.CheckState[NodeSearch] := csCheckedNormal; FVST.ReinitNode(NodeSearch, False); FVST.RepaintNode(NodeSearch); end; end; end; end; NodeSearch := FVST.GetNext(NodeSearch); end; end; finally PackageList.Free; end; end; end; Node := FVST.GetNext(Node); end; end; function TVisualTree.GetCheckedRepositoryPackages: Integer; var Node: PVirtualNode; Data: PData; begin Result := 0; Node := FVST.GetFirst; while Assigned(Node) do begin Data := FVST.GetNodeData(Node); if (Data^.DataType = 1) and ((FVST.CheckState[Node] = csCheckedNormal) or (FVST.CheckState[Node] = csMixedNormal)) then Inc(Result); if Result > 1 then Break; Node := FVST.GetNext(Node); end; end; procedure TVisualTree.VSTCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); var Data1: PData; Data2: PData; begin Data1 := Sender.GetNodeData(Node1); Data2 := Sender.GetNodeData(Node2); case Column of 0: begin if (Data1^.DataType = 1) and (Data1^.DataType = 1) then Result := CompareText(Data1^.PackageName, Data2^.PackageName); if (Data1^.DataType < Data2^.DataType) then Result := 0 else if (Data1^.DataType > Data2^.DataType) then Result := 1 else if (Data1^.DataType = 2) and (Data1^.DataType = 2) then Result := CompareText(Data1^.LazarusPackageName, Data2^.LazarusPackageName); end; 1: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then Result := Data2^.InstallState - Data1^.InstallState; 3: if (Data1^.DataType = 1) and (Data1^.DataType = 1) then Result := Ord(Data2^.HasUpdate) - Ord(Data1^.HasUpdate); end; end; procedure TVisualTree.VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); var Data: PData; begin Data := FVST.GetNodeData(Node); if Column = 0 then begin case Data^.DataType of 1: if (Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages) then ImageIndex := 25 else ImageIndex := 1; else ImageIndex := Data^.DataType end; end; end; function TVisualTree.GetDisplayString(const AStr: String): String; var SL: TStringList; I: Integer; begin Result := ''; SL := TStringList.Create; try SL.Text := AStr; for I := 0 to SL.Count - 1 do if Result = '' then Result := SL.Strings[I] else Result := Result + ' ' + SL.Strings[I]; finally SL.Free; end; end; procedure TVisualTree.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); var Data: PData; begin Data := FVST.GetNodeData(Node); if TextType = ttStatic then begin if Column = 0 then begin if (Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages) then CellText := '- ' + FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate) else CellText := ''; end else CellText := ''; end else if TextType = ttNormal then begin if Column = 0 then begin case Data^.DataType of 0: CellText := Data^.Repository; 1: if Trim(Data^.PackageDisplayName) = '' then CellText := Data^.PackageName else CellText := Data^.PackageDisplayName; 2: CellText := Data^.LazarusPackageName; 3: CellText := rsMainFrm_VSTText_Description; 4: CellText := rsMainFrm_VSTText_Author; 5: CellText := rsMainFrm_VSTText_LazCompatibility; 6: CellText := rsMainFrm_VSTText_FPCCompatibility; 7: CellText := rsMainFrm_VSTText_SupportedWidgetsets; 8: CellText := rsMainFrm_VSTText_Packagetype; 9: CellText := rsMainFrm_VSTText_License; 10: CellText := rsMainFrm_VSTText_Dependecies; 11: CellText := rsMainFrm_VSTText_PackageInfo; 12: CellText := rsMainFrm_VSTText_Category; 13: CellText := rsMainFrm_VSTText_RepositoryFilename; 14: CellText := rsMainFrm_VSTText_RepositoryFileSize; 15: CellText := rsMainFrm_VSTText_RepositoryFileHash; 16: CellText := rsMainFrm_VSTText_RepositoryFileDate; 17: CellText := rsMainFrm_VSTText_HomePageURL; 18: CellText := rsMainFrm_VSTText_DownloadURL; 19: CellText := rsMainFrm_VSTText_SVNURL; end; end else if Column = 1 then begin case Data^.DataType of 1: case Data^.InstallState of //0: CellText := rsMainFrm_VSTText_Install0; 1: CellText := rsMainFrm_VSTText_Install1; 2: CellText := rsMainFrm_VSTText_Install2; end; 2: begin if Data^.InstalledVersion <> '' then CellText := Data^.InstalledVersion else CellText := '-'; end else CellText := ''; end end else if Column = 2 then begin if Data^.DataType = 2 then CellText := Data^.Version else CellText := ''; end else if Column = 3 then begin case Data^.DataType of 1: if Data^.HasUpdate then CellText := 'NEW'; 2: begin if (Data^.InstalledVersion <> '') and (Data^.UpdateVersion <> '') then CellText := Data^.UpdateVersion else CellText := '-'; end else CellText := ''; end end else if Column = 4 then begin case Data^.DataType of 0: CellText := ''; 1: CellText := ''; 2: case Ord(Data^.PackageState) of 0: CellText := rsMainFrm_VSTText_PackageState0; 1: CellText := rsMainFrm_VSTText_PackageState1; 2: CellText := rsMainFrm_VSTText_PackageState2; 3: begin if not Data^.HasUpdate then begin if (Data^.UpdateVersion = '') then begin if Data^.InstalledVersion >= Data^.Version then CellText := rsMainFrm_VSTText_PackageState4 else CellText := rsMainFrm_VSTText_PackageState5 end else begin if (Data^.InstalledVersion >= Data^.UpdateVersion) then CellText := rsMainFrm_VSTText_PackageState4 else CellText := rsMainFrm_VSTText_PackageState6 end; end else CellText := rsMainFrm_VSTText_PackageState6; Data^.IsUpdated := CellText = rsMainFrm_VSTText_PackageState4; end; end; 3: CellText := GetDisplayString(Data^.Description); 4: CellText := Data^.Author; 5: CellText := Data^.LazCompatibility; 6: CellText := Data^.FPCCompatibility; 7: CellText := Data^.SupportedWidgetSet; 8: case Data^.PackageType of ptRunAndDesignTime: CellText := rsMainFrm_VSTText_PackageType0; ptDesignTime: CellText := rsMainFrm_VSTText_PackageType1; ptRunTime: CellText := rsMainFrm_VSTText_PackageType2; ptRunTimeOnly: CellText := rsMainFrm_VSTText_PackageType3; end; 9: CellText := GetDisplayString(Data^.License); 10: CellText := Data^.Dependencies; 11: CellText := ''; 12: CellText := TranslateCategories(Data^.Category); 13: CellText := Data^.RepositoryFileName; 14: CellText := FormatSize(Data^.RepositoryFileSize); 15: CellText := Data^.RepositoryFileHash; 16: CellText := FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate); 17: CellText := Data^.HomePageURL; 18: CellText := Data^.DownloadURL; 19: CellText := Data^.SVNURL; end; end else if Column = 5 then begin CellText := ''; end end; end; procedure TVisualTree.VSTHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Column <> 0) and (Column <> 1) and (Column <> 3) then Exit; if Button = mbLeft then begin with Sender, Treeview do begin if (SortColumn = NoColumn) or (SortColumn <> Column) then begin SortColumn := Column; SortDirection := opkman_VirtualTrees.sdAscending; end else begin if SortDirection = opkman_VirtualTrees.sdAscending then SortDirection := opkman_VirtualTrees.sdDescending else SortDirection := opkman_VirtualTrees.sdAscending; FSortDir := SortDirection; end; SortTree(SortColumn, SortDirection, False); FSortCol := Sender.SortColumn; end; end; end; procedure TVisualTree.VSTPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var Data: PData; begin Data := FVST.GetNodeData(Node); if TextType = ttStatic then begin if Column = 0 then begin if (Options.DaysToShowNewPackages > 0) and (DaysBetween(Now, Data^.RepositoryDate) <= Options.DaysToShowNewPackages) then TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold]; if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clBlack else TargetCanvas.Font.Color := clWhite; end end else if TextType = ttNormal then begin case column of 2: begin if Data^.DataType = 2 then begin if (Data^.InstalledVersion = '') or ((Data^.InstalledVersion <> '') and (Data^.InstalledVersion < Data^.Version)) then TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold] else TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold]; end; if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clBlack else TargetCanvas.Font.Color := clWhite; end; 3: begin case Data^.DataType of 1: TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; 2: if Data^.HasUpdate then TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold] else TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold]; end; if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clBlack else TargetCanvas.Font.Color := clWhite; end; 4: begin if (FHoverNode = Node) and (FHoverColumn = Column) and ((Data^.DataType = 17) or (Data^.DataType = 18)) then begin TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsUnderline]; if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clBlue else TargetCanvas.Font.Color := clWhite; end else if (Data^.DataType = 2) and (Data^.IsUpdated) then begin TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clGreen else TargetCanvas.Font.Color := clWhite; end else begin if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := clBlack else TargetCanvas.Font.Color := clWhite; end; end else begin if Node <> Sender.FocusedNode then TargetCanvas.Font.Color := FVST.Font.Color else TargetCanvas.Font.Color := clWhite; end; end; end end; procedure TVisualTree.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var Data: PData; begin Data := FVST.GetNodeData(Node); if Assigned(Data^.Button) then Data^.Button.Visible := False; Finalize(Data^); end; function TVisualTree.GetColumn(const AX: Integer): Integer; var I: Integer; L, R: Integer; begin Result := -1; for I := 0 to VST.Header.Columns.Count - 1 do begin VST.Header.Columns.GetColumnBounds(I, L, R); if (AX >= L) and (AX <= R) then begin Result := I; Break; end; end; end; procedure TVisualTree.VSTMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin FHoverColumn := -1; FHoverP.X := X; FHoverP.Y := Y; FHoverNode:= VST.GetNodeAt(X, Y); FHoverColumn := GetColumn(X); if (FHoverColumn = 5) and (FHoverNode <> nil) then begin FVST.ReinitNode(FHoverNode, False); FVST.RepaintNode(FHoverNode); end; end; procedure TVisualTree.VSTMouseEnter(Sender: TObject); begin FLeaving := False; end; procedure TVisualTree.VSTMouseLeave(Sender: TObject); begin if Assigned(FHoverNode) then begin FLeaving := True; FVST.ReinitNode(FHoverNode, False); FVST.RepaintNode(FHoverNode) end; end; procedure TVisualTree.VSTMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Node: PVirtualNode; Data: PData; MenuItem: TMenuItem; DownColumn: Integer; R: TRect; PackageName: String; Package: TPackage; begin Node := FVST.GetNodeAt(X, Y); if Node <> nil then begin DownColumn := GetColumn(X); Data := FVST.GetNodeData(Node); if Button = mbLeft then begin case DownColumn of 4: if (Data^.DataType = 17) or (Data^.DataType = 18) and (DownColumn = 4) then begin FLinkClicked := True; if (Data^.DataType = 17) and (Trim(Data^.HomePageURL) <> '') then FLink := Data^.HomePageURL else if (Data^.DataType = 18) and (Trim(Data^.DownloadURL) <> '') then FLink := Data^.DownloadURL; end; 5: begin R := FVST.GetDisplayRect(Node, DownColumn, False); Data^.Rating := Trunc((FHoverP.X - R.Left - 1)/16) + 1; if Data^.Rating > 5 then Data^.Rating := 5; Package := SerializablePackages.Items[Data^.PID]; if Package <> nil then Package.Rating := Data^.Rating; if Data^.PackageDisplayName <> '' then PackageName := Data^.PackageDisplayName else PackageName := Data^.PackageName; MessageDlgEx(Format(rsMainFrm_rsPackageRating, [PackageName, InttoStr(Data^.Rating)]), mtInformation, [mbOk], TForm(FVST.Parent.Parent)); end; end; end else if Button = mbRight then begin MenuItem := FVST.PopupMenu.Items.Find(rsMainFrm_miCopyToClpBrd); if MenuItem <> nil then MenuItem.Enabled := ((Data^.DataType = 17) and (Trim(Data^.HomePageURL) <> '')) or ((Data^.DataType = 18) and (Trim(Data^.DownloadURL) <> '')); MenuItem := FVST.PopupMenu.Items.Find(rsMainFrm_miResetRating); if MenuItem <> nil then MenuItem.Enabled := (DownColumn = 5) and (Data^.Rating <> 0); end; end end; procedure TVisualTree.VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); var Data: PData; begin Data := FVST.GetNodeData(Node); if (Column <> 4) then Exit; LineBreakStyle := hlbForceSingleLine; case Data^.DataType of 3: HintText := Data^.Description; 4: HintText := Data^.Author; 5: HintText := Data^.LazCompatibility; 6: HintText := Data^.FPCCompatibility; 7: HintText := Data^.SupportedWidgetSet; 8: case Data^.PackageType of ptRunAndDesignTime: HintText := rsMainFrm_VSTText_PackageType0; ptDesignTime: HintText := rsMainFrm_VSTText_PackageType1; ptRunTime: HintText := rsMainFrm_VSTText_PackageType2; ptRunTimeOnly: HintText := rsMainFrm_VSTText_PackageType3; end; 9: HintText := GetDisplayString(Data^.License); 10: HintText := Data^.Dependencies; 11: HintText := ''; 12: HintText := TranslateCategories(Data^.Category); 13: HintText := Data^.RepositoryFileName; 14: HintText := FormatSize(Data^.RepositoryFileSize); 15: HintText := Data^.RepositoryFileHash; 16: HintText := FormatDateTime('YYYY.MM.DD', Data^.RepositoryDate); 17: HintText := Data^.HomePageURL; 18: HintText := Data^.DownloadURL; 19: HintText := Data^.SVNURL; else HintText := ''; end; end; procedure TVisualTree.VSTDblClick(Sender: TObject); begin if FLinkClicked then begin FLinkClicked := False; FHoverColumn := -1; FHoverNode := nil; OpenURL(FLink); end; end; end.