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

git-svn-id: trunk@46508 -

.gitattributes

@@ -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

components/pochecker/Proj/pochecker.lpi

@@ -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>

components/pochecker/pocheckermain.pp

@@ -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;

components/pochecker/pocheckermemodlg.lfm

@@ -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

components/pochecker/pocheckermemodlg.pp

@@ -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.
+