mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 19:29:34 +02:00
New Examples GUI Window as an IDE plugin package by David Bannon.
This commit is contained in:
Juha
parent
31328882fb
commit
a6ce4d91e2
60
components/exampleswindow/exampleprojects.lpk
Normal file
60
components/exampleswindow/exampleprojects.lpk
Normal file
@ -0,0 +1,60 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="5">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="exampleprojects"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value=" David Bannon"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CustomOptions Value="$(IDEBuildOptions)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="Example Projects."/>
|
||||
<License Value="GPL"/>
|
||||
<Version Major="1"/>
|
||||
<Files>
|
||||
<Item>
|
||||
<Filename Value="uintf.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="uIntf"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="uconst.pas"/>
|
||||
<UnitName Value="uConst"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="ulaz_examples.pas"/>
|
||||
<UnitName Value="uLaz_Examples"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="uexampledata.pas"/>
|
||||
<UnitName Value="uexampledata"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="exwinsettings.pas"/>
|
||||
<UnitName Value="exwinsettings"/>
|
||||
</Item>
|
||||
</Files>
|
||||
<RequiredPkgs>
|
||||
<Item>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
23
components/exampleswindow/exampleprojects.pas
Normal file
23
components/exampleswindow/exampleprojects.pas
Normal file
@ -0,0 +1,23 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit exampleprojects;
|
||||
|
||||
{$warn 5023 off : no warning about unused units}
|
||||
interface
|
||||
|
||||
uses
|
||||
uIntf, uConst, uLaz_Examples, uexampledata, exwinsettings,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('uIntf', @uIntf.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('exampleprojects', @Register);
|
||||
end.
|
||||
50
components/exampleswindow/exwinsettings.lfm
Normal file
50
components/exampleswindow/exwinsettings.lfm
Normal file
@ -0,0 +1,50 @@
|
||||
object ExWinSettingsFrame: TExWinSettingsFrame
|
||||
Left = 0
|
||||
Height = 240
|
||||
Top = 0
|
||||
Width = 320
|
||||
ClientHeight = 240
|
||||
ClientWidth = 320
|
||||
TabOrder = 0
|
||||
DesignLeft = 567
|
||||
DesignTop = 426
|
||||
object ButtonDefault: TButton
|
||||
AnchorSideLeft.Control = DirectoryEdit1
|
||||
AnchorSideTop.Control = DirectoryEdit1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 20
|
||||
Height = 25
|
||||
Top = 159
|
||||
Width = 75
|
||||
BorderSpacing.Top = 10
|
||||
Caption = 'Default'
|
||||
OnClick = ButtonDefaultClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object DirectoryEdit1: TDirectoryEdit
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 20
|
||||
Height = 29
|
||||
Top = 120
|
||||
Width = 280
|
||||
Directory = 'DirectoryEdit1'
|
||||
ShowHidden = False
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akLeft, akRight]
|
||||
BorderSpacing.Left = 20
|
||||
BorderSpacing.Right = 20
|
||||
MaxLength = 0
|
||||
TabOrder = 1
|
||||
Text = 'DirectoryEdit1'
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 27
|
||||
Height = 21
|
||||
Top = 91
|
||||
Width = 287
|
||||
Caption = 'Directory where examples are saved'
|
||||
end
|
||||
end
|
||||
193
components/exampleswindow/exwinsettings.pas
Normal file
193
components/exampleswindow/exwinsettings.pas
Normal file
@ -0,0 +1,193 @@
|
||||
unit exwinsettings;
|
||||
{
|
||||
**********************************************************************
|
||||
This file is part of a Lazarus Package, Examples Window.
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
**********************************************************************
|
||||
|
||||
This unit makes a frame that is poked into Lazarus's Options Tree. At present
|
||||
all it gets back is the user's preference as to where the Example Projects
|
||||
working space is. Easily extended. David Bannon, Feb 2022
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, StdCtrls, EditBtn, IDEOptionsIntf,
|
||||
IDEOptEditorIntf;
|
||||
|
||||
{ TExWinSettings }
|
||||
|
||||
// -------- The Options Group ID, and, perhaps, a place in the Tree View -------
|
||||
|
||||
type
|
||||
TExWinSettings = class(TAbstractIDEEnvironmentOptions) // needed by options group.
|
||||
|
||||
private
|
||||
|
||||
public
|
||||
constructor Create(const pbReadRegFile: boolean);
|
||||
destructor Destroy; override;
|
||||
class function GetGroupCaption: String; override;
|
||||
class function GetInstance: TAbstractIDEOptions; override;
|
||||
procedure DoAfterWrite({%H-}Restore: boolean); override;
|
||||
end;
|
||||
|
||||
|
||||
// ------ This is the Frame displayed when user clicks the Tree View note ------
|
||||
type
|
||||
{ TExWinSettingsFrame }
|
||||
TExWinSettingsFrame = class(TAbstractIDEOptionsEditor)
|
||||
ButtonDefault: TButton;
|
||||
DirectoryEdit1: TDirectoryEdit;
|
||||
Label1: TLabel;
|
||||
procedure ButtonDefaultClick(Sender: TObject);
|
||||
|
||||
private
|
||||
DefaultExamplesHome : string;
|
||||
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function GetTitle: String; override;
|
||||
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
|
||||
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
|
||||
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
procedure RestoreSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
ExWindowOptionsGroup : integer;
|
||||
ExWinOptionsFrameID : integer;
|
||||
|
||||
implementation
|
||||
|
||||
uses Dialogs, LazLogger, UConst, baseIDEIntf, LazConfigStorage, LazFileUtils,
|
||||
LazIDEIntf;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TExWinSettings }
|
||||
|
||||
constructor TExWinSettings.Create(const pbReadRegFile: boolean);
|
||||
begin
|
||||
// inherited Create;
|
||||
end;
|
||||
|
||||
destructor TExWinSettings.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class function TExWinSettings.GetGroupCaption: String;
|
||||
begin
|
||||
Result := rsExampleProjects;
|
||||
end;
|
||||
|
||||
class function TExWinSettings.GetInstance: TAbstractIDEOptions;
|
||||
begin
|
||||
//result := TAbstractIDEOptions(self); // Nope, it does not like that !
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
procedure TExWinSettings.DoAfterWrite(Restore: boolean);
|
||||
begin
|
||||
inherited DoAfterWrite(Restore);
|
||||
end;
|
||||
|
||||
{ TExWinSettingsFrame }
|
||||
|
||||
|
||||
procedure TExWinSettingsFrame.ButtonDefaultClick(Sender: TObject);
|
||||
begin
|
||||
DirectoryEdit1.Text := DefaultExamplesHome;
|
||||
end;
|
||||
|
||||
constructor TExWinSettingsFrame.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
DefaultExamplesHome := AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)
|
||||
+ AppendPathDelim(cExamplesDir);
|
||||
end;
|
||||
|
||||
destructor TExWinSettingsFrame.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TExWinSettingsFrame.GetTitle: String;
|
||||
begin
|
||||
Result := rsExampleProjects;
|
||||
end;
|
||||
|
||||
procedure TExWinSettingsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
Config: TConfigStorage;
|
||||
begin
|
||||
try
|
||||
Config := GetIDEConfigStorage(cConfigFileName, true);
|
||||
try
|
||||
DirectoryEdit1.Text := Config.GetValue('Examples/Directory', DefaultExamplesHome);
|
||||
|
||||
finally
|
||||
Config.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn('TExWinSettingsFrame.ReadSettings Loading ' + cConfigFileName + ' failed: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
// Maybe the initial settings before we have a config file ? Labels and Captions.
|
||||
procedure TExWinSettingsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
|
||||
begin
|
||||
Label1.Caption := rsDirWhereExamplesGo;
|
||||
end;
|
||||
|
||||
class function TExWinSettingsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
// Gets called whenever user opens Options tree.
|
||||
procedure TExWinSettingsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
Config: TConfigStorage;
|
||||
begin
|
||||
try
|
||||
Config := GetIDEConfigStorage(cConfigFileName,false);
|
||||
try
|
||||
Config.SetDeleteValue('Examples/Directory',DirectoryEdit1.Text, DefaultExamplesHome);
|
||||
finally
|
||||
Config.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn('TExWinSettingsFrame.ReadSettings Saving ' + cConfigFileName + ' failed: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TExWinSettingsFrame.RestoreSettings(AOptions: TAbstractIDEOptions);
|
||||
begin
|
||||
inherited RestoreSettings(AOptions);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
ExWindowOptionsGroup := GetFreeIDEOptionsGroupIndex(GroupEditor);
|
||||
RegisterIDEOptionsGroup(ExWindowOptionsGroup, TExWinSettings, False); // F cos I get Index from above line. I think.
|
||||
|
||||
|
||||
end.
|
||||
66
components/exampleswindow/uconst.pas
Normal file
66
components/exampleswindow/uconst.pas
Normal file
@ -0,0 +1,66 @@
|
||||
unit uConst;
|
||||
{
|
||||
**********************************************************************
|
||||
This file is part of a Lazarus Package, Examples Window.
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
**********************************************************************
|
||||
|
||||
This unit provides the Example Projects package with a few constants and
|
||||
a number of string literals that will i18n translation.
|
||||
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
const
|
||||
cRemoteRepository = 'https://gitlab.com/api/v4/projects/32866275/repository/';
|
||||
// Immediate Local dir name under which we copy or
|
||||
cExamplesDir = 'examples_work_dir'; // download examples to. Carefull about simplifying it
|
||||
cConfigFileName = 'exampleprojectscfg.xml';
|
||||
|
||||
resourcestring
|
||||
|
||||
// --------- Multiple units
|
||||
rsExampleProjects = 'Example Projects';
|
||||
|
||||
// ---------- uLaz_Examples
|
||||
rsExSearchPrompt = 'Search Here';
|
||||
rsExNoProjectFile = 'Maybe no project file ?';
|
||||
rsFoundExampleProjects = 'Found %d Example Projects';
|
||||
rsRefreshExistingExample = 'Refresh Existing Example ?';
|
||||
rsExDownloadingProject = 'Downloading Project...';
|
||||
rsExCopyingProject = 'Copying Project...';
|
||||
rsExProjectDownloadedTo = 'Project Downloaded to'; // followed by a full path name
|
||||
rsExProjectCopiedTo = 'Project Copied to'; // followed by a full path name
|
||||
rsExampleName = 'Name'; // Column title
|
||||
rsExamplePath = 'Path'; // "
|
||||
rsExampleKeyWords = 'Key Words'; // "
|
||||
rsExSearchingForExamples = 'Searching for Examples';
|
||||
rsFailedToCopyFilesTo = 'Failed to copy files to'; // Followed by a dir were we, apparently, cannot write
|
||||
|
||||
// These are ObjectInspector set but I believe I cannot get OI literals i18n in a Package ??
|
||||
rsExampleOpen = 'Open'; // Button Caption
|
||||
rsExampleDownload = 'Download'; // "
|
||||
rsExampleClose = 'Close'; // "
|
||||
rsExampleCategory = 'Category'; // "
|
||||
|
||||
// Settings Frame
|
||||
rsDirWhereExamplesGo = 'Directory where Examples go';
|
||||
|
||||
// ------- rsExampleData
|
||||
// Most literals in uExampleData are for debugging only and very unlikely to be
|
||||
// seen by the end user. But a couple of network related ones may need i18n -
|
||||
rsExNetWorkError = 'GitLab NetWork Error'; // Followed by system error msg
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
1006
components/exampleswindow/uexampledata.pas
Normal file
1006
components/exampleswindow/uexampledata.pas
Normal file
File diff suppressed because it is too large
Load Diff
106
components/exampleswindow/uintf.pas
Normal file
106
components/exampleswindow/uintf.pas
Normal file
@ -0,0 +1,106 @@
|
||||
unit uIntf;
|
||||
|
||||
{
|
||||
**********************************************************************
|
||||
This file is part of a Lazarus Package, Examples Window.
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
**********************************************************************
|
||||
|
||||
This unit provides the interface between Lazarus and the Package.
|
||||
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
//LCL,
|
||||
LCLType,
|
||||
//IDEIntf,
|
||||
MenuIntf, IDECommands, ToolBarIntf, IDEOptEditorIntf;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses uLaz_Examples, uConst, lazlogger,
|
||||
LazIDEintf, LazFileUtils, BuildIntf, ExWinSettings,
|
||||
baseIDEIntf, IDEOptionsIntf, LazConfigStorage, SysUtils;
|
||||
|
||||
// Note : IDEEnvironmentOptions.GetParsedLazarusDirectory is the Lazarus STC tree.
|
||||
|
||||
function GetExamplesHomeDir() : string;
|
||||
var
|
||||
Config: TConfigStorage;
|
||||
begin
|
||||
try
|
||||
Config := GetIDEConfigStorage(cConfigFileName, true);
|
||||
try
|
||||
Result := Config.GetValue('Examples/Directory',
|
||||
AppendPathDelim(LazarusIDE.GetPrimaryConfigPath) +
|
||||
AppendPathDelim(cExamplesDir));
|
||||
|
||||
finally
|
||||
Config.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn('Examples UIntf GetExamplesDirectory Loading ' + cConfigFileName + ' failed: ' + E.Message);
|
||||
Result := IDEEnvironmentOptions.GetParsedLazarusDirectory;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure IDEMenuSectionClicked(Sender: TObject);
|
||||
var
|
||||
ProjectFFile : string;
|
||||
begin
|
||||
FormLazExam := TFormLazExam.Create(nil);
|
||||
try
|
||||
FormLazExam.ExamplesHome := GetExamplesHomeDir();
|
||||
FormLazExam.RemoteRepo := cRemoteRepository;
|
||||
FormLazExam.ShowModal;
|
||||
ProjectFFile := FormLazExam.ProjectToOpen;
|
||||
finally
|
||||
FormLazExam.Free;
|
||||
FormLazExam := nil;
|
||||
end;
|
||||
if ProjectFFile <> '' then
|
||||
LazarusIDE.DoOpenProjectFile(ProjectFFile, [ofProjectLoading]);
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
var
|
||||
IDEShortCutX: TIDEShortCut;
|
||||
IDECommandCategory: TIDECommandCategory;
|
||||
IDECommand: TIDECommand;
|
||||
begin
|
||||
IDEShortCutX := IDEShortCut(VK_E, [ssCtrl, ssAlt], VK_UNKNOWN, []);
|
||||
IDECommandCategory := IDECommandList.FindCategoryByName('ToolMenu');
|
||||
IDECommand := nil;
|
||||
if IDECommandCategory <> nil then
|
||||
begin
|
||||
IDECommand := RegisterIDECommand(IDECommandCategory, rsExampleProjects, rsExampleProjects, IDEShortCutX, nil, @IDEMenuSectionClicked);
|
||||
if IDECommand <> nil then
|
||||
RegisterIDEButtonCommand(IDECommand);
|
||||
end;
|
||||
RegisterIDEMenuCommand(itmSecondaryTools, rsExampleProjects, rsExampleProjects + ' ...', nil, @IDEMenuSectionClicked, IDECommand, 'pkg_oep');
|
||||
RegisterIDEMenuCommand(ComponentPalettePageDropDownExtraEntries, rsExampleProjects, rsExampleProjects + ' ...', nil, @IDEMenuSectionClicked, nil, 'pkg_oep');
|
||||
|
||||
ExWinOptionsFrameID := RegisterIDEOptionsEditor(ExWindowOptionsGroup, TExWinSettingsFrame, 9999)^.Index; // AIndex = what ???
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
|
||||
finalization
|
||||
|
||||
|
||||
end.
|
||||
|
||||
194
components/exampleswindow/ulaz_examples.lfm
Normal file
194
components/exampleswindow/ulaz_examples.lfm
Normal file
@ -0,0 +1,194 @@
|
||||
object FormLazExam: TFormLazExam
|
||||
Left = 562
|
||||
Height = 574
|
||||
Top = 168
|
||||
Width = 781
|
||||
Caption = 'Prototype Lazarus Examples Window'
|
||||
ClientHeight = 574
|
||||
ClientWidth = 781
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
LCLVersion = '2.3.0.0'
|
||||
object Memo1: TMemo
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Splitter2
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = CheckGroupCategory
|
||||
Left = 5
|
||||
Height = 216
|
||||
Top = 225
|
||||
Width = 771
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 5
|
||||
BorderSpacing.Right = 5
|
||||
BorderSpacing.Bottom = 5
|
||||
Lines.Strings = (
|
||||
'Memo1'
|
||||
)
|
||||
ParentShowHint = False
|
||||
ReadOnly = True
|
||||
ScrollBars = ssAutoVertical
|
||||
TabOrder = 2
|
||||
end
|
||||
object ListView1: TListView
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Panel1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Splitter2
|
||||
Left = 5
|
||||
Height = 178
|
||||
Hint = 'Click for Info, Double Click to download'
|
||||
Top = 37
|
||||
Width = 776
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 5
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.Bottom = 5
|
||||
Columns = <
|
||||
item
|
||||
end
|
||||
item
|
||||
end
|
||||
item
|
||||
Width = 661
|
||||
end>
|
||||
ParentShowHint = False
|
||||
ReadOnly = True
|
||||
ShowHint = True
|
||||
TabOrder = 1
|
||||
OnClick = ListView1Click
|
||||
OnDblClick = ListView1DblClick
|
||||
OnSelectItem = ListView1SelectItem
|
||||
end
|
||||
object CheckGroupCategory: TCheckGroup
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = ButtonOpen
|
||||
AnchorSideRight.Control = ButtonClose
|
||||
AnchorSideBottom.Control = StatusBar1
|
||||
Left = 10
|
||||
Height = 105
|
||||
Top = 446
|
||||
Width = 577
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
AutoFill = True
|
||||
BorderSpacing.Left = 10
|
||||
BorderSpacing.Right = 10
|
||||
Caption = 'Category'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 6
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 2
|
||||
Columns = 2
|
||||
OnItemClick = CheckGroupCategoryItemClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object Splitter2: TSplitter
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = ListView1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Memo1
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 220
|
||||
Width = 781
|
||||
Align = alNone
|
||||
Anchors = [akLeft, akRight]
|
||||
ResizeAnchor = akTop
|
||||
end
|
||||
object Panel1: TPanel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 32
|
||||
Top = 0
|
||||
Width = 781
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ClientHeight = 32
|
||||
ClientWidth = 781
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
object EditSearch: TEdit
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 10
|
||||
Height = 29
|
||||
Hint = 'Searches for Keywords'
|
||||
Top = 1
|
||||
Width = 415
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 9
|
||||
BorderSpacing.Right = 25
|
||||
OnExit = EditSearchExit
|
||||
OnKeyUp = EditSearchKeyUp
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 0
|
||||
Text = 'EditSearch'
|
||||
end
|
||||
end
|
||||
object StatusBar1: TStatusBar
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 551
|
||||
Width = 781
|
||||
Panels = <>
|
||||
end
|
||||
object ButtonDownload: TButton
|
||||
AnchorSideLeft.Control = ButtonClose
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = ButtonClose
|
||||
Left = 597
|
||||
Height = 35
|
||||
Top = 481
|
||||
Width = 179
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Right = 5
|
||||
Caption = 'Download'
|
||||
OnClick = ButtonDownloadClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object ButtonClose: TButton
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = StatusBar1
|
||||
Left = 597
|
||||
Height = 35
|
||||
Top = 516
|
||||
Width = 179
|
||||
Anchors = [akRight, akBottom]
|
||||
BorderSpacing.Right = 5
|
||||
Caption = 'Close'
|
||||
OnClick = ButtonCloseClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object ButtonOpen: TButton
|
||||
AnchorSideLeft.Control = ButtonClose
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = ButtonDownload
|
||||
Left = 597
|
||||
Height = 35
|
||||
Top = 446
|
||||
Width = 179
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Right = 5
|
||||
Caption = 'Open'
|
||||
OnClick = ButtonOpenClick
|
||||
TabOrder = 8
|
||||
end
|
||||
end
|
||||
58
components/exampleswindow/ulaz_examples.lpi
Normal file
58
components/exampleswindow/ulaz_examples.lpi
Normal file
@ -0,0 +1,58 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="ulaz_examples"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="ulaz_examples.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="FormLazExam"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="uLaz_Examples"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="uexampledata.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="ulaz_examples"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
471
components/exampleswindow/ulaz_examples.pas
Normal file
471
components/exampleswindow/ulaz_examples.pas
Normal file
@ -0,0 +1,471 @@
|
||||
unit uLaz_Examples;
|
||||
{
|
||||
**********************************************************************
|
||||
This file is part of a Lazarus Package, Examples Window.
|
||||
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
**********************************************************************
|
||||
|
||||
This unit displays all the examples that it can find metadata for. At present it
|
||||
looks in the LazarusDir and then the LazConfigDir (but can be made to look online).
|
||||
|
||||
It scans the examples and makes Catagory Checkboxes for all the Categories it finds.
|
||||
|
||||
In OnLine mode, will look for a master meta file in LazConfigDir/examples
|
||||
If its not there, it will try to download one from Remote.
|
||||
In either case will scan the LazConfigDir (excluding Examples ???) looking for
|
||||
potential 'other' example projects, recognisable by a valid json file with an
|
||||
extension of ex-meta.
|
||||
|
||||
Notes -
|
||||
We have a search field across the top, its requires user to press enter,
|
||||
performance notwithstanding, it could be converted to update with every key press.
|
||||
|
||||
David Bannon, Feb 2022
|
||||
}
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{x$define ONLINE_EXAMPLES}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
|
||||
ExtCtrls, Interfaces, uexampledata, uConst
|
||||
{$ifndef EXTESTMODE}
|
||||
, IDEWindowIntf
|
||||
{$endif}
|
||||
;
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TFormLazExam }
|
||||
|
||||
TFormLazExam = class(TForm)
|
||||
ButtonDownload: TButton;
|
||||
ButtonClose: TButton;
|
||||
ButtonOpen: TButton;
|
||||
CheckGroupCategory: TCheckGroup;
|
||||
EditSearch: TEdit;
|
||||
ListView1: TListView;
|
||||
Memo1: TMemo;
|
||||
Panel1: TPanel;
|
||||
Splitter2: TSplitter;
|
||||
StatusBar1: TStatusBar;
|
||||
procedure ButtonCloseClick(Sender: TObject);
|
||||
procedure ButtonDownloadClick(Sender: TObject);
|
||||
procedure ButtonOpenClick(Sender: TObject);
|
||||
procedure CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
|
||||
procedure EditSearchExit(Sender: TObject);
|
||||
procedure EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure ListView1Click(Sender: TObject);
|
||||
procedure ListView1DblClick(Sender: TObject);
|
||||
procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
|
||||
private
|
||||
procedure BuildSearchList(SL: TStringList; const Term: AnsiString);
|
||||
// SrcDir includes name of actual dir, DestDir does not.
|
||||
function CopyFiles(const Proj, SrcDir, DestDir: string): boolean;
|
||||
function DirExistsCaseInSense(const APath: string; out ActualFullDir: string) : boolean;
|
||||
// Passed the Full Path (with or without trailing delim) to a Project Dir, rets F if not
|
||||
// present, T if Dir exists. If it finds an lpi file, rets with FFilename, else empty string.
|
||||
// WriteProjectToOpen will cause a download / copy of the files.
|
||||
// Sets the Regional Var, ProjectToOpen if WriteProjectToOpen is true.
|
||||
// Thats triggers a Lazarus Open when this window closes.
|
||||
function GetProjectFile(const APath: string; WriteProjectToOpen: boolean = false): boolean;
|
||||
procedure KeyWordSearch;
|
||||
function NewLVItem(const LView : TListView; const Proj, Path, KeyWords : string): TListItem;
|
||||
// Displays the current content of Examples List in the listview and
|
||||
// populates the Category checkboxes.
|
||||
procedure LoadUpListView();
|
||||
procedure PrimeCatFilter;
|
||||
public
|
||||
GitDir : string; // Not needed in Lazarus Package, used in dev's tool emt
|
||||
//LazConfigDir : string; // We will download examples to here.
|
||||
ExamplesHome : string; // Defaults to LazConfig but user settable
|
||||
RemoteRepo : string; // This is the full gitlab URL
|
||||
ProjectToOpen : string; // If not empty after close, open the project named.
|
||||
end;
|
||||
|
||||
var
|
||||
FormLazExam: TFormLazExam;
|
||||
Ex : TExampleData;
|
||||
|
||||
implementation
|
||||
|
||||
uses LazFileUtils, LCLType, fileutil, LazLogger;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TFormLazExam }
|
||||
|
||||
|
||||
// ------------------------ L I S T V I E W ----------------------------------
|
||||
|
||||
function TFormLazExam.NewLVItem(const LView : TListView; const Proj, Path, KeyWords : string): TListItem;
|
||||
var
|
||||
TheItem : TListItem;
|
||||
begin
|
||||
TheItem := LView.Items.Add;
|
||||
TheItem.Caption := Proj;
|
||||
TheItem.SubItems.Add(KeyWords);
|
||||
TheItem.SubItems.Add(Path);
|
||||
Result := TheItem;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
|
||||
begin
|
||||
ListView1Click(Sender);
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.LoadUpListView();
|
||||
var
|
||||
Proj, Cat, Path, KeyW : string;
|
||||
Cnt : integer = 0;
|
||||
KeyList : TStringList = nil;
|
||||
begin
|
||||
Screen.Cursor := crHourGlass;
|
||||
if EditSearch.text <> rsExSearchPrompt then begin
|
||||
KeyList := TStringList.Create;
|
||||
BuildSearchList(KeyList, EditSearch.Text);
|
||||
end;
|
||||
try
|
||||
if Ex.GetListData(Proj, Cat, Path, KeyW, True, KeyList) then begin
|
||||
NewLVItem(ListView1, Proj, Path, KeyW);
|
||||
inc(Cnt);
|
||||
end;
|
||||
while Ex.GetListData(Proj, Cat, Path, KeyW, False, KeyList) do begin
|
||||
NewLVItem(ListView1, Proj, Path, KeyW);
|
||||
inc(Cnt);
|
||||
end;
|
||||
finally
|
||||
if KeyList <> Nil then KeyList.Free;
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
ButtonOpen.Enabled := false;
|
||||
ButtonDownLoad.enabled := false;
|
||||
Memo1.append(format(rsFoundExampleProjects, [Cnt]));
|
||||
StatusBar1.SimpleText := format(rsFoundExampleProjects, [Cnt]);
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.ListView1Click(Sender: TObject);
|
||||
begin
|
||||
if ListView1.Selected = nil then exit; // White space below entries ....
|
||||
Memo1.Clear;
|
||||
Memo1.append(ListView1.Selected.SubItems[1]);
|
||||
Memo1.Append(Ex.GetDesc(ListView1.Selected.SubItems[1] + ListView1.Selected.Caption));
|
||||
// ListView1.Selected.Caption may be CamelCase from JSON.Name rather than path where we found it.
|
||||
ButtonDownLoad.enabled := true;
|
||||
//ButtonOpen.Enabled := GetProjectFile(ListView1.Selected.SubItems[1]);
|
||||
ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
|
||||
end;
|
||||
|
||||
function TFormLazExam.CopyFiles(const Proj, SrcDir, DestDir : string) : boolean;
|
||||
var
|
||||
STL : TStringList;
|
||||
St, FFname : string;
|
||||
|
||||
// The Right part of St starting with Proj
|
||||
function RightSide : string;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
result := '';
|
||||
i := St.Length;
|
||||
while i > 0 do begin
|
||||
if (PathDelim + lowercase(Proj) + PathDelim) = lowercase(copy(St, i, Proj.length+2)) then
|
||||
exit(copy(St, i, 1000));
|
||||
dec(i);
|
||||
end;
|
||||
debugln('TFormLazExam.CopyFiles - failed to find [' + Proj + '] in ' + St);
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
STL := FindAllFiles(SrcDir, '*', True);
|
||||
try
|
||||
for St in STL do begin
|
||||
FFName := appendPathDelim(DestDir) + RightSide();
|
||||
|
||||
debugln('TFormLazExam.CopyFiles Forcing an ExamplesHome of ' + extractFileDir(FFname));
|
||||
debugln('TFormLazExam.CopyFiles Copying a file to ' + FFname);
|
||||
debugln('TFormLazExam.CopyFiles DestDir = ' + DestDir);
|
||||
debugln('TFormLazExam.CopyFiles ExamplesHome = ' + ExamplesHome);
|
||||
if not ForceDirectoriesUTF8(extractFileDir(FFName)) then begin
|
||||
debugln('TFormLazExam.CopyFiles - Failed to force ' + extractFileDir(FFName));
|
||||
exit;
|
||||
end;
|
||||
if not copyfile(St, FFname, [cffOverwriteFile]) then begin
|
||||
debugln('TFormLazExam.CopyFiles - Failed to copy ' + St + ' to ' + FFName);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
STL.Free;
|
||||
end;
|
||||
result := true;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.ListView1DblClick(Sender: TObject);
|
||||
begin
|
||||
if ListView1.Selected = nil then exit; // White space below entries ....
|
||||
if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption) then begin
|
||||
if Application.MessageBox(pchar(rsRefreshExistingExample)
|
||||
, pchar(ListView1.Selected.Caption)
|
||||
, MB_ICONQUESTION + MB_YESNO) <> IDYES then exit;
|
||||
// OK - we overwrite. Any other files user has added are not removed
|
||||
end;
|
||||
Screen.Cursor := crHourGlass;
|
||||
try
|
||||
if Ex <> nil then begin
|
||||
{$ifdef ONLINE_EXAMPLES}
|
||||
StatusBar1.SimpleText := rsExDownloadingProject;
|
||||
Application.ProcessMessages;
|
||||
EX.DownLoadDir(ListView1.Selected.SubItems[1]);
|
||||
StatusBar1.SimpleText := rsExProjectDownloadedTo + ' ' + Ex.MasterMeta(True)
|
||||
+ ListView1.Selected.Caption;
|
||||
{$else}
|
||||
StatusBar1.SimpleText := rsExCopyingProject;
|
||||
Application.ProcessMessages;
|
||||
if copyFiles( ListView1.Selected.Caption,
|
||||
ListView1.Selected.SubItems[1], Ex.MasterMeta(True)) then
|
||||
StatusBar1.SimpleText := rsExProjectCopiedTo + ' ' + Ex.MasterMeta(True)
|
||||
else StatusBar1.SimpleText := rsFailedToCopyFilesTo + ' ' + Ex.MasterMeta(True);
|
||||
{$endif}
|
||||
end;
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
ButtonOpen.Enabled := GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption);
|
||||
end;
|
||||
|
||||
// --------------------- B U T T O N S -----------------------------------------
|
||||
|
||||
procedure TFormLazExam.ButtonOpenClick(Sender: TObject);
|
||||
begin
|
||||
if GetProjectFile(Ex.MasterMeta(True) + ListView1.Selected.Caption, True) // Sets ProjectToOpen on success
|
||||
and ProjectToOpen.IsEmpty then
|
||||
showmessage(rsExNoProjectFile)
|
||||
else
|
||||
close;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.ButtonCloseClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.ButtonDownloadClick(Sender: TObject);
|
||||
begin
|
||||
ListView1DblClick(Sender);
|
||||
end;
|
||||
|
||||
function TFormLazExam.GetProjectFile(const APath : string; WriteProjectToOpen : boolean = false) : boolean;
|
||||
var
|
||||
Info : TSearchRec;
|
||||
RealDir : string;
|
||||
// The project dir name may not be a case match for the Project Name.
|
||||
begin
|
||||
Result := DirExistsCaseInSense(APath, RealDir);
|
||||
if not (Result and WriteProjectToOpen) then exit;
|
||||
if FindFirst(RealDir + '*.lpi', faAnyFile, Info) = 0 then
|
||||
ProjectToOpen := RealDir + Info.Name
|
||||
else ProjectToOpen := '';
|
||||
FindClose(Info);
|
||||
end;
|
||||
|
||||
// Checks for existance of passed path, the last element of which is case Insensitive.
|
||||
// Returns with the actual name of the full path if successful.
|
||||
function TFormLazExam.DirExistsCaseInSense(const APath : string; out ActualFullDir : string) : boolean;
|
||||
var
|
||||
Info : TSearchRec;
|
||||
FName : string;
|
||||
begin
|
||||
FName := lowercase(extractFileName(ChompPathDelim(APath)));
|
||||
if FindFirst(extractFileDir(ChompPathDelim(APath))+PathDelim + '*',faDirectory, Info) = 0 then begin
|
||||
try
|
||||
repeat
|
||||
if (Info.Attr and faDirectory) = faDirectory then
|
||||
if lowercase(Info.Name) = FName then begin
|
||||
ActualFullDir := extractFileDir(ChompPathDelim(APath))
|
||||
+PathDelim + Info.Name + PathDelim;
|
||||
exit(True);
|
||||
end;
|
||||
until FindNext(Info) <> 0;
|
||||
finally
|
||||
FindClose(Info);
|
||||
end;
|
||||
end;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.CheckGroupCategoryItemClick(Sender: TObject; Index: integer);
|
||||
begin
|
||||
if Ex = Nil then exit;
|
||||
Memo1.clear;
|
||||
ListView1.Clear;
|
||||
PrimeCatFilter();
|
||||
LoadUpListView();
|
||||
end;
|
||||
|
||||
|
||||
// ---------------------- S E A R C H R E L A T E D --------------------------
|
||||
|
||||
// Build a StringList of the terms user has typed in, words or "groups of words"
|
||||
procedure TFormLazExam.BuildSearchList(SL : TStringList; const Term : AnsiString);
|
||||
var
|
||||
I : integer = 1;
|
||||
AWord : string = '';
|
||||
InCommas : boolean = false;
|
||||
begin
|
||||
while I <= length(trim(Term)) do begin
|
||||
if Term[i] = '"' then begin
|
||||
if InCommas then begin
|
||||
SL.add(AWord);
|
||||
AWord := '';
|
||||
InCommas := False;
|
||||
end else begin
|
||||
InCommas := true;
|
||||
end;
|
||||
inc(I);
|
||||
continue;
|
||||
end;
|
||||
if Term[i] = ' ' then begin
|
||||
if InCommas then
|
||||
AWord := AWord + Term[i]
|
||||
else begin
|
||||
if AWord <> '' then begin
|
||||
SL.Add(AWord);
|
||||
AWord := '';
|
||||
end;
|
||||
end;
|
||||
inc(I);
|
||||
continue;
|
||||
end;
|
||||
AWord := AWord + Term[i];
|
||||
inc(i);
|
||||
continue;
|
||||
end;
|
||||
if AWord <> '' then
|
||||
SL.Add(AWord);
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.EditSearchExit(Sender: TObject);
|
||||
begin
|
||||
if EditSearch.Text = '' then begin
|
||||
EditSearch.Hint:= rsExSearchPrompt;
|
||||
EditSearch.Text := rsExSearchPrompt;
|
||||
EditSearch.SelStart := 1;
|
||||
EditSearch.SelLength := length(EditSearch.Text);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.KeyWordSearch();
|
||||
begin
|
||||
Memo1.clear;
|
||||
ListView1.Clear;
|
||||
Ex.KeyFilter := EditSearch.Text;
|
||||
LoadUpListView();
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.EditSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
// Must do this here to stop LCL from selecting the text on VK_RETURN
|
||||
if Key = VK_RETURN then begin
|
||||
Key := 0;
|
||||
KeyWordSearch();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.PrimeCatFilter();
|
||||
var
|
||||
i : integer;
|
||||
St : string = '';
|
||||
begin
|
||||
for i := 0 to CheckGroupCategory.Items.Count -1 do begin
|
||||
if CheckGroupCategory.Checked[i] then
|
||||
St := St + CheckGroupCategory.Items[i] + ' ';
|
||||
end;
|
||||
Ex.CatFilter := St;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------- H O U S E K E E P I N G ------------------------------
|
||||
|
||||
procedure TFormLazExam.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption := rsExampleProjects;
|
||||
ListView1.Column[0].Caption := rsExampleName;
|
||||
ListView1.Column[1].Caption := rsExampleKeyWords;
|
||||
ListView1.Column[2].Caption := rsExamplePath;
|
||||
ListView1.AutoSortIndicator := True;
|
||||
ListView1.Column[0].SortIndicator := siDescending;
|
||||
ListView1.AutoSort := True;
|
||||
ListView1.SortDirection:= sdDescending;
|
||||
ListView1.AutoWidthLastColumn:= True;
|
||||
ListView1.ViewStyle:= vsReport;
|
||||
ListView1.Column[0].AutoSize := true;
|
||||
ListView1.Column[1].AutoSize := true;
|
||||
ListView1.Column[2].Visible := false;
|
||||
ListView1.ReadOnly := True;
|
||||
EditSearch.text := rsExSearchPrompt;
|
||||
Ex := nil;
|
||||
// These are ObjectInspector set but I believe I cannot get OI literals set in a Package ??
|
||||
ButtonClose.Caption := rsExampleClose;
|
||||
ButtonDownload.Caption := rsExampleDownLoad;
|
||||
ButtonOpen.Caption := rsExampleOpen;
|
||||
CheckGroupCategory.Caption := rsExampleCategory;
|
||||
{$ifndef EXTESTMODE}
|
||||
IDEDialogLayoutList.ApplyLayout(Self);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
if Ex <> nil then Ex.Free;
|
||||
end;
|
||||
|
||||
procedure TFormLazExam.FormShow(Sender: TObject);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Memo1.clear;
|
||||
if Ex <> Nil then Ex.Free;
|
||||
StatusBar1.SimpleText := rsExSearchingForExamples;
|
||||
Ex := TExampleData.Create();
|
||||
Ex.GitDir := GitDir;
|
||||
Ex.ExamplesHome := ExamplesHome;
|
||||
Ex.RemoteRepo := RemoteRepo;
|
||||
{$ifdef ONLINE_EXAMPLES}
|
||||
Ex.LoadExData(FromCacheFile);
|
||||
{$else}
|
||||
Ex.LoadExData(FromLazSrcTree);
|
||||
{$endif}
|
||||
if Ex.ErrorMsg <> '' then
|
||||
Showmessage(Ex.ErrorMsg)
|
||||
else begin
|
||||
ex.getCategoryData(CheckGroupCategory.Items); // This sets the name of all categories in the CheckGroup
|
||||
for i := 0 to CheckGroupCategory.items.Count-1 do // check all the categories we found.
|
||||
CheckGroupCategory.Checked[i] := true;
|
||||
ListView1.Clear;
|
||||
PrimeCatFilter();
|
||||
LoadUpListView();
|
||||
end;
|
||||
if EditSearch.Text <> rsExSearchPrompt then
|
||||
KeyWordSearch()
|
||||
else EditSearch.SetFocus;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
{ Must add a FormClose event
|
||||
IDEDialogLayoutList.SaveLayout(Self);
|
||||
}
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user