paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 12:40:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

Opkman: Warn user if a package is incompatible with the current system.

Browse Source 
git-svn-id: trunk@61324 -
This commit is contained in:
balazs 2019-06-06 10:02:56 +00:00
parent a9c11db3de
commit 3791e9a6da
13 changed files with 681 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/onlinepackagemanager/opkman_categoriesfrm.lfm
View File

@ -1,12 +1,12 @@
object CategoriesFrm: TCategoriesFrm
Left = 520
Height = 383
Height = 411
Top = 265
Width = 345
Width = 341
BorderIcons = [biSystemMenu]
Caption = 'CategoriesFrm'
ClientHeight = 383
ClientWidth = 345
ClientHeight = 411
ClientWidth = 341
KeyPreview = True
OnClose = FormClose
OnCreate = FormCreate
@ -19,17 +19,17 @@ object CategoriesFrm: TCategoriesFrm
Left = 0
Height = 47
Top = 0
Width = 345
Width = 341
Align = alTop
BevelOuter = bvNone
ClientHeight = 47
ClientWidth = 345
ClientWidth = 341
TabOrder = 0
object lbMessage: TLabel
Left = 11
Height = 15
Top = 11
Width = 323
Width = 319
Anchors = [akTop, akLeft, akRight]
Caption = 'lbMessage'
ParentColor = False
@ -37,11 +37,11 @@ object CategoriesFrm: TCategoriesFrm
OnResize = lbMessageResize
end
end
object ButtonPanel1: TButtonPanel
object BP: TButtonPanel
Left = 6
Height = 34
Top = 343
Width = 333
Top = 371
Width = 329
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
OKButton.OnClick = bOkClick

137
components/onlinepackagemanager/opkman_categoriesfrm.pas
View File

@ -31,15 +31,15 @@ uses
Classes, SysUtils,
// LCL
Forms, Controls, Graphics, ExtCtrls, StdCtrls, ButtonPanel, laz.VirtualTrees,
LCLPlatformDef,
// OpkMan
opkman_const, opkman_common, opkman_options, opkman_maindm;
type
{ TCategoriesFrm }
TCategoriesFrm = class(TForm)
ButtonPanel1: TButtonPanel;
BP: TButtonPanel;
lbMessage: TLabel;
pnMessage: TPanel;
procedure bOkClick(Sender: TObject);
@ -52,6 +52,9 @@ type
FVST: TLazVirtualStringTree;
FModRes: TModalResult;
FCategoriesCSV: String;
FLazCompatibility: String;
FFPCCompatibility: String;
FSupportedWidgetSets: String;
FLineAdded: Boolean;
procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; {%H-}TextType: TVSTTextType; var CellText: String);
@ -63,9 +66,12 @@ type
procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
function CheckNode(const AName: String): Boolean;
public
procedure SetupControls;
procedure PopulateTree;
procedure SetupControls(const AType: Integer);
procedure PopulateTree(const AType: Integer);
property CategoriesCSV: String read FCategoriesCSV write FCategoriesCSV;
property LazCompatibility: String read FLazCompatibility write FLazCompatibility;
property FPCCompatibility: String read FFPCCompatibility write FFPCCompatibility;
property SupportedWidgetSets: String read FSupportedWidgetSets write FSupportedWidgetSets;
end;
var
@ -98,16 +104,41 @@ var
Data: PData;
begin
FCategoriesCSV := '';
FLazCompatibility := '';
FFPCCompatibility := '';
FSupportedWidgetSets := '';
Node := FVST.GetFirst;
while Assigned(Node) do
begin
Data := FVST.GetNodeData(Node);
if FVST.CheckState[Node] = csCheckedNormal then
begin
if FCategoriesCSV = '' then
FCategoriesCSV := Data^.FName
else
FCategoriesCSV := FCategoriesCSV + ', ' + Data^.FName;
case Data^.FType of
0,1: begin
if FCategoriesCSV = '' then
FCategoriesCSV := Data^.FName
else
FCategoriesCSV := FCategoriesCSV + ', ' + Data^.FName;
end;
2: begin
if FLazCompatibility = '' then
FLazCompatibility := Data^.FName
else
FLazCompatibility := FLazCompatibility + ', ' + Data^.FName;
end;
3: begin
if FFPCCompatibility = '' then
FFPCCompatibility := Data^.FName
else
FFPCCompatibility := FFPCCompatibility + ', ' + Data^.FName;
end;
4: begin
if FSupportedWidgetSets = '' then
FSupportedWidgetSets := Data^.FName
else
FSupportedWidgetSets := FSupportedWidgetSets + ', ' + Data^.FName;
end;
end;
end;
Node := FVST.GetNext(Node);
end;
@ -231,16 +262,18 @@ begin
Finalize(Data^);
end;
procedure TCategoriesFrm.SetupControls;
procedure TCategoriesFrm.SetupControls(const AType: Integer);
begin
FModRes := mrNone;
Caption := rsCategoriesFrm_Caption;
BP.OKButton.Caption := rsCategoriesFrm_bYes_Caption;
BP.CancelButton.Caption := rsCategoriesFrm_bCancel_Caption;
case AType of
1: Caption := rsCategoriesFrm_Caption1;
2: Caption := rsCategoriesFrm_Caption2;
3: Caption := rsCategoriesFrm_Caption3;
4: Caption := rsCategoriesFrm_Caption4;
end;
lbMessage.Caption := rsCategoriesFrm_lbMessage_Caption;
//bOk.Caption := rsCategoriesFrm_bYes_Caption;
//bCancel.Caption := rsCategoriesFrm_bCancel_Caption;
//bOk.Top := (pnButtons.Height - bOk.Height) div 2;
//bCancel.Top := (pnButtons.Height - bCancel.Height) div 2;
//pnMessage.Height := lbMessage.Top + lbMessage.Height + 5;
end;
function TCategoriesFrm.CheckNode(const AName: String): Boolean;
@ -263,32 +296,73 @@ begin
end;
end;
procedure TCategoriesFrm.PopulateTree;
procedure TCategoriesFrm.PopulateTree(const AType: Integer);
var
I: Integer;
Node: PVirtualNode;
Data: PData;
SL: TStringList;
LCLPlatform: TLCLPlatform;
begin
FLineAdded := True;
for I := 0 to MaxCategories - 1 do
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
Data := FVST.GetNodeData(Node);
Data^.FName := Categories[I];
Data^.FImageIndex := -1;
if UpperCase(CategoriesEng[I]) = 'OTHER' then
Data^.FType := 1
else
Data^.FType := 0;
end;
FVST.SortTree(0, laz.VirtualTrees.sdAscending);
SL := TStringList.Create;
try
SL.Delimiter := ',';
SL.DelimitedText := FCategoriesCSV;
SL.StrictDelimiter := True;
case AType of
1: begin
for I := 0 to MaxCategories - 1 do
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
Data := FVST.GetNodeData(Node);
Data^.FName := Categories[I];
Data^.FImageIndex := -1;
if UpperCase(CategoriesEng[I]) = 'OTHER' then
Data^.FType := 1
else
Data^.FType := 0;
end;
SL.DelimitedText := FCategoriesCSV;
end;
2: begin
for I := 0 to MaxLazVersions - 1 do
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
Data := FVST.GetNodeData(Node);
Data^.FName := LazVersions[I];
Data^.FImageIndex := -1;
Data^.FType := 2;
end;
SL.DelimitedText := FLazCompatibility;
end;
3: begin
for I := 0 to MaxFPCVersions - 1 do
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
Data := FVST.GetNodeData(Node);
Data^.FName := FPCVersions[I];
Data^.FImageIndex := -1;
Data^.FType := 3;
end;
SL.DelimitedText := FFPCCompatibility;
end;
4: begin
for LCLPlatform := Low(TLCLPlatform) to High(TLCLPlatform) do
begin
Node := FVST.AddChild(nil);
Node^.CheckType := ctTriStateCheckBox;
Data := FVST.GetNodeData(Node);
Data^.FName := LCLPlatformDisplayNames[LCLPlatform];
Data^.FImageIndex := -1;
Data^.FType := 4;
end;
SL.DelimitedText := FSupportedWidgetSets;
end;
end;
FVST.SortTree(0, laz.VirtualTrees.sdAscending);
for I := 0 to SL.Count - 1 do
CheckNode(Trim(SL.Strings[I]));
finally
@ -296,5 +370,6 @@ begin
end;
end;
end.

20
components/onlinepackagemanager/opkman_common.pas
View File

@ -111,12 +111,32 @@ const
'Other',
'Games and Game Engines');
MaxLazVersions = 7;
LazVersions: array [0..MaxLazVersions - 1] of String = (
'1.8.0', '1.8.2', '1.8.4', '1.8.5',
'2.0.0', '2.0.2',
'Trunk');
LazDefVersions = '2.0.0, 2.0.2';
LazTrunk = '2.1.0';
MaxFPCVersions = 4;
FPCVersions: array [0..MaxFPCVersions - 1] of String = (
'3.0.0', '3.0.2', '3.0.4',
'Trunk');
FPCDefVersion = '3.0.0, 3.0.2, 3.0.4';
FPCTrunk = '3.3.1';
DefWidgetSets = 'gtk2, win32/win64';
var
LocalRepositoryConfigFile: String;
LocalRepositoryUpdatesFile: String;
PackageAction: TPackageAction;
InstallPackageList: TObjectList;
CriticalSection: TRTLCriticalSection;
CurLazVersion: String;
CurFPCVersion: String;
CurWidgetSet: String;
function MessageDlgEx(const AMsg: String; ADlgType: TMsgDlgType; AButtons:
TMsgDlgButtons; AParent: TForm): TModalResult;

21
components/onlinepackagemanager/opkman_const.pas
View File

@ -188,6 +188,7 @@ resourcestring
rsMainFrm_miLoad = 'Load packages';
rsMainFrm_PackagenameAlreadyExists = 'A package with the same name already exists!';
rsMainFrm_PackageAlreadyInstalled = 'The following packages are already installed. Continue anyway?';
rsMainFrm_PackageIncompatible = 'The following packages are not compatible with your system and the install will most likely fail. Continue anyway?';
rsMainFrm_PackageAlreadyDownloaded = 'The following repository packages already exist in the target folder. Continue?';
rsMainFrm_PackageUpdateWarning = 'Installing packages from external link is not without a risk!' + sLineBreak + 'Only install if you trust the package maintainer. Continue?';
rsMainFrm_PackageUpdate0 = 'The following repository packages are not available externally. The packages will be skipped. Continue?';
@ -272,6 +273,10 @@ resourcestring
rsOptions_cbSelectProfile_Hint = 'Choose a profile that best fits you';
rsOptions_cbDelete_Caption = 'Delete downloaded zip files after installation/update';
rsOptions_cbDelete_Hint = 'If this option is checked the downloaded zip file is always deleted after installation';
rsOption_cbIncompatiblePackage_Caption = 'Warn me about incompatible packages';
rsOption_cbIncompatiblePackage_Hint = 'If a package is not compatible with the current widgetset or Lazarus/FPC version, OPM will show a warning message';
rsOption_cbcbAlreadyInstalledPackages_Caption = 'Warn me about already installed packages';
rsOption_cbcbAlreadyInstalledPackages_Hint = 'If a package is already installed, OPM will show a warning message';
rsOptions_cbProxy_Caption = 'Use proxy';
rsOptions_gbProxySettings_Caption = 'Proxy settings';
rsOptions_lbServer_Caption = 'Server';
@ -329,9 +334,18 @@ resourcestring
rsPackageListFrm_Caption0 = 'Installed package list';
rsPackageListFrm_Caption1 = 'Downloaded package list';
rsPackageListFrm_Caption2 = 'Update package list';
rsPackageListFrm_Caption3 = 'Incompatible package list';
rsPackageListFrm_SupLazVers = 'Supported Lazarus versions: ';
rsPackageListFrm_CurLazVer = 'Current Lazarus version: ';
rsPackageListFrm_SupFPCVers = 'Supported FPC versions: ';
rsPackageListFrm_CurFPCVer = 'Current FPC version: ';
rsPackageListFrm_SupWSs = 'Supported widgetsets: ';
rsPackageListFrm_CurWS = 'Current widgetset: ';
rsPackageListFrm_Incompatible = 'Incompatible';
rsPackageListFrm_bYes_Caption = 'Yes';
rsPackageListFrm_bNo_Caption = 'No';
rsPackageListFrm_bOk_Caption = 'OK';
rsPackageListFrm_lbHint_Caption = 'Hint: for more details move the mouse over the problematic column.';
//createrepositorypackage form
rsCreateRepositoryPackageFrm_Caption = 'Create repository package';
@ -398,8 +412,11 @@ resourcestring
rsCreateJSONForUpdatesFrm_Error1 = 'Cannot create JSON for updates! Error message:';
//categories form
rsCategoriesFrm_Caption = 'List with categories';
rsCategoriesFrm_lbMessage_Caption = 'Please select (check) one or more categories';
rsCategoriesFrm_Caption1 = 'List with categories';
rsCategoriesFrm_Caption2 = 'List with Lazarus versions';
rsCategoriesFrm_Caption3 = 'List with FPC versions';
rsCategoriesFrm_Caption4 = 'List with supported widgetsets';
rsCategoriesFrm_lbMessage_Caption = 'Please select (check) one or more items';
rsCategoriesFrm_bYes_Caption = 'OK';
rsCategoriesFrm_bCancel_Caption = 'Cancel';

136
components/onlinepackagemanager/opkman_createrepositorypackagefrm.lfm
View File

@ -116,14 +116,6 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm
ClientWidth = 549
TabOrder = 1
Visible = False
object edSupportedWidgetset: TEdit
Left = 170
Height = 23
Top = 80
Width = 350
Anchors = [akTop, akLeft, akRight]
TabOrder = 2
end
object lbLazCompatibility: TLabel
Left = 9
Height = 15
@ -140,22 +132,6 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm
Caption = 'lbFPCCompatibility'
ParentColor = False
end
object edLazCompatibility: TEdit
Left = 170
Height = 23
Top = 8
Width = 350
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object edFPCCompatibility: TEdit
Left = 170
Height = 23
Top = 45
Width = 350
Anchors = [akTop, akLeft, akRight]
TabOrder = 1
end
object lbSupportedWidgetSet: TLabel
Left = 9
Height = 15
@ -200,6 +176,117 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm
ParentColor = False
ParentFont = False
end
object pnLazCompatibility: TPanel
Left = 170
Height = 23
Top = 9
Width = 351
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 351
ParentColor = False
TabOrder = 0
object spLazCompatibility: TSpeedButton
Tag = 2
Left = 328
Height = 23
Top = 0
Width = 23
Align = alRight
Caption = '...'
OnClick = spCategoriesClick
ShowHint = True
ParentShowHint = False
end
object edLazCompatibility: TEdit
Left = 0
Height = 23
Top = 0
Width = 328
Align = alClient
AutoSize = False
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 0
end
end
object pnFPCCompatibility: TPanel
Left = 170
Height = 23
Top = 45
Width = 351
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 351
ParentColor = False
TabOrder = 1
object spFPCCompatibility: TSpeedButton
Tag = 3
Left = 328
Height = 23
Top = 0
Width = 23
Align = alRight
Caption = '...'
OnClick = spCategoriesClick
ShowHint = True
ParentShowHint = False
end
object edFPCCompatibility: TEdit
Left = 0
Height = 23
Top = 0
Width = 328
Align = alClient
AutoSize = False
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 0
end
end
object pnSupportedWidgetset: TPanel
Left = 170
Height = 23
Top = 79
Width = 351
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 351
ParentColor = False
TabOrder = 2
object spSupportedWidgetset: TSpeedButton
Tag = 4
Left = 328
Height = 23
Top = 0
Width = 23
Align = alRight
Caption = '...'
OnClick = spCategoriesClick
ShowHint = True
ParentShowHint = False
end
object edSupportedWidgetset: TEdit
Left = 0
Height = 23
Top = 0
Width = 328
Align = alClient
AutoSize = False
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 0
end
end
end
object pnCategory: TPanel
Left = 0
@ -313,6 +400,7 @@ object CreateRepositoryPackagesFrm: TCreateRepositoryPackagesFrm
ParentColor = False
TabOrder = 0
object spCategories: TSpeedButton
Tag = 1
Left = 328
Height = 23
Top = 0

36
components/onlinepackagemanager/opkman_createrepositorypackagefrm.pas
View File

@ -51,14 +51,14 @@ type
bSubmit: TButton;
cbJSONForUpdates: TCheckBox;
edCategories: TEdit;
edFPCCompatibility: TEdit;
edSupportedWidgetset: TEdit;
edLazCompatibility: TEdit;
edPackageDir: TDirectoryEdit;
edDownloadURL: TEdit;
edDisplayName: TEdit;
edSVNURL: TEdit;
edFPCCompatibility: TEdit;
edHomePageURL: TEdit;
edLazCompatibility: TEdit;
edSupportedWidgetset: TEdit;
lbCategory: TLabel;
lbDownloadURL: TLabel;
lbDisplayName: TLabel;
@ -77,6 +77,9 @@ type
pnB: TPanel;
pnButtons: TPanel;
pnCategories: TPanel;
pnFPCCompatibility: TPanel;
pnSupportedWidgetset: TPanel;
pnLazCompatibility: TPanel;
pnPackageData: TPanel;
pnBrowse: TPanel;
pnCategory: TPanel;
@ -85,6 +88,9 @@ type
pnData: TPanel;
SDD: TSelectDirectoryDialog;
spCategories: TSpeedButton;
spFPCCompatibility: TSpeedButton;
spSupportedWidgetset: TSpeedButton;
spLazCompatibility: TSpeedButton;
spMain: TSplitter;
procedure bCancelClick(Sender: TObject);
procedure bCreateClick(Sender: TObject);
@ -484,9 +490,9 @@ begin
Data^.FFullPath := TPackageData(PackageList.Objects[I]).FFullPath;
if not LoadPackageData(Data^.FFullPath, Data) then
MessageDlgEx(rsCreateRepositoryPackageFrm_Error0, mtError, [mbOk], Self);
Data^.FLazCompatibility := '1.8, 2.0, Trunk';
Data^.FFPCCompatibility := '3.0.0, 3.0.2, 3.0.4';
Data^.FSupportedWidgetSet := 'win32/64, gtk2';
Data^.FLazCompatibility := LazDefVersions;
Data^.FFPCCompatibility := FPCDefVersion;
Data^.FSupportedWidgetSet := DefWidgetSets;
Data^.FDataType := 1;
end;
FVSTPackages.FullExpand;
@ -524,11 +530,21 @@ procedure TCreateRepositoryPackagesFrm.spCategoriesClick(Sender: TObject);
begin
CategoriesFrm := TCategoriesFrm.Create(Self);
try
CategoriesFrm.SetupControls;
CategoriesFrm.CategoriesCSV := edCategories.Text;
CategoriesFrm.PopulateTree;
CategoriesFrm.SetupControls(TButton(Sender).Tag);
case TButton(Sender).Tag of
1: CategoriesFrm.CategoriesCSV := edCategories.Text;
2: CategoriesFrm.LazCompatibility := edLazCompatibility.Text;
3: CategoriesFrm.FPCCompatibility := edFPCCompatibility.Text;
4: CategoriesFrm.SupportedWidgetSets := edSupportedWidgetset.Text;
end;
CategoriesFrm.PopulateTree(TButton(Sender).Tag);
if CategoriesFrm.ShowModal = mrOK then
edCategories.Text := CategoriesFrm.CategoriesCSV;
case TButton(Sender).Tag of
1: edCategories.Text := CategoriesFrm.CategoriesCSV;
2: edLazCompatibility.Text := CategoriesFrm.LazCompatibility;
3: edFPCCompatibility.Text := CategoriesFrm.FPCCompatibility;
4: edSupportedWidgetset.Text := CategoriesFrm.SupportedWidgetSets;
end;
finally
CategoriesFrm.Free;
end;

88
components/onlinepackagemanager/opkman_mainfrm.pas
View File

@ -32,9 +32,9 @@ uses
Classes, SysUtils, fpjson, Graphics, laz.VirtualTrees,
// LCL
Forms, Controls, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, ComCtrls, Clipbrd,
LCLIntf, LCLVersion, LCLProc,
InterfaceBase, LCLIntf, LCLVersion, LCLProc, LCLPlatformDef,
// LazUtils
LazFileUtils, LazIDEIntf,
LazFileUtils, LazIDEIntf, LazVersion,
// IdeIntf
IDECommands, PackageIntf,
// OpkMan
@ -211,6 +211,9 @@ begin
spClear.ImageIndex := IMG_CLEAR;
FHintTimeOut := Application.HintHidePause;
Updates := nil;
CurLazVersion := IntToStr(laz_major) + '.' + IntToStr(laz_minor) + '.' + IntToStr(laz_release);
CurFPCVersion := {$I %FPCVERSION%};
CurWidgetSet := LCLPlatformDisplayNames[GetDefaultLCLWidgetType];
Application.HintHidePause := 1000000;
Application.AddOnDeactivateHandler(@DoDeactivate, False);
end;
@ -907,53 +910,74 @@ begin
Exit;
CanGo := True;
PackageListFrm := TPackageListFrm.Create(MainFrm);
try
PackageListFrm.lbMessage.Caption := rsMainFrm_PackageAlreadyInstalled;
PackageListFrm.PopulateList(0);
if PackageListFrm.Count > 0 then
CanGo := PackageListFrm.ShowModal = mrYes
else
CanGo := True;
finally
PackageListFrm.Free;
if Options.IncompatiblePackages then
begin
PackageListFrm := TPackageListFrm.Create(MainFrm);
try
PackageListFrm.lbMessage.Caption := rsMainFrm_PackageIncompatible;
PackageListFrm.PopulateList(3);
if PackageListFrm.Count > 0 then
CanGo := PackageListFrm.ShowModal = mrYes
else
CanGo := True;
finally
PackageListFrm.Free;
end;
end;
if CanGo then
begin
PackageAction := paInstall;
VisualTree.UpdatePackageStates;
if SerializablePackages.DownloadCount > 0 then
if Options.AlreadyInstalledPackages then
begin
DoExtract := True;
CanGo := Download(Options.LocalRepositoryArchiveExpanded, DoExtract) = mrOK;
VisualTree.UpdatePackageStates;
PackageListFrm := TPackageListFrm.Create(MainFrm);
try
PackageListFrm.lbMessage.Caption := rsMainFrm_PackageAlreadyInstalled;
PackageListFrm.PopulateList(0);
if PackageListFrm.Count > 0 then
CanGo := PackageListFrm.ShowModal = mrYes
else
CanGo := True;
finally
PackageListFrm.Free;
end;
end;
if CanGo then
begin
if SerializablePackages.ExtractCount > 0 then
PackageAction := paInstall;
VisualTree.UpdatePackageStates;
if SerializablePackages.DownloadCount > 0 then
begin
DoOpen := False;
CanGo := Extract(Options.LocalRepositoryArchiveExpanded, Options.LocalRepositoryPackagesExpanded, DoOpen) = mrOk;
DoExtract := True;
CanGo := Download(Options.LocalRepositoryArchiveExpanded, DoExtract) = mrOK;
VisualTree.UpdatePackageStates;
end;
if CanGo then
begin
if Options.DeleteZipAfterInstall then
SerializablePackages.DeleteDownloadedZipFiles;
if SerializablePackages.InstallCount > 0 then
if SerializablePackages.ExtractCount > 0 then
begin
InstallStatus := isFailed;
NeedToRebuild := False;
if Install(InstallStatus, NeedToRebuild) = mrOk then
DoOpen := False;
CanGo := Extract(Options.LocalRepositoryArchiveExpanded, Options.LocalRepositoryPackagesExpanded, DoOpen) = mrOk;
VisualTree.UpdatePackageStates;
end;
if CanGo then
begin
if Options.DeleteZipAfterInstall then
SerializablePackages.DeleteDownloadedZipFiles;
if SerializablePackages.InstallCount > 0 then
begin
SerializablePackages.MarkRuntimePackages;
VisualTree.UpdatePackageStates;
if (InstallStatus = isSuccess) or (InstallStatus = isPartiallyFailed) then
if NeedToRebuild then
Rebuild;
InstallStatus := isFailed;
NeedToRebuild := False;
if Install(InstallStatus, NeedToRebuild) = mrOk then
begin
SerializablePackages.MarkRuntimePackages;
VisualTree.UpdatePackageStates;
if (InstallStatus = isSuccess) or (InstallStatus = isPartiallyFailed) then
if NeedToRebuild then
Rebuild;
end;
end;
end;
end;

10
components/onlinepackagemanager/opkman_options.pas
View File

@ -59,6 +59,8 @@ type
FActiveRepositoryIndex: Integer;
FForceDownloadAndExtract: Boolean;
FDeleteZipAfterInstall: Boolean;
FIncompatiblePackages: Boolean;
FAlreadyInstalledPackages: Boolean;
FCheckForUpdates: Integer;
FLastUpdate: TDateTime;
FConTimeOut: Integer;
@ -105,6 +107,8 @@ type
property ActiveRepositoryIndex: Integer read FActiveRepositoryIndex write FActiveRepositoryIndex;
property ForceDownloadAndExtract: Boolean read FForceDownloadAndExtract write FForceDownloadAndExtract;
property DeleteZipAfterInstall: Boolean read FDeleteZipAfterInstall write FDeleteZipAfterInstall;
property IncompatiblePackages: Boolean read FIncompatiblePackages write FIncompatiblePackages;
property AlreadyInstalledPackages: Boolean read FAlreadyInstalledPackages write FAlreadyInstalledPackages;
property CheckForUpdates: Integer read FCheckForUpdates write FCheckForUpdates;
property LastUpdate: TDateTime read FLastUpdate write FLastUpdate;
property ConTimeOut: Integer read FConTimeOut write FConTimeOut;
@ -194,6 +198,8 @@ begin
FActiveRepositoryIndex := FXML.GetValue('General/ActiveRepositoryIndex/Value', 0);
FForceDownloadAndExtract := FXML.GetValue('General/ForceDownloadAndExtract/Value', True);
FDeleteZipAfterInstall := FXML.GetValue('General/DeleteZipAfterInstall/Value', True);
FIncompatiblePackages := FXML.GetValue('General/IncompatiblePackages/Value', True);
FAlreadyInstalledPackages := FXML.GetValue('General/AlreadyInstalledPackages/Value', False);
FLastDownloadDir := FXML.GetValue('General/LastDownloadDir/Value', '');
FLastPackageDirSrc := FXML.GetValue('General/LastPackageDirSrc/Value', '');
FLastPackageDirDst := FXML.GetValue('General/LastPackageDirDst/Value', '');
@ -231,6 +237,8 @@ begin
FXML.SetDeleteValue('General/ActiveRepositoryIndex/Value', FActiveRepositoryIndex, 0);
FXML.SetDeleteValue('General/ForceDownloadAndExtract/Value', FForceDownloadAndExtract, True);
FXML.SetDeleteValue('General/DeleteZipAfterInstall/Value', FDeleteZipAfterInstall, True);
FXML.SetDeleteValue('General/IncompatiblePackages/Value', FIncompatiblePackages, True);
FXML.SetDeleteValue('General/AlreadyInstalledPackages/Value', FAlreadyInstalledPackages, False);
FXML.SetDeleteValue('General/LastDownloadDir/Value', FLastDownloadDir, '');
FXML.SetDeleteValue('General/LastPackageDirSrc/Value', FLastPackageDirSrc, '');
FXML.SetDeleteValue('General/LastPackageDirDst/Value', FLastPackageDirDst, '');
@ -275,6 +283,8 @@ begin
FActiveRepositoryIndex := 0;
FForceDownloadAndExtract := True;
FDeleteZipAfterInstall := True;
FIncompatiblePackages := True;
FAlreadyInstalledPackages := False;
FCheckForUpdates := 5;
FLastUpdate := 0.0;
FConTimeOut := 10;

108
components/onlinepackagemanager/opkman_optionsfrm.lfm
View File

@ -1,12 +1,12 @@
object OptionsFrm: TOptionsFrm
Left = 338
Height = 556
Height = 597
Top = 131
Width = 635
Width = 644
BorderIcons = [biSystemMenu]
Caption = 'Options'
ClientHeight = 556
ClientWidth = 635
ClientHeight = 597
ClientWidth = 644
Constraints.MinHeight = 300
Constraints.MinWidth = 475
KeyPreview = True
@ -19,19 +19,19 @@ object OptionsFrm: TOptionsFrm
object pnBottom: TPanel
Left = 0
Height = 46
Top = 510
Width = 635
Top = 551
Width = 644
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 46
ClientWidth = 635
ClientWidth = 644
TabOrder = 1
object bpOptions: TButtonPanel
Left = 6
Height = 34
Top = 6
Width = 623
Width = 632
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
OKButton.OnClick = OKButtonClick
@ -49,9 +49,9 @@ object OptionsFrm: TOptionsFrm
end
object pgOptions: TPageControl
Left = 6
Height = 498
Height = 539
Top = 6
Width = 623
Width = 632
ActivePage = tsGeneral
Align = alClient
BorderSpacing.Around = 6
@ -59,17 +59,17 @@ object OptionsFrm: TOptionsFrm
TabOrder = 0
object tsGeneral: TTabSheet
Caption = 'General'
ClientHeight = 470
ClientWidth = 615
ClientHeight = 511
ClientWidth = 624
object pnGeneral: TPanel
Left = 0
Height = 470
Height = 511
Top = 0
Width = 615
Width = 624
Align = alClient
BevelOuter = bvNone
ClientHeight = 470
ClientWidth = 615
ClientHeight = 511
ClientWidth = 624
ParentColor = False
TabOrder = 0
object lbRemoteRepository: TLabel
@ -115,7 +115,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Control = Bevel1
Left = 6
Height = 15
Top = 157
Top = 199
Width = 146
BorderSpacing.Top = 5
Caption = 'Check for package updates:'
@ -127,7 +127,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 178
Top = 220
Width = 209
BorderSpacing.Top = 6
ItemHeight = 15
@ -151,7 +151,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrCenter
Left = 230
Height = 15
Top = 182
Top = 224
Width = 64
BorderSpacing.Left = 15
Caption = 'Last update:'
@ -166,14 +166,14 @@ object OptionsFrm: TOptionsFrm
Left = 6
Height = 23
Top = 27
Width = 603
Width = 612
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 4
BorderSpacing.Right = 6
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 603
ClientWidth = 612
TabOrder = 0
object cbRemoteRepository: TComboBox
AnchorSideLeft.Control = pnRepositories
@ -182,7 +182,7 @@ object OptionsFrm: TOptionsFrm
Left = 0
Height = 23
Top = 0
Width = 578
Width = 587
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 2
ItemHeight = 15
@ -197,7 +197,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbRemoteRepository
AnchorSideBottom.Side = asrBottom
Left = 580
Left = 589
Height = 23
Top = 0
Width = 23
@ -213,7 +213,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 15
Top = 216
Top = 258
Width = 204
BorderSpacing.Top = 15
Caption = 'Show newly added packages for(days):'
@ -226,7 +226,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrCenter
Left = 216
Height = 23
Top = 212
Top = 254
Width = 76
BorderSpacing.Left = 6
MaxValue = 365
@ -239,7 +239,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 241
Top = 283
Width = 232
BorderSpacing.Top = 10
Caption = 'Show regular icon for installed packages'
@ -251,7 +251,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 399
Top = 441
Width = 116
BorderSpacing.Top = 7
Caption = 'Use default theme'
@ -262,8 +262,8 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 0
Height = 2
Top = 152
Width = 611
Top = 194
Width = 620
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 25
end
@ -272,18 +272,18 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 4
Height = 2
Top = 285
Width = 611
Top = 327
Width = 620
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 25
end
object lbConTimeOut: TLabel
AnchorSideLeft.Control = lbRemoteRepository
AnchorSideTop.Control = cbDeleteZipAfterInstall
AnchorSideTop.Control = cbAlreadyInstalledPackages
AnchorSideTop.Side = asrBottom
Left = 6
Height = 15
Top = 112
Top = 154
Width = 164
BorderSpacing.Top = 16
Caption = 'Connection timeout(seconds): '
@ -298,7 +298,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrCenter
Left = 176
Height = 23
Top = 108
Top = 150
Width = 55
BorderSpacing.Left = 6
MinValue = 1
@ -310,8 +310,8 @@ object OptionsFrm: TOptionsFrm
AnchorSideTop.Side = asrBottom
Left = 4
Height = 2
Top = 390
Width = 611
Top = 432
Width = 620
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 10
end
@ -322,8 +322,8 @@ object OptionsFrm: TOptionsFrm
AnchorSideRight.Side = asrBottom
Left = 6
Height = 88
Top = 292
Width = 599
Top = 334
Width = 608
Anchors = [akTop, akLeft, akRight]
AutoFill = True
BorderSpacing.Top = 5
@ -337,7 +337,7 @@ object OptionsFrm: TOptionsFrm
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 68
ClientWidth = 595
ClientWidth = 604
ItemIndex = 0
Items.Strings = (
'Behaves like a regular hint window'
@ -351,7 +351,7 @@ object OptionsFrm: TOptionsFrm
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = rbHintFormOptions
AnchorSideBottom.Side = asrBottom
Left = 480
Left = 489
Height = 26
Top = 21
Width = 105
@ -364,6 +364,34 @@ object OptionsFrm: TOptionsFrm
TabOrder = 3
end
end
object cbIncompatiblePackages: TCheckBox
AnchorSideLeft.Control = lbRemoteRepository
AnchorSideTop.Control = cbDeleteZipAfterInstall
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 98
Width = 227
BorderSpacing.Top = 2
Caption = 'Warn me about incompatible packages'
ParentShowHint = False
ShowHint = True
TabOrder = 9
end
object cbAlreadyInstalledPackages: TCheckBox
AnchorSideLeft.Control = lbRemoteRepository
AnchorSideTop.Control = cbIncompatiblePackages
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 119
Width = 242
BorderSpacing.Top = 2
Caption = 'Warn me about already installed packages'
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
end
end
object tsProxy: TTabSheet

10
components/onlinepackagemanager/opkman_optionsfrm.pas
View File

@ -58,6 +58,8 @@ type
bOpen: TButton;
bpOptions: TButtonPanel;
bColors: TButton;
cbIncompatiblePackages: TCheckBox;
cbAlreadyInstalledPackages: TCheckBox;
cbProxy: TCheckBox;
cbForceDownloadExtract: TCheckBox;
cbDeleteZipAfterInstall: TCheckBox;
@ -421,6 +423,8 @@ begin
Options.ForceDownloadAndExtract := cbForceDownloadExtract.Checked;
Options.ConTimeOut := spConTimeOut.Value;
Options.DeleteZipAfterInstall := cbDeleteZipAfterInstall.Checked;
Options.IncompatiblePackages := cbIncompatiblePackages.Checked;
Options.AlreadyInstalledPackages := cbAlreadyInstalledPackages.Checked;
Options.CheckForUpdates := cbCheckForUpdates.ItemIndex;
Options.DaysToShowNewPackages := spDaysToShowNewPackages.Value;
Options.ShowRegularIcons := cbRegularIcons.Checked;
@ -486,6 +490,8 @@ begin
cbRemoteRepository.ItemIndex := Options.ActiveRepositoryIndex;
cbForceDownloadExtract.Checked := Options.ForceDownloadAndExtract;
cbDeleteZipAfterInstall.Checked := Options.DeleteZipAfterInstall;
cbIncompatiblePackages.Checked := Options.IncompatiblePackages;
cbAlreadyInstalledPackages.Checked := Options.AlreadyInstalledPackages;
cbForceDownloadExtract.Caption := rsOptions_cbForceDownloadExtract_Caption;
cbForceDownloadExtract.Hint := rsOptions_cbForceDownloadExtract_Hint;
lbConTimeOut.Caption := rsOptions_lbConTimeOut_Caption;
@ -493,6 +499,10 @@ begin
spConTimeOut.Value := Options.ConTimeOut;
cbDeleteZipAfterInstall.Caption := rsOptions_cbDelete_Caption;
cbDeleteZipAfterInstall.Hint := rsOptions_cbDelete_Hint;
cbIncompatiblePackages.Caption := rsOption_cbIncompatiblePackage_Caption;
cbIncompatiblePackages.Hint := rsOption_cbIncompatiblePackage_Hint;
cbAlreadyInstalledPackages.Caption := rsOption_cbcbAlreadyInstalledPackages_Caption;
cbAlreadyInstalledPackages.Hint := rsOption_cbcbAlreadyInstalledPackages_Hint;
lbUpdates.Caption := rsOptions_lbCheckForUpdates_Caption;
cbCheckForUpdates.Clear;
cbCheckForUpdates.Items.Add(rsOptions_cbCheckForUpdates_Item0);

17
components/onlinepackagemanager/opkman_packagelistfrm.lfm
View File

@ -79,6 +79,23 @@ object PackageListFrm: TPackageListFrm
ModalResult = 7
TabOrder = 1
end
object lbHint: TLabel
Left = 12
Height = 15
Top = 11
Width = 33
Caption = 'lbHint'
Enabled = False
Font.CharSet = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Pitch = fpVariable
Font.Quality = fqDraft
ParentColor = False
ParentFont = False
Visible = False
end
end
object pnUpDown: TPanel
Left = 370

232
components/onlinepackagemanager/opkman_packagelistfrm.pas
View File

@ -26,11 +26,11 @@ unit opkman_packagelistfrm;
interface
uses
SysUtils,
SysUtils, Classes,
// LCL
Forms, Controls, Graphics, ExtCtrls, StdCtrls, laz.VirtualTrees,
// OpkMan
opkman_const, opkman_serializablepackages, opkman_options, opkman_visualtree,
opkman_const, opkman_common, opkman_serializablepackages, opkman_options, opkman_visualtree,
opkman_maindm;
type
@ -41,6 +41,7 @@ type
bOk: TButton;
bYes: TButton;
bNo: TButton;
lbHint: TLabel;
lbMessage: TLabel;
pnUpDown: TPanel;
pnMessage: TPanel;
@ -52,6 +53,7 @@ type
procedure lbMessageResize(Sender: TObject);
private
FVST: TLazVirtualStringTree;
FSL: TStringList;
FModRes: TModalResult;
function GetCount: Integer;
procedure SetupControls(const ATyp: Integer);
@ -60,10 +62,18 @@ type
procedure VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
{%H-}Kind: TVTImageKind; Column: TColumnIndex; var {%H-}Ghosted: Boolean;
var ImageIndex: Integer);
procedure VSTPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex;
{%H-}TextType: TVSTTextType);
procedure VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
function IsNodeVisible(const APackageName: String): Boolean;
function IsLazarusCompatible(const ALazVersions: String): Boolean;
function IsFPCCompatible(const AFPCVersions: String): Boolean;
function IsWidgetSetCompatible(const AWidgetSets: String): Boolean;
public
procedure PopulateList(const ATyp: Integer; const AExtra: String = '');
property Count: Integer read GetCount;
@ -83,6 +93,12 @@ type
TData = record
FName: string[100];
FImageIndex: Integer;
FSupLazVers: String;
FIsLazComp: Boolean;
FSupFPCVers: String;
FIsFPCComp: Boolean;
FSupWS: String;
FIsWSComp: Boolean;
end;
procedure TPackageListFrm.FormKeyPress(Sender: TObject; var Key: char);
@ -116,10 +132,22 @@ begin
0: Caption := rsPackageListFrm_Caption0;
1: Caption := rsPackageListFrm_Caption1;
2: Caption := rsPackageListFrm_Caption0;
3: begin
Caption := rsPackageListFrm_Caption3;
Self.Width := 650;
Self.BorderStyle := bsSizeable;
FVST.Header.Options := FVST.Header.Options + [hoVisible];
FVST.Header.Columns.Items[1].Options := FVST.Header.Columns.Items[1].Options + [coVisible];
FVST.Header.Columns.Items[2].Options := FVST.Header.Columns.Items[2].Options + [coVisible];
FVST.Header.Columns.Items[3].Options := FVST.Header.Columns.Items[3].Options + [coVisible];
FVST.TreeOptions.MiscOptions := FVST.TreeOptions.MiscOptions + [toReportMode];
lbHint.Visible := True;
end;
end;
bYes.Caption := rsPackageListFrm_bYes_Caption;
bNo.Caption := rsPackageListFrm_bNo_Caption;
bOk.Caption := rsPackageListFrm_bOk_Caption;
lbHint.Caption := rsPackageListFrm_lbHint_Caption;
bYes.Top := (pnButtons.Height - bYes.Height) div 2;
bNo.Top := (pnButtons.Height - bNo.Height) div 2;
bOk.Top := (pnButtons.Height - bOk.Height) div 2;
@ -133,6 +161,7 @@ var
Data: PData;
LazarusPkg: TLazarusPackage;
ChkCnt, InvCnt: Integer;
LazComp, FPCComp, WSComp: Boolean;
begin
SetupControls(ATyp);
ChkCnt := 0;
@ -188,6 +217,32 @@ begin
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
end;
end;
end
else if ATyp = 3 then
begin
for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do
begin
LazarusPkg := TLazarusPackage(SerializablePackages.Items[I].LazarusPackages.Items[J]);
if (LazarusPkg.Checked) then
begin
LazComp := IsLazarusCompatible(LazarusPkg.LazCompatibility);
FPCComp := IsFPCCompatible(LazarusPkg.FPCCompatibility);
WSComp := IsWidgetSetCompatible(LazarusPkg.SupportedWidgetSet);
if (not LazComp) or (not FPCComp) or (not WSComp) then
begin
Node := FVST.AddChild(nil);
Data := FVST.GetNodeData(Node);
Data^.FName := LazarusPkg.Name + '(' + LazarusPkg.InstalledFileVersion + ')';
Data^.FImageIndex := IMG_PKG_FILE;
Data^.FSupLazVers := LazarusPkg.LazCompatibility;
Data^.FIsLazComp := LazComp;
Data^.FSupFPCVers := LazarusPkg.FPCCompatibility;
Data^.FIsFPCComp := FPCComp;
Data^.FSupWS := LazarusPkg.SupportedWidgetSet;
Data^.FIsWSComp := WSComp;
end;
end;
end;
end;
end;
if (ATyp = 2) and (ChkCnt = InvCnt) then
@ -230,28 +285,59 @@ begin
BorderSpacing.Top := Scale96ToForm(5);
BorderSpacing.Left := Scale96ToForm(15);
BorderSpacing.Right := Scale96ToForm(15);
Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoAutoSpring];
with Header.Columns.Add do begin
Position := 0;
Width := Scale96ToForm(250);
Text := 'PackageName';
Text := rsMainFrm_VSTHeaderColumn_PackageName;
end;
with Header.Columns.Add do
begin
Position := 1;
Width := FVST.Scale96ToForm(110);
Alignment := taCenter;
Options := Options - [coVisible];
Text := 'FPC';
end;
with Header.Columns.Add do
begin
Position := 2;
Width := FVST.Scale96ToForm(110);
Alignment := taCenter;
Options := Options - [coVisible];
Text := 'Lazarus';
end;
with Header.Columns.Add do
begin
Position := 3;
Width := FVST.Scale96ToForm(110);
Alignment := taCenter;
Options := Options - [coVisible];
Text := 'Widgetset';
end;
Header.Options := [hoAutoResize, hoColumnResize, hoRestrictDrag, hoShowSortGlyphs, hoAutoSpring];
Header.SortColumn := 0;
TabOrder := 2;
HintMode := hmHint;
ShowHint := True;
TreeOptions.MiscOptions := [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning];
TreeOptions.PaintOptions := [toHideFocusRect, toPopupMode, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages];
TreeOptions.SelectionOptions := [toFullRowSelect, toRightClickSelect];
TreeOptions.AutoOptions := [toAutoTristateTracking];
OnGetText := @VSTGetText;
OnPaintText := @VSTPaintText;
OnGetImageIndex := @VSTGetImageIndex;
OnCompareNodes := @VSTCompareNodes;
OnGetHint := @VSTGetHint;
OnFreeNode := @VSTFreeNode;
end;
FVST.NodeDataSize := SizeOf(TData);
FSL := TStringList.Create;
FSL.Delimiter := ',';
FSL.StrictDelimiter := True;
end;
procedure TPackageListFrm.FormDestroy(Sender: TObject);
begin
FSL.Free;
FVST.Clear;
FVST.Free;
end;
@ -263,8 +349,21 @@ var
Data: PData;
begin
Data := FVST.GetNodeData(Node);
if Column = 0 then
CellText := Data^.FName;
case Column of
0: CellText := Data^.FName;
1: if Data^.FIsFPCComp then
CellText := 'OK'
else
CellText := rsPackageListFrm_Incompatible;
2: if Data^.FIsLazComp then
CellText := 'OK'
else
CellText := rsPackageListFrm_Incompatible;
3: if Data^.FIsWSComp then
CellText := 'OK'
else
CellText := rsPackageListFrm_Incompatible;
end;
end;
procedure TPackageListFrm.VSTGetImageIndex(Sender: TBaseVirtualTree;
@ -278,6 +377,35 @@ begin
ImageIndex := Data^.FImageIndex;
end;
procedure TPackageListFrm.VSTPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
function GetColor(const AIsComp: Boolean): TColor;
begin
if (Node = Sender.FocusedNode) then
Result := FVST.Colors.SelectionTextColor
else
if AIsComp then
Result := clBlack
else
Result := clRed;
end;
var
Data: PData;
begin
if TextType = ttNormal then
begin
Data := FVST.GetNodeData(Node);
case Column of
1: TargetCanvas.Font.Color := GetColor(Data^.FIsFPCComp);
2: TargetCanvas.Font.Color := GetColor(Data^.FIsLazComp);
3: TargetCanvas.Font.Color := GetColor(Data^.FIsWSComp);
end;
end;
end;
procedure TPackageListFrm.VSTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
@ -290,6 +418,40 @@ begin
Result := CompareText(Data1^.FName, Data2^.FName);
end;
procedure TPackageListFrm.VSTGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
var
Data: PData;
CurFPCVer, CurLazVer: String;
SupFPCVers, SupLazVers: String;
begin
Data := FVST.GetNodeData(Node);
LineBreakStyle := hlbForceSingleLine;
if CurFPCVersion = FPCTrunk then
CurFPCVer := 'Trunk'
else
CurFPCVer := CurFPCVersion;
SupFPCVers := StringReplace(Data^.FSupFPCVers, FPCTrunk, 'Trunk', [rfIgnoreCase, rfReplaceAll]);
if CurLazVersion = LazTrunk then
CurLazVer := 'Trunk'
else
CurLazVer := CurLazVersion;
SupLazVers := StringReplace(Data^.FSupLazVers, LazTrunk, 'Trunk', [rfIgnoreCase, rfReplaceAll]);
case Column of
1: HintText := rsPackageListFrm_CurFPCVer + CurFPCVer + sLineBreak +
rsPackageListFrm_SupFPCVers + SupFPCVers;
2: HintText := rsPackageListFrm_CurLazVer + CurLazVer + sLineBreak +
rsPackageListFrm_SupLazVers + SupLazVers;
3: HintText := rsPackageListFrm_CurWS + CurWidgetSet + sLineBreak +
rsPackageListFrm_SupWSs + Data^.FSupWS;
else
HintText := '';
end;
end;
procedure TPackageListFrm.VSTFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
@ -318,5 +480,61 @@ begin
end;
end;
function TPackageListFrm.IsLazarusCompatible(const ALazVersions: String): Boolean;
var
LazVersion: String;
I: Integer;
begin
Result := False;
FSL.Clear;
FSL.DelimitedText := ALazVersions;
for I := 0 to FSL.Count - 1 do
begin
LazVersion := Trim(FSL.Strings[I]);
if LazVersion <> 'Trunk' then
Result := LazVersion = CurLazVersion
else
Result := CurLazVersion >= LazTrunk;
if Result then
Exit;
end;
end;
function TPackageListFrm.IsFPCCompatible(const AFPCVersions: String): Boolean;
var
FPCVersion: String;
I: Integer;
begin
Result := False;
FSL.Clear;
FSL.DelimitedText := AFPCVersions;
for I := 0 to FSL.Count - 1 do
begin
FPCVersion := Trim(FSL.Strings[I]);
if FPCVersion <> 'Trunk' then
Result := FPCVersion = CurFPCVersion
else
Result := CurFPCVersion >= FPCTrunk;
if Result then
Exit;
end;
end;
function TPackageListFrm.IsWidgetSetCompatible(const AWidgetSets: String): Boolean;
var
WidgetSet: String;
I: Integer;
begin
FSL.Clear;
FSL.DelimitedText := AWidgetSets;
for I := 0 to FSL.Count - 1 do
begin
WidgetSet := Trim(FSL.Strings[I]);
Result := WidgetSet = CurWidgetSet;
if Result then
Exit;
end;
end;
end.

2
components/onlinepackagemanager/opkman_showhint.lfm
View File

@ -4,6 +4,7 @@ object ShowHintFrm: TShowHintFrm
Top = 233
Width = 563
BorderIcons = [biSystemMenu]
BorderStyle = bsNone
Caption = 'ShowHintFrm'
ClientHeight = 325
ClientWidth = 563
@ -14,6 +15,7 @@ object ShowHintFrm: TShowHintFrm
OnDestroy = FormDestroy
OnKeyUp = FormKeyUp
PopupMode = pmExplicit
LCLVersion = '2.1.0.0'
object pnMain: TPanel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner