Calculate height of form (messageDlg).

Hi,

I found following procedure on EE. But it is not completely according my wishes.

Adjustmens that must be made:
1. When calling this procedure I want to be able to also send the TMsgDlgType
    (like: mtWarning, mtError, mtInformation, mtConfirmation, mtCustom)
     - just like calling standard MessageDlg
2. When calling this procedure I want to be able to also send the ModalResult
    (like mrNone, mrOk, mrCancel, mrYes, mrNo, mrAbort, mrRetry, mrIgnore,
    mrAll, mrNoToAll, mrYesToAll)
     - just like calling standard MessageDlg
3. When the string I send to the procedure (MyMessage) contains multiple
    lines (f.e. 10 lines) the form isn't sized correctly. So I need to calculate the
    formsize (maybe based on the string that I send to the procedure)


procedure TForm1.Button1Click(Sender: TObject) ;
begin
  MyMessageDlg('This is a test to calculate the' + chr(13)
                      +'height of the total text that is' + chr(13)
                      +'captured in the string S' +chr(13)
                      +'How can we do this correctly?');
end;


procedure TForm1.MyMesssageDlg(MyMessage : String);
var AMsgDialog: TForm;
    ACheckBox: TCheckBox;
begin
  AMsgDialog := CreateMessageDialog(MyMessage, mtWarning,[mbYes, mbNo]);
  ACheckBox := TCheckBox.Create(AMsgDialog) ;
  with AMsgDialog do
  try
    Font.Name := 'Arial';
    Font.Size := 8;
    Font.Color := clNavy;
    Caption := 'Dialog Title' ;
    Height := 170;

    with ACheckBox do
    begin
      Parent := AMsgDialog;
      Caption := 'Don't show this message again.';
      Top := 121;
      Left := 8;
    end;

    if (ShowModal = ID_YES) then
    begin
      if ACheckBox.Checked then
      begin
        ShowMessage('Checkbox is checked');
      end else
      begin
        ShowMessage('Checkbox is not checked');
      end;
    end;
  finally
    ACheckBox.Free;
    Free;
  end;
end;


Can anybody help me with this?
Maybe also the Fontname, Fontsize and Fonttype can be taken into account.

Thanks, Stef
Stef MerlijnDeveloperAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

geobulCommented:
Hi,

Try this:

function TForm1.GeoMesssageDlg(const aCaption: String;
                      const Msg: string;
                      DlgType: TMsgDlgType;
                      Buttons: TMsgDlgButtons): Integer;
var AMsgDialog: TForm;
    ACheckBox: TCheckBox;
begin
  AMsgDialog := CreateMessageDialog(Msg, DlgType, Buttons);
  ACheckBox := TCheckBox.Create(AMsgDialog) ;
  with AMsgDialog do
  try
    Font.Name := 'Arial';
    Font.Size := 8;
    Font.Color := clNavy;
    if Length(aCaption) > 0 then Caption := aCaption;
    Height := Height + ACheckBox.Height;

    with ACheckBox do
    begin
      Parent := AMsgDialog;
      Caption := 'Dont show this message again.';
      Top := Parent.ClientHeight - Height;
      Left := 8;
    end;

    Result := ShowModal;

    // The rest of the code will always be executed because
    // you may now define different button combinations
    // [Yes,No], [OK, Cancel], etc.
    if ACheckBox.Checked then
    begin
        ShowMessage('Checkbox is checked');
    end else
    begin
        ShowMessage('Checkbox is not checked');
    end;

  finally
    ACheckBox.Free;
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ModRes: integer;
begin
  ModRes := GeoMesssageDlg('Dialog Title',
                      'This is a test to calculate the' + chr(13)
                      +'height of the total text that is' + chr(13)
                      +'captured in the string S' +chr(13)
                      +'How can we do this correctly?' +chr(13)
                      +'Line 5' +chr(13)
                      +'Line 6' +chr(13)
                      +'Line 7' +chr(13)
                      +'Line 8' +chr(13)
                      +'Line 9' +chr(13)
                      +'Line 10' +chr(13)
                      +'Line 11' +chr(13)
                      ,
                      mtConfirmation,
                      [mbOK, mbCancel]);
  if ModRes = mrOK then ...
end;

Regards, Geo
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
vadim_tiCommented:
Hi, another variant

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function MyMessageDlg(MyMessage : String; DlgType: TMsgDlgType):Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   MyMessageDlg('This is a test to calculate the' + chr(13)
                      +'height of the total text that is' + chr(13)
                      +'captured in the string S' +chr(13)
                      +'height of the total text that is' + chr(13)
                      +'captured in the string S' +chr(13)
                      +'height of the total text that is' + chr(13)
                      +'captured in the string S' +chr(13)
                      +'How can we do this correctly?',
                      mtError);
end;



function TForm1.MyMessageDlg(MyMessage : String; DlgType: TMsgDlgType): Integer;
var AMsgDialog: TForm;
    ACheckBox: TCheckBox;
    NonClientMetrics: TNonClientMetrics;
    saved:Boolean;
    saveLogFont, newLogFont:TLogFont;
begin
  NonClientMetrics.cbSize := sizeof(TNonClientMetrics);
  saved := false;
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then begin
    saved := true;
    saveLogFont := NonClientMetrics.lfMessageFont;
    FillChar(newLogFont, sizeof(TLogFont), 0);
    newLogFont.lfHeight := -14;
    StrPCopy(newLogFont.lfFaceName, 'Arial');
    NonClientMetrics.lfMessageFont :=  newLogFont;
    SystemParametersInfo(SPI_SETNONCLIENTMETRICS, 0, @NonClientMetrics, 0)
  end;
  AMsgDialog := CreateMessageDialog(MyMessage+#13#13#13, DlgType,[mbYes, mbNo]);
  ACheckBox := TCheckBox.Create(AMsgDialog) ;
  with AMsgDialog do
  try
    Caption := 'Dialog Title' ;
    Font.Color := clNavy;
    with ACheckBox do
    begin
      AutoSize := false;
      Parent := AMsgDialog;
      Caption := 'Don''t show this message again.';
      Left := 8;
      Width := AMsgDialog.Width - 16;
      ACheckBox.Top := AMsgDialog.Height - 100;
    end;

    result := ShowModal;
    if saved then begin
      NonClientMetrics.lfMessageFont :=  saveLogFont;
      SystemParametersInfo(SPI_SETNONCLIENTMETRICS, 0, @NonClientMetrics, 0)
    end;
    if (result = ID_YES) then
    begin
      if ACheckBox.Checked then
      begin
        ShowMessage('Checkbox is checked');
      end else
      begin
        ShowMessage('Checkbox is not checked');
      end;
    end;
  finally
    ACheckBox.Free;
    Free;
  end;
end;

end.
0
geobulCommented:
Where have you got these constants 16 and 100? Experimentally? They might be different depending on the screen resolution, small or large fonts being used, the size of window border, etc.
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

vadim_tiCommented:
if left = 8
why width cannot be parent.width - 16, it is really no problem

100 is more problematic,
it is possible to find button something like this:
for i:=0 to ComponentCount-1 do
  if Components[i] is TButton then begin
      ACheckBox.Top := AMsgDialog.Height - (Components[i] is TButton).Top - ACheckBox.Height*2;
     break;
  end
0
ZhaawZSoftware DeveloperCommented:
Can't you use TForm().AutoSize property?

Btw, there's no need to use chr() function. I think it's better to use syntax with #(num), becaouse it doesn't call function.
s : string;
s := 'first line'#13#10'second line'#13#10'third line';

It's also better to use #13#10 in Windows, not just #13.
0
Stef MerlijnDeveloperAuthor Commented:
Thanks to you all for helping me.
After testing both solution I decided to give the points to geobul because his solution is the fastest and has the required parameters.


After some trial and error I came up with this solution.
Maybe somebody can optimize this code. At least for the part where the buttons are positioned.

What the function does is the following:
1. Display the message.
2. Display a bitmap with Warning, Information, etc.
3. Resize the form's width, whenever the message makes the form is too small for the CheckBox.Caption (Don't show this message again.) to show completely.
4. Display a checkbox (Don't show this message again)
5. Re-position the buttons in the center of the form, whenever the form was resized (see at 3)

On buttonclick on the form the user will get the MessageDlg until the CheckBox (Don't show this message again.) is checked.
5. MessageDlg is bypassed when user checked the checkbox.

========== Here starts the unit ===============

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GeoMesssageDlg(const aCaption: String;
                      const Msg: string;
                      DlgType: TMsgDlgType;
                      Buttons: TMsgDlgButtons): Integer;
  end;

var
  Form1: TForm1;
  ShowGeoMessageDlg : Boolean = True;

implementation

{$R *.dfm}


function TForm1.GeoMesssageDlg(const aCaption: String;
                      const Msg: string;
                      DlgType: TMsgDlgType;
                      Buttons: TMsgDlgButtons): Integer;
var AMsgDialog: TForm;
    ACheckBox: TCheckBox;
    CenterButtons : Boolean;
    i, j, loopnumber, CountButtons : Integer;
begin
  CenterButtons := False;
  CountButtons  := 0;
  loopnumber    := 0;
  AMsgDialog := CreateMessageDialog(Msg, DlgType, Buttons);
  ACheckBox := TCheckBox.Create(AMsgDialog) ;
  with AMsgDialog do
  try
    Font.Name := 'Arial';
    Font.Size := 8;
    Font.Color := clNavy;
    if Length(aCaption) > 0 then Caption := aCaption;
    Height := Height + ACheckBox.Height;
    If Width < 200 then
    begin
      // Set the Form.width to the minimum value of 200
      // in order to display the complete text of the checkbox.
      Width := 200;
      CenterButtons := True;
    end;

    with ACheckBox do
    begin
      Parent := AMsgDialog;
      Caption := 'Dont show this message again.';
      Top := Parent.ClientHeight - Height;
      Left := 8;
      Width := 600;
    end;

    If CenterButtons then
    begin
      // Center the buttons on the form.
      for i:=0 to ComponentCount-1 do
      begin
        if Components[i] is TButton then
        begin
          // Determine the number of buttons on the form.
          // When there are more than 2 buttons the form.width will always exceed the 200.
          CountButtons := CountButtons + 1;
        end;
      end;
      If CountButtons = 1 then
      begin
        for j:=0 to ComponentCount-1 do
        begin
          if Components[j] is TButton then
          begin
            (Components[j] as TButton).Left := (AMsgDialog.Width - (Components[j] as TButton).Width) div 2;
          end;
        end;
      end else
      begin
        for j:=0 to ComponentCount-1 do
        begin
          if Components[j] is TButton then
          begin
            If loopnumber = 0 then
            begin
              // Moving the first button
              (Components[j] as TButton).Left := (AMsgDialog.Width div 2) - ((Components[j] as TButton).Width + 3);
              Loopnumber := loopnumber + 1;
            end else
              // Moving the second button
              (Components[j] as TButton).Left := (AMsgDialog.Width div 2) + 3;

          end;
        end;
      end;
    end;

    Result := ShowModal;

    // The rest of the code will always be executed because
    // you may now define different button combinations
    // [Yes,No], [OK, Cancel], etc.
    if ACheckBox.Checked then
    begin
      ShowGeoMessageDlg := False;
    end else
    begin
      ShowMessage('Checkbox is not checked');
    end;

  finally
    ACheckBox.Free;
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  If ShowGeoMessageDlg then
  begin
    If GeoMesssageDlg('Dialog Title',
                   'This is a test to calculate the' + chr(13)
                  +'height of the total text that is' + chr(13)
                  +'captured in the string S' +chr(13)
                  +'How can we do this correctly?' +chr(13)
                  +'Line 5' +chr(13)
                  +'Line 6' +chr(13)
                  +'Line 7' +chr(13)
                  +'Line 8' +chr(13)
                  +'Line 9' +chr(13)
                  +'Line 10' +chr(13)
                  +'Line 11' +chr(13)
                  ,mtConfirmation,[mbOK, mbCancel]) = mrOK then
    begin
      ShowMessage('OK button in MessageDlg was pressed');
    end else
    begin
      ShowMessage('Cancel button in MessageDlg was pressed');
    end;
  end else
    ShowMessage('MessageDlg is bypassed because checkbox was checked');
end;

end.

========== Here ends the unit ===============

Feel free to comment or update it. Please post updates here.

Thanks again, Stef
0
vadim_tiCommented:
what will happen with this solution if you will change font size, lets say to
    Font.Size := 14;
0
Stef MerlijnDeveloperAuthor Commented:
The fontname, fontsize and fonttype are all declared within the function so that shouldn't be a problem.
But if changed then it would be necessary to change other parts of the procedure as well. Thanks for your remark.

Regards, Stef
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.