mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-04 13:58:16 +02:00
New PoChecker IDE package from Bart Broersma
git-svn-id: trunk@34404 -
This commit is contained in:
juha
parent
3b7d2b72f2
commit
01233f98fe
10
.gitattributes
vendored
10
.gitattributes
vendored
@ -1937,6 +1937,16 @@ components/plotfunction/regplotpanel.lrs svneol=native#text/pascal
|
|||||||
components/plotfunction/regplotpanel.pp svneol=native#text/plain
|
components/plotfunction/regplotpanel.pp svneol=native#text/plain
|
||||||
components/plotfunction/tplotexpressionpanel.png -text svneol=unset#image/png
|
components/plotfunction/tplotexpressionpanel.png -text svneol=unset#image/png
|
||||||
components/plotfunction/tplotfunctionpanel.png -text svneol=unset#image/png
|
components/plotfunction/tplotfunctionpanel.png -text svneol=unset#image/png
|
||||||
|
components/pochecker/.directory svneol=native#text/plain
|
||||||
|
components/pochecker/README.txt svneol=native#text/plain
|
||||||
|
components/pochecker/pochecker.lpk svneol=native#text/plain
|
||||||
|
components/pochecker/pochecker.pas svneol=native#text/plain
|
||||||
|
components/pochecker/pocheckermain.lfm svneol=native#text/plain
|
||||||
|
components/pochecker/pocheckermain.pp svneol=native#text/plain
|
||||||
|
components/pochecker/pofamilies.pp svneol=native#text/plain
|
||||||
|
components/pochecker/resultdlg.lfm svneol=native#text/plain
|
||||||
|
components/pochecker/resultdlg.pp svneol=native#text/plain
|
||||||
|
components/pochecker/simplepofiles.pp svneol=native#text/plain
|
||||||
components/prettymessages/README.txt svneol=native#text/plain
|
components/prettymessages/README.txt svneol=native#text/plain
|
||||||
components/prettymessages/hidefpchints.pas svneol=native#text/plain
|
components/prettymessages/hidefpchints.pas svneol=native#text/plain
|
||||||
components/prettymessages/prettymessages.lpk svneol=native#text/plain
|
components/prettymessages/prettymessages.lpk svneol=native#text/plain
|
||||||
|
|||||||
5
components/pochecker/.directory
Normal file
5
components/pochecker/.directory
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
[Dolphin]
|
||||||
|
AdditionalInfoV2=Details_Size,Details_Date,CustomizedDetails
|
||||||
|
Timestamp=2011,12,25,14,41,0
|
||||||
|
Version=2
|
||||||
|
ViewMode=1
|
||||||
7
components/pochecker/README.txt
Normal file
7
components/pochecker/README.txt
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
This package checks the validity of translated PO files.
|
||||||
|
|
||||||
|
Original version made by Bart Broersma
|
||||||
|
|
||||||
|
ToDo:
|
||||||
|
- Find automatically all PO files belonging to the current project.
|
||||||
|
- Improve IDE integration
|
||||||
75
components/pochecker/pochecker.lpk
Normal file
75
components/pochecker/pochecker.lpk
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="4">
|
||||||
|
<Name Value="PoChecker"/>
|
||||||
|
<AddToProjectUsesSection Value="True"/>
|
||||||
|
<Author Value="Bart Broersma"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<UseMsgFile Value="True"/>
|
||||||
|
</CompilerMessages>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Description Value="Check the validity of translated PO files.
|
||||||
|
"/>
|
||||||
|
<Version Major="1"/>
|
||||||
|
<Files Count="7">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="resultdlg.lfm"/>
|
||||||
|
<Type Value="LFM"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Filename Value="resultdlg.pp"/>
|
||||||
|
<UnitName Value="ResultDlg"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Filename Value="pofamilies.pp"/>
|
||||||
|
<UnitName Value="PoFamilies"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Filename Value="pocheckermain.pp"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="pocheckermain"/>
|
||||||
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Filename Value="simplepofiles.pp"/>
|
||||||
|
<UnitName Value="SimplePoFiles"/>
|
||||||
|
</Item5>
|
||||||
|
<Item6>
|
||||||
|
<Filename Value="resultdlg.lfm"/>
|
||||||
|
<Type Value="LFM"/>
|
||||||
|
</Item6>
|
||||||
|
<Item7>
|
||||||
|
<Filename Value="pocheckermain.lfm"/>
|
||||||
|
<Type Value="LFM"/>
|
||||||
|
</Item7>
|
||||||
|
</Files>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<RequiredPkgs Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="SynEdit"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
||||||
21
components/pochecker/pochecker.pas
Normal file
21
components/pochecker/pochecker.pas
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
{ This file was automatically created by Lazarus. Do not edit!
|
||||||
|
This source is only used to compile and install the package.
|
||||||
|
}
|
||||||
|
|
||||||
|
unit PoChecker;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
ResultDlg, PoFamilies, pocheckermain, SimplePoFiles, LazarusPackageIntf;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterUnit('pocheckermain', @pocheckermain.Register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterPackage('PoChecker', @Register);
|
||||||
|
end.
|
||||||
149
components/pochecker/pocheckermain.lfm
Normal file
149
components/pochecker/pocheckermain.lfm
Normal file
@ -0,0 +1,149 @@
|
|||||||
|
object PoCheckerForm: TPoCheckerForm
|
||||||
|
Left = 409
|
||||||
|
Height = 295
|
||||||
|
Top = 133
|
||||||
|
Width = 463
|
||||||
|
Caption = 'GUI Po-file checking tool'
|
||||||
|
ClientHeight = 295
|
||||||
|
ClientWidth = 463
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
LCLVersion = '0.9.31'
|
||||||
|
object TestListBox: TCheckListBox
|
||||||
|
Left = 168
|
||||||
|
Height = 163
|
||||||
|
Top = 44
|
||||||
|
Width = 288
|
||||||
|
Enabled = False
|
||||||
|
ItemHeight = 0
|
||||||
|
OnItemClick = TestListBoxItemClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 168
|
||||||
|
Height = 15
|
||||||
|
Top = 24
|
||||||
|
Width = 105
|
||||||
|
Caption = 'Select test types'
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object OpenBtn: TBitBtn
|
||||||
|
Left = 8
|
||||||
|
Height = 79
|
||||||
|
Top = 44
|
||||||
|
Width = 144
|
||||||
|
Caption = '&Open a po-file'
|
||||||
|
Glyph.Data = {
|
||||||
|
36040000424D3604000000000000360000002800000010000000100000000100
|
||||||
|
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00005E8E8D005D
|
||||||
|
8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D
|
||||||
|
8CBD005D8CBD005D8CBD005D8CBD005E8E8D005B8900005B890000679AB06AB7
|
||||||
|
DAFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CCEDFF82CC
|
||||||
|
EDFF82CCEDFF82CCEDFF83CDEEFF318DB9C9005E8E40005F8F000070A9A256AA
|
||||||
|
CEFF80CBEAFF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9E9FF7EC9
|
||||||
|
E9FF7EC9E9FF7EC9E9FF7EC9E9FF57AFD6D90066996E006699000074AD9D44A1
|
||||||
|
CBFF8AD3EFFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CDEBFF83CD
|
||||||
|
EBFF83CDEBFF83CDEBFF83CDEBFF81CDEBF2006FA8930071AB010076B29952B0
|
||||||
|
D7FF85D2EDFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2EEFF89D2
|
||||||
|
EEFF89D2EEFF89D2EEFF89D2EEFF90D8F1FF228EC1AA0077B31D0079B69574CA
|
||||||
|
E8FF75CAE8FF90D8F2FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7F1FF8FD7
|
||||||
|
F1FF8FD7F1FF8FD7F1FF8FD7F1FF91D8F2FF4FB1DAC2007FBD46007CBA928FDD
|
||||||
|
F4FF63C0E5FFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EE
|
||||||
|
FAFFA8EEFAFFA8EEFAFFA8EEFAFFA8EEFAFF86D8EFDE0083C571007FBD8EA6EC
|
||||||
|
FCFF64C2E9FF4FB5E2FF4DB4E2FF4CB3E1FF4BB2E0FF49B1DFFF48B0DFFF47AE
|
||||||
|
DEFF45ADDDFF44ACDDFF46AEDFFF0084C6C70087CB810087CB610081C18BABF0
|
||||||
|
FEFFA4E9FCFFA2E7FBFF9FE5FAFF9CE3F8FF9AE1F7FF97DEF6FF94DCF4FF91D9
|
||||||
|
F3FF8ED7F1FF8BD4F0FF90D8F3FF0081C18B0087CA000087CB000083C488ADF1
|
||||||
|
FFFFA6EBFDFFA4E9FCFFA2E7FBFF9FE5FAFF9CE3F8FF9AE1F7FF97DEF6FF94DC
|
||||||
|
F4FF91D9F3FF8ED7F1FF93DAF4FF0083C4880083C4000085C8000085C785B0F4
|
||||||
|
FFFFADF1FFFFABF0FEFFA9EEFDFFA7ECFCFFA5EAFBFFA2E8FAFFA0E6F9FF9DE3
|
||||||
|
F8FF9AE1F7FF98DFF6FF99E0F7FF0085C7850085C7000085C7000087CA620087
|
||||||
|
CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF5F5EEFFEBEB
|
||||||
|
DDFFFEC941FFF4B62EFF0087CA830087CA620086C9000086C9000087CA000087
|
||||||
|
CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088CC810088
|
||||||
|
CC810088CC810088CC810088CC2E0087CA000086C9000086C900FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||||
|
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
||||||
|
}
|
||||||
|
OnClick = OpenBtnClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object RunBtn: TBitBtn
|
||||||
|
Left = 8
|
||||||
|
Height = 79
|
||||||
|
Top = 128
|
||||||
|
Width = 144
|
||||||
|
Caption = '&Run Selected Tests'
|
||||||
|
Enabled = False
|
||||||
|
Kind = bkOK
|
||||||
|
OnClick = RunBtnClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object StatusPanel: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 48
|
||||||
|
Top = 247
|
||||||
|
Width = 463
|
||||||
|
Align = alBottom
|
||||||
|
BevelOuter = bvLowered
|
||||||
|
ClientHeight = 48
|
||||||
|
ClientWidth = 463
|
||||||
|
TabOrder = 3
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 8
|
||||||
|
Width = 74
|
||||||
|
Caption = 'Current Test:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 15
|
||||||
|
Top = 24
|
||||||
|
Width = 87
|
||||||
|
Caption = 'Current po-file:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object CurTestLabel: TLabel
|
||||||
|
Left = 104
|
||||||
|
Height = 15
|
||||||
|
Top = 8
|
||||||
|
Width = 73
|
||||||
|
Caption = 'CurTestLabel'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object CurPoLabel: TLabel
|
||||||
|
Left = 104
|
||||||
|
Height = 15
|
||||||
|
Top = 24
|
||||||
|
Width = 65
|
||||||
|
Caption = 'CurPoLabel'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object NoErrLabel: TLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 24
|
||||||
|
Top = 216
|
||||||
|
Width = 171
|
||||||
|
Caption = 'No errors found'
|
||||||
|
Font.Color = clRed
|
||||||
|
Font.Height = -19
|
||||||
|
Font.Style = [fsBold]
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object OpenDialog: TOpenDialog
|
||||||
|
Filter = 'po-files (*.po)|*.po|all files|*'
|
||||||
|
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
|
||||||
|
left = 40
|
||||||
|
top = 512
|
||||||
|
end
|
||||||
|
end
|
||||||
335
components/pochecker/pocheckermain.pp
Normal file
335
components/pochecker/pocheckermain.pp
Normal file
@ -0,0 +1,335 @@
|
|||||||
|
{
|
||||||
|
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 <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
|
||||||
|
to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
|
||||||
|
MA 02111-1307, USA.
|
||||||
|
}
|
||||||
|
|
||||||
|
// Original version made by Bart Broersma
|
||||||
|
|
||||||
|
unit pocheckermain;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FileUtil, SynEdit, Forms, Controls, Graphics, Dialogs,
|
||||||
|
StdCtrls, LCLProc, CheckLst, Buttons, ExtCtrls, IDEIntf, MenuIntf,
|
||||||
|
SimplePoFiles, PoFamilies, ResultDlg;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TPoCheckerForm }
|
||||||
|
|
||||||
|
TPoCheckerForm = class(TForm)
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
CurTestLabel: TLabel;
|
||||||
|
CurPoLabel: TLabel;
|
||||||
|
NoErrLabel: TLabel;
|
||||||
|
StatusPanel: TPanel;
|
||||||
|
RunBtn: TBitBtn;
|
||||||
|
OpenBtn: TBitBtn;
|
||||||
|
Button3: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
OpenDialog: TOpenDialog;
|
||||||
|
TestListBox: TCheckListBox;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure OpenBtnClick(Sender: TObject);
|
||||||
|
procedure RunBtnClick(Sender: TObject);
|
||||||
|
procedure TestListBoxItemClick(Sender: TObject; Index: integer);
|
||||||
|
private
|
||||||
|
PoFamily: TPoFamily;
|
||||||
|
FChoosenMasterName: String;
|
||||||
|
FChoosenChildName: String;
|
||||||
|
procedure OnTestStart(const ATestName, APoFileName: String);
|
||||||
|
procedure OnTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||||
|
procedure FillTestListBox;
|
||||||
|
function GetOptionsFromListBox: TPoTestOptions;
|
||||||
|
procedure ShowError(const Msg: String);
|
||||||
|
function TrySelectFile: Boolean;
|
||||||
|
procedure RunSelectedTests;
|
||||||
|
procedure ClearAndDisableStatusPanel;
|
||||||
|
public
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
rsPoChecker = 'PO File Checker';
|
||||||
|
sSelectAllTests = 'Select all tests';
|
||||||
|
sUnSelectAllTests = 'Unselect all tests';
|
||||||
|
sCannotFindMaster = 'Cannot find master po file:'^m'%s'^m'for selected file'^m'%s';
|
||||||
|
sNotAProperFileName = 'Selected filename'^m'%s'^m'does not seem to be a proper name for a po-file';
|
||||||
|
sErrorOnCreate = 'Error creating an instance of TPoFamily:'^m'%s';
|
||||||
|
sErrorOnCleanup = 'An unrecoverable error occurred'^m'%s'^m'Please close the program';
|
||||||
|
|
||||||
|
sTotalErrors = 'Total errors found: %d';
|
||||||
|
//sNoErrorsFound = 'No errors found.';
|
||||||
|
sNoTestSelected = 'There are no tests selected.';
|
||||||
|
|
||||||
|
var
|
||||||
|
PoCheckerForm: TPoCheckerForm;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
procedure ShowPoCheckerForm();
|
||||||
|
begin
|
||||||
|
if not Assigned(PoCheckerForm) then
|
||||||
|
PoCheckerForm := TPoCheckerForm.Create(Application);
|
||||||
|
PoCheckerForm.Show;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TPoCheckerForm }
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FillTestListBox;
|
||||||
|
ClearAndDisableStatusPanel;
|
||||||
|
NoErrLabel.Visible := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if Assigned(PoFamily) then PoFamily.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.OpenBtnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if TrySelectFile then
|
||||||
|
begin
|
||||||
|
RunBtn.Enabled := True;
|
||||||
|
TestListBox.Enabled := True;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
RunBtn.Enabled := False;
|
||||||
|
TestListBox.Enabled := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.RunBtnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
RunSelectedTests;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.TestListBoxItemClick(Sender: TObject; Index: integer);
|
||||||
|
var
|
||||||
|
Check: Boolean;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
if (Index = TestListBox.Count - 1) then
|
||||||
|
begin//Run All Test checkbox
|
||||||
|
Check := TestListBox.Checked[Index];
|
||||||
|
for i := 0 to TestListBox.Count - 2 do TestListBox.Checked[i] := Check;
|
||||||
|
if Check then
|
||||||
|
TestListBox.Items[Index] := sUnSelectAllTests
|
||||||
|
else
|
||||||
|
TestListBox.Items[Index] := sSelectAllTests;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.OnTestStart(const ATestName, APoFileName: String);
|
||||||
|
begin
|
||||||
|
//debugln('OnTestStart: ATestName = "',AtestName,'" APoFileName = "',APoFileName);
|
||||||
|
CurTestLabel.Caption := ATestName;
|
||||||
|
CurPoLabel.Caption := APoFileName;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.OnTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||||
|
begin
|
||||||
|
//CurTestLabel.Caption := '';
|
||||||
|
//CurPoLabel.Caption := '';
|
||||||
|
debugln('OnTestEnd [',ATestName,']: ErrorCount = ',DbgS(ErrorCount));
|
||||||
|
//Application.ProcessMessages;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.FillTestListBox;
|
||||||
|
var
|
||||||
|
Opt: TPoTestOption;
|
||||||
|
begin
|
||||||
|
for Opt := Low(PoTestOptionNames) to High(PoTestOptionNames) do
|
||||||
|
begin
|
||||||
|
TestListBox.Items.Add(PoTestOptionNames[Opt]);
|
||||||
|
end;
|
||||||
|
TestListBox.Items.Add(sSelectAllTests);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPoCheckerForm.GetOptionsFromListBox: TPoTestOptions;
|
||||||
|
var
|
||||||
|
Opt: TPoTestOption;
|
||||||
|
Index: Integer;
|
||||||
|
begin
|
||||||
|
Result := [];
|
||||||
|
for Opt := Low(TpoTestOption) to High(TPoTestOption) do
|
||||||
|
begin
|
||||||
|
Index := Ord(Opt);
|
||||||
|
if (Index < TestListBox.Count) then
|
||||||
|
begin
|
||||||
|
if TestListBox.Checked[Index] then Result := Result + [Opt];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.ShowError(const Msg: String);
|
||||||
|
begin
|
||||||
|
MessageDlg('GPoCheck', Msg, mtError, [mbOk], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPoCheckerForm.TrySelectFile: Boolean;
|
||||||
|
var
|
||||||
|
Fn: String;
|
||||||
|
ShortFn: String;
|
||||||
|
OK: Boolean;
|
||||||
|
begin
|
||||||
|
NoErrLabel.Visible := False;
|
||||||
|
OK := False;
|
||||||
|
if OpenDialog.Execute then
|
||||||
|
begin
|
||||||
|
Fn := OpenDialog.FileName;
|
||||||
|
ShortFn := ExtractFileName(Fn);
|
||||||
|
if IsMasterPoName(Fn) then
|
||||||
|
begin
|
||||||
|
FChoosenMasterName := Fn;
|
||||||
|
FChoosenChildName := '';
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin //not a mastername, may be a child
|
||||||
|
FChoosenChildName := Fn;
|
||||||
|
FChoosenMasterName := ExtractMasterNameFromChildName(Fn);
|
||||||
|
if (FChoosenMasterName = '') then
|
||||||
|
begin
|
||||||
|
FChoosenMasterName := '';
|
||||||
|
FChoosenChildName := '';
|
||||||
|
ShowError(Format(sNotAProperFileName,[ShortFn]));
|
||||||
|
end
|
||||||
|
else if not FileExistsUtf8(FChoosenMasterName) then
|
||||||
|
begin
|
||||||
|
FChoosenMasterName := '';
|
||||||
|
FChoosenChildName := '';
|
||||||
|
ShowError(Format(sCannotFindMaster,[ShortFn]));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
OK := (FChoosenMasterName <> '');
|
||||||
|
if OK then
|
||||||
|
begin
|
||||||
|
if Assigned(PoFamily) then PoFamily.Free;
|
||||||
|
try
|
||||||
|
PoFamily := TPoFamily.Create(FChoosenMasterName, FChoosenChildName);
|
||||||
|
PoFamily.OnTestStart := @OnTestStart;
|
||||||
|
PoFamily.OnTestEnd := @OnTestEnd;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
OK := False;
|
||||||
|
ShowError(Format(sErrorOnCreate,[E.Message]));
|
||||||
|
if Assigned(PoFamily) then
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
PoFamily.Free;
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
ShowError(Format(sErrorOnCleanUp,[E.Message]));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := OK;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.RunSelectedTests;
|
||||||
|
var
|
||||||
|
Options: TPoTestOptions;
|
||||||
|
ErrorCount: Integer;
|
||||||
|
SL: TStrings;
|
||||||
|
ResultDlg: TResultDlgForm;
|
||||||
|
begin
|
||||||
|
Options := GetOptionsFromListBox;
|
||||||
|
if (Options = []) then
|
||||||
|
begin
|
||||||
|
ShowError(sNoTestSelected);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
NoErrLabel.Visible := False;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
SL := TStringList.Create;
|
||||||
|
try
|
||||||
|
StatusPanel.Enabled := True;
|
||||||
|
if (not (ptoFindAllChilds in Options)) and Assigned(PoFamily.Child) and
|
||||||
|
(PoFamily.ChildName <> FChoosenChildName) then PoFamily.ChildName := FChoosenChildName;
|
||||||
|
PoFamily.RunTests(Options, ErrorCount, SL);
|
||||||
|
if (ErrorCount > 0) then
|
||||||
|
begin
|
||||||
|
debugln('RunSelectedTests: ',Format(sTotalErrors,[ErrorCount]));
|
||||||
|
SL.Add(Format(sTotalErrors,[ErrorCount]));
|
||||||
|
ResultDlg := TResultDlgForm.Create(Nil);
|
||||||
|
try
|
||||||
|
ResultDlg.Log.Assign(SL);
|
||||||
|
FreeAndNil(SL); //No need to keep 2 copies of this data
|
||||||
|
ResultDlg.ShowModal;
|
||||||
|
finally
|
||||||
|
ResultDlg.Free;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin//no errors
|
||||||
|
NoErrLabel.Visible := True;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
if Assigned(SL) then
|
||||||
|
SL.Free;
|
||||||
|
ClearAndDisableStatusPanel;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoCheckerForm.ClearAndDisableStatusPanel;
|
||||||
|
begin
|
||||||
|
CurTestLabel.Caption := '';
|
||||||
|
CurPoLabel.Caption := '';
|
||||||
|
StatusPanel.Enabled := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SameItem(Item1, Item2: TPoFileItem): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (Item1.Identifier = Item2.Identifier) and
|
||||||
|
(Item1.Original = Item2.Original) and
|
||||||
|
(Item1.Context = Item2.Context) and
|
||||||
|
(Item1.Flags = Item2.Flags) and
|
||||||
|
(Item1.PreviousID = Item2.PreviousID) and
|
||||||
|
(Item1.Translation = Item2.Translation);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure IDEMenuClicked(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ShowPoCheckerForm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterIDEMenuCommand(itmSecondaryTools, 'mnuPoChecker', rsPoChecker, nil, @IDEMenuClicked);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
703
components/pochecker/pofamilies.pp
Normal file
703
components/pochecker/pofamilies.pp
Normal file
@ -0,0 +1,703 @@
|
|||||||
|
unit PoFamilies;
|
||||||
|
|
||||||
|
{ $define DebugSimplePoFiles}
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LCLProc, FileUtil, StringHashList,
|
||||||
|
{LConvEncoding}
|
||||||
|
//{$IFDEF UNIX}{$IFNDEF DisableCWString}, cwstring{$ENDIF}{$ENDIF},
|
||||||
|
SimplePoFiles;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
TPoTestOption = (ptoCheckNrOfItems, ptoCheckFormatArgs, ptoCheckMissingIdentifiers,
|
||||||
|
ptoCheckMismatchedOriginals, ptoCheckDuplicateOriginals,
|
||||||
|
ptoFindAllChilds);
|
||||||
|
TPoTestOptions = Set of TPoTestOption;
|
||||||
|
|
||||||
|
const
|
||||||
|
optRunAllTests: TPoTestOptions = [];
|
||||||
|
optRunAllTestsOnAllChilds: TPoTestOptions = [];
|
||||||
|
|
||||||
|
PoTestOptionNames: array[TPoTestOption] of String = ('Check number of items', 'Check for incompatible format arguments',
|
||||||
|
'Check missing identifiers','Check for mismatches in untranslated strings',
|
||||||
|
'Check for duplicate untranslated values',
|
||||||
|
'Find all translated po-files');
|
||||||
|
|
||||||
|
Type
|
||||||
|
{ TPoFamily }
|
||||||
|
|
||||||
|
TTestStartEvent = procedure(const ATestName, APoFileName: String) of object;
|
||||||
|
TTestEndEvent = procedure(const ATestName: String; const ErrorCount: Integer) of object;
|
||||||
|
|
||||||
|
TPoFamily = class
|
||||||
|
private
|
||||||
|
FMaster: TSimplePoFile;
|
||||||
|
FChild: TSimplePoFile;
|
||||||
|
FMasterName: String;
|
||||||
|
FChildName: String;
|
||||||
|
FOnTestStart: TTestStartEvent;
|
||||||
|
FOnTestEnd: TTestEndEvent;
|
||||||
|
procedure SetChildName(AValue: String);
|
||||||
|
procedure SetMasterName(AValue: String);
|
||||||
|
function GetShortMasterName: String;
|
||||||
|
function GetShortChildName: String;
|
||||||
|
protected
|
||||||
|
procedure DoTestStart(const ATestName, APoFileName: String);
|
||||||
|
procedure DoTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
constructor Create(const MasterName: String);
|
||||||
|
constructor Create(const AMasterName, AChildName: String);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
protected
|
||||||
|
procedure CheckNrOfItems(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
procedure CheckFormatArgs(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
procedure CheckMissingIdentifiers(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
procedure CheckMismatchedOriginals(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
procedure CheckDuplicateOriginals(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
|
||||||
|
public
|
||||||
|
procedure RunTests(const Options: TPoTestOptions; out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
|
||||||
|
property Master: TSimplePoFile read FMaster;
|
||||||
|
property Child: TSimplePoFile read FChild;
|
||||||
|
property MasterName: String read FMasterName write SetMasterName;
|
||||||
|
property ChildName: String read FChildName write SetChildName;
|
||||||
|
property ShortMasterName: String read GetShortMasterName;
|
||||||
|
property ShortChildName: String read GetShortChildName;
|
||||||
|
property OnTestStart: TTestStartEvent read FOnTestStart write FOnTestStart;
|
||||||
|
property OnTestEnd: TTestEndEvent read FOnTestEnd write FOnTestEnd;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExtractFormatArgs(S: String): String;
|
||||||
|
function IsMasterPoName(const Fn: String): Boolean;
|
||||||
|
function ExtractMasterNameFromChildName(const AChildName: String): String;
|
||||||
|
function FindAllTranslatedPoFiles(const Filename: string): TStringList;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
NoError = 0;
|
||||||
|
sCommentIdentifier = '#: ';
|
||||||
|
//sCharSetIdentifier = '"Content-Type: text/plain; charset=';
|
||||||
|
sMsgID = 'msgid "';
|
||||||
|
sMsgStr = 'msgstr "';
|
||||||
|
//sMsgCtxt = 'msgctxt "';
|
||||||
|
//sFlags = '#, ';
|
||||||
|
//sPrevMsgID = '#| msgid "';
|
||||||
|
//sPrevStr = '#| "';
|
||||||
|
|
||||||
|
Divider = '--------------------------------------------------';
|
||||||
|
sOriginal = 'Original';
|
||||||
|
sTranslation = 'Translation';
|
||||||
|
sErrorsByTest = 'Errors reported by %s for:';
|
||||||
|
sCheckFormatArgs = 'CheckFormatArgs';
|
||||||
|
sCheckMissingIdentifiers = 'CheckMissingIdentifiers';
|
||||||
|
sCheckNrOfItems = 'CheckNrOfItems';
|
||||||
|
sCheckMismatchedOriginals = 'CheckMismatchedOriginals';
|
||||||
|
sCheckDuplicateOriginals = 'CheckDiplicateOriginals';
|
||||||
|
sIncompatibleFormatArgs = '[Line: %d] Incompatible format() arguments for:' ;
|
||||||
|
|
||||||
|
|
||||||
|
sNrErrorsFound = 'Found %d errors.';
|
||||||
|
sLineInFileName = '[Line %d] in %s:';
|
||||||
|
sIdentifierNotFoundIn = 'Identifier [%s] not found in %s';
|
||||||
|
sMissingMasterIdentifier = 'Identifier [%s] found in %s, but it does not exist in %s';
|
||||||
|
sLineNr = '[Line: %d]';
|
||||||
|
|
||||||
|
sFormatArgsID = '%s %s';
|
||||||
|
sFormatArgsValues = '%s%s" (= %s)';
|
||||||
|
|
||||||
|
sNrOfItemsMisMatch = 'Mismatch in number of items for master and child';
|
||||||
|
sNrOfItemsMismatchM = '%s: %d items';
|
||||||
|
sNrOfItemsMismatchC = '%s: %d items';
|
||||||
|
|
||||||
|
sMismatchOriginalsID = '%s';
|
||||||
|
sMismatchOriginalsM = '%s: %s';
|
||||||
|
sMismatchOriginalsC = '%s: %s';
|
||||||
|
|
||||||
|
sDuplicateOriginals = 'This resourcestring:';
|
||||||
|
sDuplicateIdentifier = '#: %s';
|
||||||
|
sDuplicateOriginal = 'msgid "%s"';
|
||||||
|
sDuplicateContext = 'msgctxt "%s"';
|
||||||
|
sDuplicateOriginals2 = 'has the same value as idenftifier %s at line %d';
|
||||||
|
sDuplicateOriginals3 = 'For this entry it is recommended to set: msgctxt="%s"';
|
||||||
|
|
||||||
|
//Helper functions
|
||||||
|
|
||||||
|
function ExtractFormatArgs(S: String): String;
|
||||||
|
const
|
||||||
|
FormatSpecs = ['D','E','F','G','N','M','P','S','X'];
|
||||||
|
var
|
||||||
|
i,p: Integer;
|
||||||
|
InFormat: Boolean;
|
||||||
|
NewStr: String;
|
||||||
|
c: Char;
|
||||||
|
begin
|
||||||
|
SetLength(NewStr, Length(S));
|
||||||
|
InFormat := False;
|
||||||
|
p := 0;
|
||||||
|
for i := 1 to length(S) do
|
||||||
|
begin
|
||||||
|
c := S[i];
|
||||||
|
if (c = '%') then InFormat := not InFormat;
|
||||||
|
//debugln('i = ',dbgs(i),' c = ',c,' InFormat = ',dbgs(informat));
|
||||||
|
if InFormat and (UpCase(c) in (FormatSpecs+['%'])) then
|
||||||
|
begin
|
||||||
|
begin
|
||||||
|
Inc(p);
|
||||||
|
NewStr[p] := c;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (c = '%') and (i > 1) and (S[i-1] = '%') and (p > 0) and (NewStr[p] = '%') then
|
||||||
|
begin//2 consecutive % means a literal % and is not a format specifier
|
||||||
|
//debugln('p = ',dbgs(p), 'i = ',dbgs(i));
|
||||||
|
NewStr[p] := '#';
|
||||||
|
Dec(p);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if InFormat and (Upcase(c) in FormatSpecs) then InFormat := False;
|
||||||
|
end;
|
||||||
|
SetLength(NewStr, p);
|
||||||
|
Result := NewStr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsMasterPoName(const Fn: String): Boolean;
|
||||||
|
//Returns True if Fn is like '[Path/To/]somename.po'
|
||||||
|
var
|
||||||
|
Ext: String;
|
||||||
|
S: String;
|
||||||
|
begin
|
||||||
|
S := ExtractFileName(Fn);
|
||||||
|
Ext := ExtractFileExt(S);
|
||||||
|
S := Copy(S, 1, Length(S) - Length(Ext));
|
||||||
|
Result := (Length(S) > 0) and
|
||||||
|
(CompareText(Ext, ExtensionSeparator + 'po') = 0) and
|
||||||
|
(Pos(ExtensionSeparator, S) = 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExtractMasterNameFromChildName(const AChildName: String): String;
|
||||||
|
{
|
||||||
|
Pre condition: AChildName is like: somename.some_language_specifier.po
|
||||||
|
Post condition: Result = somename.po
|
||||||
|
}
|
||||||
|
var
|
||||||
|
Ext: String;
|
||||||
|
EndSep: Set of Char;
|
||||||
|
Len: Integer;
|
||||||
|
begin
|
||||||
|
EndSep := AllowDirectorySeparators + AllowDriveSeparators + [ExtensionSeparator];
|
||||||
|
Ext := ExtractFileExt(AChildName);
|
||||||
|
Result := Copy(AChildName, 1, Length(AChildName) - Length(Ext));
|
||||||
|
Len := Length(Result);
|
||||||
|
While (Len > 0) and (not (Result[Len] in EndSep)) do Dec(Len);
|
||||||
|
|
||||||
|
//debugln('Len = ',DbgS(Len));
|
||||||
|
//debugln('Length(Result) = ',DbgS(Length(result)));
|
||||||
|
//if Len > 0 then debugln('Result[Len] = ',Result[len]);
|
||||||
|
|
||||||
|
if (Len > 1) and (Len < Length(Result)) and (Result[Len] = ExtensionSeparator) then
|
||||||
|
Result := Copy(Result, 1, Len - 1) + Ext
|
||||||
|
else
|
||||||
|
Result := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FindAllTranslatedPoFiles(const Filename: string): TStringList;
|
||||||
|
var
|
||||||
|
Path: String;
|
||||||
|
Name: String;
|
||||||
|
NameOnly: String;
|
||||||
|
Ext: String;
|
||||||
|
FileInfo: TSearchRec;
|
||||||
|
CurExt: String;
|
||||||
|
begin
|
||||||
|
Result := TStringList.Create;
|
||||||
|
Path := ExtractFilePath(Filename);
|
||||||
|
Name := ExtractFilename(Filename);
|
||||||
|
Ext := ExtractFileExt(Filename);
|
||||||
|
NameOnly := LeftStr(Name,length(Name)-length(Ext));
|
||||||
|
if FindFirstUTF8(Path+GetAllFilesMask,faAnyFile,FileInfo)=0 then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '')
|
||||||
|
or (CompareFilenames(FileInfo.Name,Name) = 0) then continue;
|
||||||
|
CurExt:=ExtractFileExt(FileInfo.Name);
|
||||||
|
if (CompareFilenames(CurExt,'.po') <> 0)
|
||||||
|
or (CompareFilenames(LeftStr(FileInfo.Name,length(NameOnly)),NameOnly) <> 0)
|
||||||
|
then
|
||||||
|
continue;
|
||||||
|
Result.Add(Path+FileInfo.Name);
|
||||||
|
until FindNextUTF8(FileInfo)<>0;
|
||||||
|
end;
|
||||||
|
FindCloseUTF8(FileInfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function CompareFormatArgs(S1, S2: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := CompareText(ExtractFormatArgs(S1), ExtractFormatArgs(S2)) = 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPoFamily }
|
||||||
|
|
||||||
|
procedure TPoFamily.SetMasterName(AValue: String);
|
||||||
|
begin
|
||||||
|
if FMasterName = AValue then Exit;
|
||||||
|
FMaster.Free;
|
||||||
|
FMaster := nil;
|
||||||
|
FMasterName := '';
|
||||||
|
if (AValue <> '') then FMaster := TSimplePoFile.Create(AValue{, True});
|
||||||
|
FMasterName := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPoFamily.GetShortMasterName: String;
|
||||||
|
begin
|
||||||
|
Result := ExtractFileName(FMasterName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPoFamily.GetShortChildName: String;
|
||||||
|
begin
|
||||||
|
Result := ExtractFileName(FChildName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.DoTestStart(const ATestName, APoFileName: String);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnTestStart) then FOnTestStart(ATestName, APoFileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.DoTestEnd(const ATestName: String; const ErrorCount: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnTestEnd) then FOnTestEnd(ATestName, ErrorCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TPoFamily.SetChildName(AValue: String);
|
||||||
|
begin
|
||||||
|
if FChildName = AValue then Exit;
|
||||||
|
FChild.Free;
|
||||||
|
FChild := nil;
|
||||||
|
FChildName := '';
|
||||||
|
if (AValue <> '') then FChild := TSimplePoFile.Create(AValue{, True});
|
||||||
|
FChildName := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPoFamily.Create;
|
||||||
|
begin
|
||||||
|
Create('','');
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPoFamily.Create(const MasterName: String);
|
||||||
|
begin
|
||||||
|
Create(MasterName, '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPoFamily.Create(const AMasterName, AChildName: String);
|
||||||
|
begin
|
||||||
|
if (AMasterName <> '') then
|
||||||
|
begin
|
||||||
|
FMaster := TSimplePoFile.Create(AMasterName, True);
|
||||||
|
FMasterName := AMasterName;
|
||||||
|
//debugln('TPoFamily.Create: created ',FMasterName);
|
||||||
|
end;
|
||||||
|
if (AChildName <> '') then
|
||||||
|
begin
|
||||||
|
FChild := TSimplePoFile.Create(AChildName, True);
|
||||||
|
FChildName := AChildName;
|
||||||
|
//debugln('TPoFamily.Create: created ',FChildName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPoFamily.Destroy;
|
||||||
|
begin
|
||||||
|
if Assigned(FMaster) then FMaster.Free;
|
||||||
|
if Assigned(FChild) then FChild.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.CheckNrOfItems(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
begin
|
||||||
|
//debugln('TPoFamily.CheckNrOfItems');
|
||||||
|
DoTestStart(PoTestOptionNames[ptoCheckNrOfItems], ShortChildName);
|
||||||
|
if (FMaster.Count <> FChild.Count) then
|
||||||
|
begin
|
||||||
|
ErrorCount := 1;
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckNrOfItems]));
|
||||||
|
ErrorLog.Add(ShortChildName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add(sNrOfItemsMismatch);
|
||||||
|
ErrorLog.Add(Format(sNrOfItemsMismatchM,[ShortMasterName,FMaster.Count]));
|
||||||
|
ErrorLog.Add(Format(sNrOfItemsMismatchC,[ShortChildName,FChild.Count]));
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end
|
||||||
|
else ErrorCount := NoError;
|
||||||
|
DoTestEnd(PoTestOptionNames[ptoCheckNrOfItems], ErrorCount);
|
||||||
|
//debugln('TPoFamily.CheckNrOfItemsMismatch: ',Dbgs(ErrorCount),' Errors');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.CheckFormatArgs(out ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
CPoItem: TPOFileItem;
|
||||||
|
begin
|
||||||
|
//debugln('TPoFamily.CheckFormatArgs');
|
||||||
|
DoTestStart(PoTestOptionNames[ptoCheckFormatArgs], ShortChildName);
|
||||||
|
ErrorCount := NoError;
|
||||||
|
//for i := 0 to FMaster.Count - 1 do
|
||||||
|
for i := 0 to FChild.Count - 1 do
|
||||||
|
begin
|
||||||
|
//debugln(' i = ',DbgS(i));
|
||||||
|
//MPoItem := FMaster.PoItems[i];
|
||||||
|
CPoItem := FChild.PoItems[i];
|
||||||
|
//CPoItem := FChild.FindPoItem(MPoItem.Identifier);
|
||||||
|
if Assigned(CPoItem) then
|
||||||
|
begin
|
||||||
|
if (Pos('%', CPoItem.Translation) > 0) and not CompareFormatArgs(CPoItem.Original, CPoItem.Translation) then
|
||||||
|
begin
|
||||||
|
if (ErrorCount = 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckFormatArgs]));
|
||||||
|
ErrorLog.Add(ShortChildName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
Inc(ErrorCount);
|
||||||
|
ErrorLog.Add(Format(sIncompatibleFormatArgs,[CPoItem.LineNr]));
|
||||||
|
ErrorLog.Add(Format(sFormatArgsID,[sCommentIdentifier, CPoItem.Identifier]));
|
||||||
|
ErrorLog.Add(Format(sFormatArgsValues,[sMsgID,CPoItem.Original,sOriginal]));
|
||||||
|
ErrorLog.Add(Format(sFormatArgsValues,[sMsgStr,CPoItem.Translation,sTranslation]));
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (ErrorCount > 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
DoTestEnd(PoTestOptionNames[ptoCheckFormatArgs], ErrorCount);
|
||||||
|
//debugln('TPoFamily.CheckIncompatibleFormatArgs: ',Dbgs(ErrorCount),' Errors');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.CheckMissingIdentifiers(out ErrorCount: Integer;
|
||||||
|
ErrorLog: TStrings);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
MPoItem, CPoItem: TPOFileItem;
|
||||||
|
begin
|
||||||
|
//debugln('TPoFamily.CheckMissingIdentifiers');
|
||||||
|
DoTestStart(PoTestOptionNames[ptoCheckMissingIdentifiers], ShortChildName);
|
||||||
|
ErrorCount := NoError;
|
||||||
|
for i := 0 to FMaster.Count - 1 do
|
||||||
|
begin
|
||||||
|
MPoItem := FMaster.PoItems[i];
|
||||||
|
if Assigned(MPoItem) and (MPoItem.Identifier <> '') then
|
||||||
|
begin
|
||||||
|
CPoItem := FChild.FindPoItem(MPoItem.Identifier);
|
||||||
|
if not Assigned(CPoItem) then
|
||||||
|
begin
|
||||||
|
if (ErrorCount = 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckMissingIdentifiers]));
|
||||||
|
ErrorLog.Add(ShortChildName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
Inc(ErrorCount);
|
||||||
|
ErrorLog.Add(Format(sLineInFileName,
|
||||||
|
[MPoItem.LineNr,ShortMasterName]));
|
||||||
|
ErrorLog.Add(Format(sIdentifierNotFoundIn,
|
||||||
|
[MPoItem.Identifier,ShortChildName]));
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
//Now reverse the search
|
||||||
|
for i := 0 to FChild.Count - 1 do
|
||||||
|
begin
|
||||||
|
CPoItem := FChild.PoItems[i];
|
||||||
|
if Assigned(CPoItem) and (CPoItem.Identifier <> '') then
|
||||||
|
begin
|
||||||
|
MPoItem := FMaster.FindPoItem(CPoItem.Identifier);
|
||||||
|
if not Assigned(MPoItem) then
|
||||||
|
begin
|
||||||
|
if (ErrorCount = 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckMissingIdentifiers]));
|
||||||
|
ErrorLog.Add(ShortChildName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
Inc(ErrorCount);
|
||||||
|
ErrorLog.Add(Format(sLineNr,
|
||||||
|
[CPoItem.LineNr]));
|
||||||
|
ErrorLog.Add(Format(sMissingMasterIdentifier,
|
||||||
|
[CPoItem.Identifier,ShortChildName,ShortMasterName]));
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (ErrorCount > 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
DoTestEnd(PoTestOptionNames[ptoCheckMissingIdentifiers], ErrorCount);
|
||||||
|
//debugln('TPoFamily.CheckMissingIdentifiers: ',Dbgs(ErrorCount),' Errors');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.CheckMismatchedOriginals(out ErrorCount: Integer;
|
||||||
|
ErrorLog: TStrings);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
MPoItem, CPoItem: TPOFileItem;
|
||||||
|
begin
|
||||||
|
//debugln('TPoFamily.CheckMismatchedOriginals');
|
||||||
|
DoTestStart(PoTestOptionNames[ptoCheckMismatchedOriginals], ShortChildName);
|
||||||
|
ErrorCount := NoError;
|
||||||
|
for i := 0 to FMaster.Count - 1 do
|
||||||
|
begin
|
||||||
|
MPoItem := FMaster.PoItems[i];
|
||||||
|
CPoItem := FChild.FindPoItem(MpoItem.Identifier);
|
||||||
|
if Assigned(CPoItem) then
|
||||||
|
begin
|
||||||
|
if (MPoItem.Original <> CPoItem.Original) then
|
||||||
|
begin
|
||||||
|
if (ErrorCount = 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckMismatchedOriginals]));
|
||||||
|
ErrorLog.Add(ShortChildName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
Inc(ErrorCount);
|
||||||
|
ErrorLog.Add(Format(sLineInFileName,[CpoItem.LineNr, ShortChildName]));
|
||||||
|
ErrorLog.Add(Format(sMismatchOriginalsID,[CPoItem.Identifier]));
|
||||||
|
ErrorLog.Add(Format(sMismatchOriginalsM,[ShortMasterName,MPoItem.Original]));
|
||||||
|
ErrorLog.Add(Format(sMismatchOriginalsC,[ShortChildName, CPoItem.Original]));
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (ErrorCount > 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
DoTestEnd(PoTestOptionNames[ptoCheckMismatchedOriginals], ErrorCount);
|
||||||
|
//debugln('TPoFamily.CheckMismatchedOriginals: ',Dbgs(ErrorCount),' Errors');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPoFamily.CheckDuplicateOriginals(out ErrorCount: Integer;
|
||||||
|
ErrorLog: TStrings);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
PoItem, Dup: TPOFileItem;
|
||||||
|
begin
|
||||||
|
//debugln('TPoFamily.CheckMismatchedOriginals');
|
||||||
|
DoTestStart(PoTestOptionNames[ptoCheckDuplicateOriginals], ShortMasterName);
|
||||||
|
ErrorCount := NoError;
|
||||||
|
for i := FMaster.Count - 1 downto 0 do
|
||||||
|
begin
|
||||||
|
PoItem := FMaster.PoItems[i];
|
||||||
|
Dup := FMaster.OriginalToItem(PoItem.Original);
|
||||||
|
if Assigned(Dup) and (Dup.Identifier <> PoItem.Identifier) and (Dup.Context = '') then
|
||||||
|
begin
|
||||||
|
if (ErrorCount = 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add(Format(sErrorsByTest,[sCheckDuplicateOriginals]));
|
||||||
|
ErrorLog.Add(ShortMasterName);
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
Inc(ErrorCount);
|
||||||
|
ErrorLog.Add(Format(sLineNr,[PoItem.LineNr]));
|
||||||
|
ErrorLog.Add(sDuplicateOriginals);
|
||||||
|
ErrorLog.Add(Format(sDuplicateIdentifier,[PoItem.Identifier]));
|
||||||
|
ErrorLog.Add(Format(sDuplicateOriginal,[PoItem.Original]));
|
||||||
|
ErrorLog.Add(Format(sDuplicateContext,[PoItem.Context]));
|
||||||
|
ErrorLog.Add(Format(sDuplicateOriginals2,[Dup.Identifier,Dup.LineNr]));
|
||||||
|
ErrorLog.Add(Format(sDuplicateOriginals3,[PoItem.Identifier]));
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if (ErrorCount > 0) then
|
||||||
|
begin
|
||||||
|
ErrorLog.Add(Format(sNrErrorsFound,[ErrorCount]));
|
||||||
|
ErrorLog.Add(Divider);
|
||||||
|
ErrorLog.Add('');
|
||||||
|
ErrorLog.Add('');
|
||||||
|
end;
|
||||||
|
DoTestEnd(PoTestOptionNames[ptoCheckDuplicateOriginals], ErrorCount);
|
||||||
|
//debugln('TPoFamily.CheckDuplicateOriginals: ',Dbgs(ErrorCount),' Errors');
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
procedure TPoFamily.RunTests(const Options: TPoTestOptions; out
|
||||||
|
Pre conditions:
|
||||||
|
* Master and a matching Child must be assigned at start ot testing
|
||||||
|
* If a Child is assigned it must be child of Master
|
||||||
|
}
|
||||||
|
procedure TPoFamily.RunTests(const Options: TPoTestOptions; out
|
||||||
|
ErrorCount: Integer; ErrorLog: TStrings);
|
||||||
|
var
|
||||||
|
SL: TStringList;
|
||||||
|
CurrErrCnt: Integer;
|
||||||
|
i: Integer;
|
||||||
|
CurrChildName: String;
|
||||||
|
S: String;
|
||||||
|
begin
|
||||||
|
SL := nil;
|
||||||
|
ErrorCount := NoError;
|
||||||
|
if (not Assigned(FMaster)) and (not Assigned(FChild)) then
|
||||||
|
begin
|
||||||
|
{$ifdef DebugSimplePoFiles}
|
||||||
|
debugln('TPoFamily.RunTests: Both master and child are unassigned.');
|
||||||
|
{$endif}
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if not Assigned(FMaster) then
|
||||||
|
begin
|
||||||
|
S := ExtractMasterNameFromChildName(FChildName);
|
||||||
|
if (S <> '') and FileExistsUtf8(S) then
|
||||||
|
begin
|
||||||
|
SetMasterName(S);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{$ifdef DebugSimplePoFiles}
|
||||||
|
Debugln('TPoFamily.RunTests: Cannot find master for ',ShortChildName);
|
||||||
|
{$endif}
|
||||||
|
Exit;
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
if not Assigned(FChild) and ([ptoFindAllChilds, ptoCheckDuplicateOriginals] * Options = []) then
|
||||||
|
begin
|
||||||
|
{$ifdef DebugSimplePoFiles}
|
||||||
|
Debugln('TPoFamily.RunTests: no child assigned for ',ShortMasterName);
|
||||||
|
{$endif}
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (ptoFindAllChilds in Options) then
|
||||||
|
begin
|
||||||
|
SL := FindAllTranslatedPoFiles(FMasterName);
|
||||||
|
//We want current Child (if currently assigned) at index 0
|
||||||
|
if Assigned(FChild) then
|
||||||
|
begin
|
||||||
|
for i := 0 to SL.Count - 1 do
|
||||||
|
begin
|
||||||
|
if (CompareFileNames(Sl.Strings[i], FChildName) = 0) then
|
||||||
|
begin
|
||||||
|
if (i <> 0) then SL.Exchange(i,0);
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
SL := TStringList.Create;
|
||||||
|
Sl.Add(FChildName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// for i := 0 to sl.count - 1 do debugln(extractfilename(sl.strings[i]));
|
||||||
|
|
||||||
|
try
|
||||||
|
|
||||||
|
//First run checks that are Master-only
|
||||||
|
if (ptoCheckDuplicateOriginals in Options) then
|
||||||
|
begin
|
||||||
|
CheckDuplicateOriginals(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//then iterate all Children
|
||||||
|
for i := 0 to SL.Count - 1 do
|
||||||
|
begin
|
||||||
|
CurrChildName := SL.Strings[i];
|
||||||
|
//debugln('TPoFamily.RunTests: setting ChildName to ',CurrChildName);
|
||||||
|
SetChildName(CurrChildName);
|
||||||
|
|
||||||
|
if (ptoCheckNrOfItems in Options) then
|
||||||
|
begin
|
||||||
|
CheckNrOfItems(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (ptoCheckFormatArgs in Options) then
|
||||||
|
begin
|
||||||
|
CheckFormatArgs(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
if (ptoCheckMissingIdentifiers in Options) then
|
||||||
|
begin
|
||||||
|
CheckMissingIdentifiers(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
if (ptoCheckMismatchedOriginals in Options) then
|
||||||
|
begin
|
||||||
|
CheckMismatchedOriginals(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
if (pto in Options) then
|
||||||
|
begin
|
||||||
|
Check(CurrErrCnt, ErrorLog);
|
||||||
|
ErrorCount := CurrErrCnt + ErrorCount;
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SL.Free;
|
||||||
|
end;
|
||||||
|
//debugln('TPoFamilyRunTests: ErrorCount = ',DbgS(ErrorCount));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitTestOptions;
|
||||||
|
var
|
||||||
|
Index: TPoTestOption;
|
||||||
|
begin
|
||||||
|
for Index := Low(TPoTestOption) to High(TPotestOption) do optRunAllTestsOnAllChilds := optRunAllTestsOnAllChilds + [Index];
|
||||||
|
optRunAllTests := optRunAllTestsOnAllChilds - [ptoFindAllChilds];
|
||||||
|
end;
|
||||||
|
|
||||||
|
Initialization
|
||||||
|
|
||||||
|
InitTestOptions;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
620
components/pochecker/resultdlg.lfm
Normal file
620
components/pochecker/resultdlg.lfm
Normal file
@ -0,0 +1,620 @@
|
|||||||
|
object ResultDlgForm: TResultDlgForm
|
||||||
|
Left = 284
|
||||||
|
Height = 635
|
||||||
|
Top = 108
|
||||||
|
Width = 742
|
||||||
|
ActiveControl = CopyBtn
|
||||||
|
Caption = 'Results'
|
||||||
|
ClientHeight = 635
|
||||||
|
ClientWidth = 742
|
||||||
|
KeyPreview = True
|
||||||
|
OnClose = FormClose
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
OnKeyDown = FormKeyDown
|
||||||
|
OnShow = FormShow
|
||||||
|
LCLVersion = '0.9.31'
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 0
|
||||||
|
Height = 50
|
||||||
|
Top = 585
|
||||||
|
Width = 742
|
||||||
|
Align = alBottom
|
||||||
|
BevelOuter = bvNone
|
||||||
|
ClientHeight = 50
|
||||||
|
ClientWidth = 742
|
||||||
|
TabOrder = 1
|
||||||
|
object CloseBtn: TBitBtn
|
||||||
|
AnchorSideRight.Control = Panel1
|
||||||
|
AnchorSideRight.Side = asrBottom
|
||||||
|
Left = 657
|
||||||
|
Height = 30
|
||||||
|
Top = 10
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akRight]
|
||||||
|
BorderSpacing.Right = 10
|
||||||
|
DefaultCaption = True
|
||||||
|
Kind = bkClose
|
||||||
|
ModalResult = 11
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object SaveBtn: TBitBtn
|
||||||
|
AnchorSideRight.Control = CloseBtn
|
||||||
|
Left = 572
|
||||||
|
Height = 30
|
||||||
|
Top = 10
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akRight]
|
||||||
|
BorderSpacing.Around = 10
|
||||||
|
Caption = '&Save to file'
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object CopyBtn: TBitBtn
|
||||||
|
AnchorSideRight.Control = SaveBtn
|
||||||
|
Left = 487
|
||||||
|
Height = 30
|
||||||
|
Top = 10
|
||||||
|
Width = 75
|
||||||
|
Anchors = [akRight]
|
||||||
|
BorderSpacing.Around = 10
|
||||||
|
Caption = 'CopyBtn'
|
||||||
|
OnClick = CopyBtnClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
inline LogMemo: TSynEdit
|
||||||
|
Left = 98
|
||||||
|
Height = 150
|
||||||
|
Top = 120
|
||||||
|
Width = 200
|
||||||
|
Font.Height = -13
|
||||||
|
Font.Name = 'Courier New'
|
||||||
|
Font.Pitch = fpFixed
|
||||||
|
Font.Quality = fqNonAntialiased
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
TabOrder = 0
|
||||||
|
Gutter.Width = 21
|
||||||
|
Gutter.MouseActions = <
|
||||||
|
item
|
||||||
|
ClickCount = ccAny
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcOnMainGutterClick
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Button = mbRight
|
||||||
|
Command = emcContextMenu
|
||||||
|
end>
|
||||||
|
RightGutter.Width = 0
|
||||||
|
RightGutter.MouseActions = <
|
||||||
|
item
|
||||||
|
ClickCount = ccAny
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcOnMainGutterClick
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Button = mbRight
|
||||||
|
Command = emcContextMenu
|
||||||
|
end>
|
||||||
|
Keystrokes = <
|
||||||
|
item
|
||||||
|
Command = ecUp
|
||||||
|
ShortCut = 38
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelUp
|
||||||
|
ShortCut = 8230
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecScrollUp
|
||||||
|
ShortCut = 16422
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDown
|
||||||
|
ShortCut = 40
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelDown
|
||||||
|
ShortCut = 8232
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecScrollDown
|
||||||
|
ShortCut = 16424
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLeft
|
||||||
|
ShortCut = 37
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelLeft
|
||||||
|
ShortCut = 8229
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecWordLeft
|
||||||
|
ShortCut = 16421
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelWordLeft
|
||||||
|
ShortCut = 24613
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecRight
|
||||||
|
ShortCut = 39
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelRight
|
||||||
|
ShortCut = 8231
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecWordRight
|
||||||
|
ShortCut = 16423
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelWordRight
|
||||||
|
ShortCut = 24615
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPageDown
|
||||||
|
ShortCut = 34
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelPageDown
|
||||||
|
ShortCut = 8226
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPageBottom
|
||||||
|
ShortCut = 16418
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelPageBottom
|
||||||
|
ShortCut = 24610
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPageUp
|
||||||
|
ShortCut = 33
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelPageUp
|
||||||
|
ShortCut = 8225
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPageTop
|
||||||
|
ShortCut = 16417
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelPageTop
|
||||||
|
ShortCut = 24609
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLineStart
|
||||||
|
ShortCut = 36
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelLineStart
|
||||||
|
ShortCut = 8228
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecEditorTop
|
||||||
|
ShortCut = 16420
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelEditorTop
|
||||||
|
ShortCut = 24612
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLineEnd
|
||||||
|
ShortCut = 35
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelLineEnd
|
||||||
|
ShortCut = 8227
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecEditorBottom
|
||||||
|
ShortCut = 16419
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelEditorBottom
|
||||||
|
ShortCut = 24611
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecToggleMode
|
||||||
|
ShortCut = 45
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecCopy
|
||||||
|
ShortCut = 16429
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPaste
|
||||||
|
ShortCut = 8237
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteChar
|
||||||
|
ShortCut = 46
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecCut
|
||||||
|
ShortCut = 8238
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteLastChar
|
||||||
|
ShortCut = 8
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteLastChar
|
||||||
|
ShortCut = 8200
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteLastWord
|
||||||
|
ShortCut = 16392
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecUndo
|
||||||
|
ShortCut = 32776
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecRedo
|
||||||
|
ShortCut = 40968
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLineBreak
|
||||||
|
ShortCut = 13
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSelectAll
|
||||||
|
ShortCut = 16449
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecCopy
|
||||||
|
ShortCut = 16451
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecBlockIndent
|
||||||
|
ShortCut = 24649
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLineBreak
|
||||||
|
ShortCut = 16461
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecInsertLine
|
||||||
|
ShortCut = 16462
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteWord
|
||||||
|
ShortCut = 16468
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecBlockUnindent
|
||||||
|
ShortCut = 24661
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecPaste
|
||||||
|
ShortCut = 16470
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecCut
|
||||||
|
ShortCut = 16472
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteLine
|
||||||
|
ShortCut = 16473
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecDeleteEOL
|
||||||
|
ShortCut = 24665
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecUndo
|
||||||
|
ShortCut = 16474
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecRedo
|
||||||
|
ShortCut = 24666
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker0
|
||||||
|
ShortCut = 16432
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker1
|
||||||
|
ShortCut = 16433
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker2
|
||||||
|
ShortCut = 16434
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker3
|
||||||
|
ShortCut = 16435
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker4
|
||||||
|
ShortCut = 16436
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker5
|
||||||
|
ShortCut = 16437
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker6
|
||||||
|
ShortCut = 16438
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker7
|
||||||
|
ShortCut = 16439
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker8
|
||||||
|
ShortCut = 16440
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecGotoMarker9
|
||||||
|
ShortCut = 16441
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker0
|
||||||
|
ShortCut = 24624
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker1
|
||||||
|
ShortCut = 24625
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker2
|
||||||
|
ShortCut = 24626
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker3
|
||||||
|
ShortCut = 24627
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker4
|
||||||
|
ShortCut = 24628
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker5
|
||||||
|
ShortCut = 24629
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker6
|
||||||
|
ShortCut = 24630
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker7
|
||||||
|
ShortCut = 24631
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker8
|
||||||
|
ShortCut = 24632
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecSetMarker9
|
||||||
|
ShortCut = 24633
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel1
|
||||||
|
ShortCut = 41009
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel2
|
||||||
|
ShortCut = 41010
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel1
|
||||||
|
ShortCut = 41011
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel1
|
||||||
|
ShortCut = 41012
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel1
|
||||||
|
ShortCut = 41013
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel6
|
||||||
|
ShortCut = 41014
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel7
|
||||||
|
ShortCut = 41015
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel8
|
||||||
|
ShortCut = 41016
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel9
|
||||||
|
ShortCut = 41017
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldLevel0
|
||||||
|
ShortCut = 41008
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcFoldCurrent
|
||||||
|
ShortCut = 41005
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcUnFoldCurrent
|
||||||
|
ShortCut = 41003
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = EcToggleMarkupWord
|
||||||
|
ShortCut = 32845
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecNormalSelect
|
||||||
|
ShortCut = 24654
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColumnSelect
|
||||||
|
ShortCut = 24643
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecLineSelect
|
||||||
|
ShortCut = 24652
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecTab
|
||||||
|
ShortCut = 9
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecShiftTab
|
||||||
|
ShortCut = 8201
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecMatchBracket
|
||||||
|
ShortCut = 24642
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelUp
|
||||||
|
ShortCut = 40998
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelDown
|
||||||
|
ShortCut = 41000
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelLeft
|
||||||
|
ShortCut = 40997
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelRight
|
||||||
|
ShortCut = 40999
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelPageDown
|
||||||
|
ShortCut = 40994
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelPageBottom
|
||||||
|
ShortCut = 57378
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelPageUp
|
||||||
|
ShortCut = 40993
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelPageTop
|
||||||
|
ShortCut = 57377
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelLineStart
|
||||||
|
ShortCut = 40996
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelLineEnd
|
||||||
|
ShortCut = 40995
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelEditorTop
|
||||||
|
ShortCut = 57380
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Command = ecColSelEditorBottom
|
||||||
|
ShortCut = 57379
|
||||||
|
end>
|
||||||
|
MouseActions = <
|
||||||
|
item
|
||||||
|
ShiftMask = [ssShift, ssAlt]
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcStartSelections
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Shift = [ssShift]
|
||||||
|
ShiftMask = [ssShift, ssAlt]
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcStartSelections
|
||||||
|
MoveCaret = True
|
||||||
|
Option = 1
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Shift = [ssAlt]
|
||||||
|
ShiftMask = [ssShift, ssAlt]
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcStartColumnSelections
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Shift = [ssShift, ssAlt]
|
||||||
|
ShiftMask = [ssShift, ssAlt]
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcStartColumnSelections
|
||||||
|
MoveCaret = True
|
||||||
|
Option = 1
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Button = mbRight
|
||||||
|
Command = emcContextMenu
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ClickCount = ccDouble
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcSelectWord
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ClickCount = ccTriple
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcSelectLine
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ClickCount = ccQuad
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcSelectPara
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Button = mbMiddle
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcPasteSelection
|
||||||
|
MoveCaret = True
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Shift = [ssCtrl]
|
||||||
|
ShiftMask = [ssShift, ssAlt, ssCtrl]
|
||||||
|
Command = emcMouseLink
|
||||||
|
end>
|
||||||
|
MouseSelActions = <
|
||||||
|
item
|
||||||
|
ClickDir = cdDown
|
||||||
|
Command = emcStartDragMove
|
||||||
|
end>
|
||||||
|
Lines.Strings = (
|
||||||
|
'LogMemo'
|
||||||
|
)
|
||||||
|
VisibleSpecialChars = [vscSpace, vscTabAtLast]
|
||||||
|
ReadOnly = True
|
||||||
|
ScrollBars = ssAutoBoth
|
||||||
|
BracketHighlightStyle = sbhsBoth
|
||||||
|
inline SynLeftGutterPartList1: TSynGutterPartList
|
||||||
|
object SynGutterLineNumber1: TSynGutterLineNumber
|
||||||
|
Width = 17
|
||||||
|
MouseActions = <>
|
||||||
|
MarkupInfo.Background = clBtnFace
|
||||||
|
MarkupInfo.Foreground = clNone
|
||||||
|
DigitCount = 2
|
||||||
|
ShowOnlyLineNumbersMultiplesOf = 1
|
||||||
|
ZeroStart = False
|
||||||
|
LeadingZeros = False
|
||||||
|
end
|
||||||
|
object SynGutterChanges1: TSynGutterChanges
|
||||||
|
Width = 4
|
||||||
|
MouseActions = <>
|
||||||
|
ModifiedColor = 59900
|
||||||
|
SavedColor = clGreen
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object SaveDialog: TSaveDialog
|
||||||
|
Filter = 'Text files|*.txt|All files|*'
|
||||||
|
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
|
||||||
|
left = 40
|
||||||
|
top = 320
|
||||||
|
end
|
||||||
|
end
|
||||||
102
components/pochecker/resultdlg.pp
Normal file
102
components/pochecker/resultdlg.pp
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
unit ResultDlg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||||
|
ExtCtrls, Buttons, ClipBrd, LCLType, LCLProc, SynEdit, SynHighlighterPo;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TResultDlgForm }
|
||||||
|
|
||||||
|
TResultDlgForm = class(TForm)
|
||||||
|
CopyBtn: TBitBtn;
|
||||||
|
SaveBtn: TBitBtn;
|
||||||
|
CloseBtn: TBitBtn;
|
||||||
|
Panel1: TPanel;
|
||||||
|
SaveDialog: TSaveDialog;
|
||||||
|
FLog: TStringList;
|
||||||
|
LogMemo: TSynEdit;
|
||||||
|
procedure CopyBtnClick(Sender: TObject);
|
||||||
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
PoHL: TSynPoSyn;
|
||||||
|
procedure SaveToFile;
|
||||||
|
public
|
||||||
|
{ public declarations }
|
||||||
|
property Log: TStringList read FLog write FLog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
const
|
||||||
|
sSaveError = 'Error saving file:'^m'%s';
|
||||||
|
|
||||||
|
{ TResultDlgForm }
|
||||||
|
|
||||||
|
procedure TResultDlgForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
LogMemo.Lines.Clear;
|
||||||
|
LogMemo.Align := alClient;
|
||||||
|
FLog := TStringList.Create;
|
||||||
|
PoHL := TSynPoSyn.Create(Self);
|
||||||
|
LogMemo.Highlighter := PoHL;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.FormClose(Sender: TObject;
|
||||||
|
var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
FLog.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.CopyBtnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ClipBoard.AsText := LogMemo.Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FLog.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.FormKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if (Key = VK_Tab) and (Shift = []) and LogMemo.Focused then
|
||||||
|
begin
|
||||||
|
//Workaroud: cannot tab out of LogMemo
|
||||||
|
CopyBtn.SetFocus;
|
||||||
|
//debugln('Tab');
|
||||||
|
Key := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
LogMemo.Lines.Assign(FLog);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResultDlgForm.SaveToFile;
|
||||||
|
begin
|
||||||
|
if SaveDialog.Execute then
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
LogMemo.Lines.SaveToFile(SaveDialog.FileName);
|
||||||
|
except
|
||||||
|
MessageDlg('GPoCheck',Format(sSaveError,[SaveDialog.FileName]), mtError, [mbOk], 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
1511
components/pochecker/simplepofiles.pp
Normal file
1511
components/pochecker/simplepofiles.pp
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user