?
Solved

Calculate height of form (messageDlg).

Posted on 2004-11-21
8
Medium Priority
?
879 Views
Last Modified: 2010-05-18
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
0
Comment
Question by:Stef Merlijn
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 17

Accepted Solution

by:
geobul earned 2000 total points
ID: 12642717
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
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12642900
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
 
LVL 17

Expert Comment

by:geobul
ID: 12643555
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 6

Expert Comment

by:vadim_ti
ID: 12643729
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
 
LVL 11

Expert Comment

by:ZhaawZ
ID: 12644589
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
 

Author Comment

by:Stef Merlijn
ID: 12646951
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
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12647046
what will happen with this solution if you will change font size, lets say to
    Font.Size := 14;
0
 

Author Comment

by:Stef Merlijn
ID: 12649691
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

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
Loops Section Overview
Suggested Courses

862 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question