paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 17:55:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

PoChecker: use a custom made dialog for displying possibly very long list of filenames.

Browse Source 
git-svn-id: trunk@46508 -
This commit is contained in:
bart 2014-10-10 20:34:36 +00:00
parent 4b521f81a5
commit b6924d33a1
5 changed files with 154 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2937,6 +2937,8 @@ components/pochecker/pochecker.pas svneol=native#text/plain
components/pochecker/pocheckerconsts.pas svneol=native#text/pascal
components/pochecker/pocheckermain.lfm svneol=native#text/plain
components/pochecker/pocheckermain.pp svneol=native#text/plain
components/pochecker/pocheckermemodlg.lfm svneol=native#text/plain
components/pochecker/pocheckermemodlg.pp svneol=native#text/pascal
components/pochecker/pocheckersettings.pp svneol=native#text/pascal
components/pochecker/pocheckerxmlconfig.pp svneol=native#text/pascal
components/pochecker/pofamilies.pp svneol=native#text/plain

9
components/pochecker/Proj/pochecker.lpi
View File

@ -69,7 +69,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="9">
<Units Count="10">
<Unit0>
<Filename Value="pochecker.lpr"/>
<IsPartOfProject Value="True"/>
@ -123,6 +123,13 @@
<IsPartOfProject Value="True"/>
<UnitName Value="PoFamilyLists"/>
</Unit8>
<Unit9>
<Filename Value="..\pocheckermemodlg.pp"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MemoForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="pocheckermemodlg"/>
</Unit9>
</Units>
</ProjectOptions>
<CompilerOptions>

20
components/pochecker/pocheckermain.pp
View File

@ -33,7 +33,7 @@ uses
IDEIntf, MenuIntf,
{$ENDIF}
SimplePoFiles, PoFamilies, ResultDlg, pocheckerconsts, PoCheckerSettings,
PoFamilyLists;
PoFamilyLists, PoCheckerMemoDlg;
type
@ -475,11 +475,16 @@ begin
end;
end;
if (Msg <> '') then
MessageDlg('PoChecker',Format(sFilesNotFoundAndRemoved,[Msg]), mtInformation, [mbOk], 0);
//MessageDlg('PoChecker',Format(sFilesNotFoundAndRemoved,[Msg]), mtInformation, [mbOk], 0);
Msg := Format(sFilesNotFoundAndRemoved,[Msg]);
Cnt := MasterList.Count;
if (Cnt = 0) then
Msg := Msg + LineEnding + LineEnding + LineEnding + sNoFilesLeftToCheck;
if (Msg <> '') then
MemoDlg('PoChecker',Msg);
if (Cnt = 0) then
begin
MessageDlg('PoChecker', sNoFilesLeftToCheck, mtInformation, [mbOk], 0);
//MessageDlg('PoChecker', sNoFilesLeftToCheck, mtInformation, [mbOk], 0);
Exit;
end;
try
@ -487,10 +492,15 @@ begin
PoFamilyList := TPoFamilyList.Create(MasterList, Lang, Msg);
if (Msg <> '') then
begin
MessageDlg('PoChecker',Format(sFilesNotFoundAndRemoved,[Msg]), mtInformation, [mbOk], 0);
//MessageDlg('PoChecker',Format(sFilesNotFoundAndRemoved,[Msg]), mtInformation, [mbOk], 0);
Msg := Format(sFilesNotFoundAndRemoved,[Msg]);
if (PoFamilyList.Count = 0) then
Msg := Msg + LineEnding + LineEnding + LineEnding + sNoFilesLeftToCheck;
if (Msg <> '') then
MemoDlg('PoChecker',Msg);
if (PoFamilyList.Count = 0) then
begin
MessageDlg('PoChecker', sNoFilesLeftToCheck, mtInformation, [mbOk], 0);
//MessageDlg('PoChecker', sNoFilesLeftToCheck, mtInformation, [mbOk], 0);
FreeAndNil(PoFamilyList);
Exit;
end;

41
components/pochecker/pocheckermemodlg.lfm Normal file
View File

@ -0,0 +1,41 @@
object MemoForm: TMemoForm
Left = 649
Height = 230
Top = 123
Width = 365
Caption = 'MemoForm'
ClientHeight = 230
ClientWidth = 365
Constraints.MinHeight = 230
Constraints.MinWidth = 365
Position = poMainFormCenter
LCLVersion = '1.3'
object BitBtn1: TBitBtn
AnchorSideLeft.Control = MsgMemo
AnchorSideLeft.Side = asrCenter
Left = 132
Height = 30
Top = 192
Width = 100
Anchors = [akLeft, akBottom]
Default = True
DefaultCaption = True
Kind = bkOK
ModalResult = 1
TabOrder = 0
end
object MsgMemo: TMemo
AnchorSideBottom.Control = BitBtn1
Left = 0
Height = 182
Top = 0
Width = 365
Align = alTop
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 10
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 1
WordWrap = False
end
end

88
components/pochecker/pocheckermemodlg.pp Normal file
View File

@ -0,0 +1,88 @@
unit pocheckermemodlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, types, FileUtil, Forms, Controls, Graphics, Dialogs,
Buttons, StdCtrls, LCLProc, PoCheckerSettings;
type
{ TMemoForm }
TMemoForm = class(TForm)
BitBtn1: TBitBtn;
MsgMemo: TMemo;
private
FMsg: String;
procedure SetMsg(AValue: String);
{ private declarations }
public
{ public declarations }
property Message: String read FMsg write SetMsg;
end;
function MemoDlg(const ACaption, AMsg: String): TModalResult;
implementation
function MemoDlg(const ACaption, AMsg: String): TModalResult;
var
Dlg: TMemoForm;
begin
Dlg := TMemoForm.Create(nil);
try
Dlg.Caption := ACaption;
Dlg.SetMsg(AMsg);
Result := Dlg.ShowModal;
finally
Dlg.Free;
end;
end;
{$R *.lfm}
{ TMemoForm }
procedure TMemoForm.SetMsg(AValue: String);
var
i, LH, TW, MaxTW, BottomGap, ReqH: Integer;
Size: TSize;
ARect, WARect: TRect;
begin
if FMsg = AValue then Exit;
FMsg := AValue;
MsgMemo.Text := AValue;
//for i := 1 to 50 do MsgMemo.Lines.Add(IntToStr(i));
Size := Canvas.TextExtent('qWM');
LH := Size.cy;
MaxTW := Constraints.MinWidth;
for i := 0 to MsgMemo.Lines.Count - 1 do
begin
TW := Self.Canvas.TextWidth(MsgMemo.Lines[i]);
if TW > MaxTW then MaxTW := TW;
end;
ClientWidth := MaxTW + 50;
ReqH := MsgMemo.Lines.Count * LH;
BottomGap := ClientHeight - MsgMemo.Height;
ReqH := ReqH + BottomGap;
ClientHeight := ReqH;
ARect := Self.BoundsRect;
WARect := Screen.WorkAreaRect;
WARect.Right := WARect.Right - 50;
WARect.Bottom := WARect.Bottom - 75;
//debugln('ARect = ',DbgS(ARect));
ARect := FitToRect(ARect, WARect);
//debugln('ARect = ',DbgS(ARect));
//debugln('Screen.WARect = ',DbgS(WARect));
BoundsRect := ARect;
end;
end.