Redimensionar Tform de acordo com o tamanho da string em um Tlabel.

Delphi

08/05/2020

Bom dia.
Criei um formul�rio que possui um tamanho padr�o como tela de mensagens do meu sistema. Dentro desse form tenho um Tlabel que recebe a mensagem que eu quero que apare�a na tela, porem, se eu passar uma mensagem muito grande o formul�rio n�o se ajusta de acordo com o tamanho do Tlabel e assim ocultado a parte final da mensagem.
Gostaria de saber se � poss�vel redimensionar um form, de acordo com com o tamanho desse Tlabel em tempo de execu��o?. Se for poss�vel, como eu poderia fazer?





unit untMensagens;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ImgList, RzButton,
  Vcl.StdCtrls, RzPanel, dxGDIPlusClasses,StrUtils, JvComponentBase,
  JvFormAutoSize;
type
  TMyButtons = (mbSim, mbNao, mbOk,mbDefNao);
type
  TfrmMensagens = class(TForm)
    pnlBotoes: TRzPanel;
    btnSim: TRzBitBtn;
    btnNao: TRzBitBtn;
    btnOk: TRzBitBtn;
    pnlMensagem: TRzPanel;
    lblMensagem: TLabel;
  public
     class function Mensagem(Texto: String;Titulo:String; Tipo: String; Botoes: array of TMyButtons;const Minimizar:boolean = false): Boolean;
  end;
var
  frmMensagens: TfrmMensagens;
const
    LEFTBUTTONS : array[0..2] of integer = (258, 178, 97);

implementation

{$R *.dfm}

{ TfrmMensagens }

class function TfrmMensagens.Mensagem(Texto, Titulo: String; Tipo: String;
  Botoes: array of TMyButtons;const Minimizar:boolean): Boolean;
var
  i: Integer;
  frm :TfrmMensagens;
begin
  frm := TfrmMensagens.Create(nil);
  try
    if Minimizar = true then
    begin
      frm.OnShow := frm.eventoOnShow;
    end;

    frm.lblMensagem.Caption := Texto;
    frm.Caption := Titulo;

    for i:=0 to Length(Botoes)-1 do
    begin
      case (Botoes[i]) of
        mbOk: begin
                frm.BtnOK.Visible := True;
                frm.BtnOK.Left := LEFTBUTTONS[i];
              end;
        mbDefNao: begin
                    frm.btnNao.TabOrder := 0;
                    frm.btnNao.Visible := True;
                    frm.btnNao.Left := LEFTBUTTONS[i];
                  end;
        mbSim: begin
                 frm.btnSim.Visible := True;
                 frm.btnSim.Left := LEFTBUTTONS[i];
               end;

        mbNao: begin
                 frm.BtnNao.Visible := True;
                 frm.BtnNao.Left := LEFTBUTTONS[i];
               end;

        else begin
          frm.BtnOK.Visible := True;
          frm.BtnOK.Left := LEFTBUTTONS[i];
        end;
      end;
    end;
     frm.ShowModal;

    case (frm.ModalResult) of
      mrOk, mrYes : result := True;
    else
        result := False;
    end;

  finally
    if (frm<>nil) then
      FreeAndNil(frm);
  end;

Desde j� agrade�o a ajuda.

Vanessa Cruz

Curtidas 0

Melhor post

Guilherme Wiethaus

09/05/2020

Oi Vanessa,

Eu fiz um c�digo para resolver o seu problema ou pelo menso em parte.

� uma solu��o um pouco aprimorada, mas simples. Leva em considera��o apenas o desenho do texto no canvas a qual ele calcula por s� o tamanho e com base nisto � que calculamos o quanto tem que redimensionar o label para caber o seu conte�do. � poss�vel melhorar mais, por exemplo, criar um limite de largura da caixa se passar disto ent�o para e cresce apenas o texto para baixo aumentando o comprimento apenas da caixa. Vou colocar o c�digo aqui. Infelizmente n�o aceita anexo. Estou enviando o dfm. Abra um editor de texto e cole e salve com extens�o .dfm

Arquivo Unit7.dfm

object frmMessageBox: TfrmMessageBox
  Left = 0
  Top = 0
  BorderStyle = bsSingle
  Caption = 'frmMessageBox'
  ClientHeight = 107
  ClientWidth = 377
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object lblTitle: TLabel
    AlignWithMargins = True
    Left = 10
    Top = 0
    Width = 357
    Height = 31
    Margins.Left = 10
    Margins.Top = 0
    Margins.Right = 10
    Margins.Bottom = 0
    Align = alTop
    AutoSize = False
    Caption = 'TITULO'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    Layout = tlCenter
    ExplicitLeft = 0
    ExplicitWidth = 367
  end
  object lblMessage: TLabel
    AlignWithMargins = True
    Left = 10
    Top = 31
    Width = 357
    Height = 25
    Margins.Left = 10
    Margins.Top = 0
    Margins.Right = 10
    Margins.Bottom = 10
    Align = alClient
    WordWrap = True
    ExplicitLeft = 0
    ExplicitWidth = 3
    ExplicitHeight = 13
  end
  object Panel1: TPanel
    Left = 0
    Top = 66
    Width = 377
    Height = 41
    Align = alBottom
    BevelEdges = [beTop]
    BevelKind = bkFlat
    BevelOuter = bvNone
    TabOrder = 0
    object BOK: TButton
      Left = 6
      Top = 6
      Width = 75
      Height = 25
      Caption = 'OK'
      ModalResult = 1
      TabOrder = 0
    end
  end
end

Arquivo Unit7.pas

unit Unit7;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TfrmMessageBox = class(TForm)
    lblTitle: TLabel;
    lblMessage: TLabel;
    Panel1: TPanel;
    BOK: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FLabelHeight: Integer;
    function CalcRecLabel(ALabel: TLabel; AWidth: Integer): Integer;
  public
    { Public declarations }
    function ShowModal(AMessage: String): Integer; overload;
  end;

var
  frmMessageBox: TfrmMessageBox;

implementation

{$R *.dfm}

function TfrmMessageBox.CalcRecLabel(ALabel: TLabel; AWidth: Integer): Integer;
var
  lRect : TRect;
  lText : string;
begin
  lRect.Left := 0;
  lRect.Right := AWidth;
  lRect.Top := 0;
  lRect.Bottom := 0;

  lText := ALabel.Caption;

  ALabel.Canvas.TextRect(
            lRect,                    //ser� modificado apra preencher a dimens�o do texto
            lText,                    //n�o � modificado, a menos que voc� use o flag "tfModifyingString"
            [tfCalcRect, tfWordBreak] //o flag para indicar "calcule a dimens�o do texto com as quebras de linha"
          );
  Assert( lRect.Top = 0 );
  //ALabel.Height := lRect.Bottom; //para teste apenas
  Result := lRect.Bottom;
end;



procedure TfrmMessageBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= TCloseAction.caFree;
  frmMessageBox:= nil;
end;


procedure TfrmMessageBox.FormCreate(Sender: TObject);
begin
  FLabelHeight:= lblMessage.Height;
end;


function TfrmMessageBox.ShowModal(AMessage: String): Integer;
var
  h: Integer;
begin
  DisableAlign;

  lblMessage.Caption:= AMessage;
  Application.ProcessMessages;
  lblMessage.Height:= CalcRecLabel(lblMessage, Self.Width);

  Self.Height:= Self.Height + (lblMessage.Height - FLabelHeight);
  FLabelHeight:= lblMessage.Height;

  EnableAlign;

  Result:= inherited ShowModal();

end;
end.

Pegue e coloque a unit no seu projeto

Exemplo de uso:

var
  msg: string;
begin
  if not Assigned(frmMessageBox) then frmMessageBox:= TfrmMessageBox.Create(Self);
  msg:= '<Escreva um texto grande aqui>';
  frmMessageBox.ShowModal(msg);
end;

Acho que isto deve te ajudar ou a te guiar numa outra solu��o.

GOSTEI 1

Mais Respostas

Vanessa Cruz

08/05/2020

Guilherme Muito obrigada! Me ajudou muito sua dica.

GOSTEI 0

Vanessa Cruz

08/05/2020

Para colegas que tamb�m estejam com a mesma dificuldade, modifiquei da a fun��o CalcRecLabel da seguinte maneira:

function TfrmMensagens.CalcRecLabel(ALabel: TLabel;AForm:Tform; AWidth: Integer): Integer;
var
  lRect : TRect;
  lText : string;
begin
  lRect.Left := 0;
  lRect.Right := AWidth;
  lRect.Top := 0;
  lRect.Bottom := 0;

  lText := ALabel.Caption;

  AForm.Canvas.TextRect(
            lRect,                    //ser� modificado apra preencher a dimens�o do texto
            lText,                    //n�o � modificado, a menos que voc� use o flag "tfModifyingString"
            [tfCalcRect, tfWordBreak] //o flag para indicar "calcule a dimens�o do texto com as quebras de linha"
          );
  Assert( lRect.Top = 0 );
  Result := lRect.Bottom;

class function TfrmMensagens.Mensagem(Texto, Titulo: String; Tipo: String;
  Botoes: array of TMyButtons;const Minimizar:boolean): Boolean;
var
  i: Integer;
  frm :TfrmMensagens;
  FLabelHeight: Integer;
begin
  frm := TfrmMensagens.Create(nil);
  try
    if Minimizar = true then
    begin
      frm.OnShow := frm.eventoOnShow;
    end;
    FLabelHeight :=frm.lblMensagem.Height;
    frm.lblMensagem.Caption := Texto;

    frm.Height := frm.Height + frm.CalcRecLabel(frm.lblMensagem, frm , frm.Width);
    frm.Height:= frm.Height - FLabelHeight;
    frm.Caption := Titulo;

    for i:=0 to Length(Botoes)-1 do
    begin
      case (Botoes[i]) of
        mbOk: begin
                frm.BtnOK.Visible := True;
                frm.BtnOK.Left := LEFTBUTTONS[i];
              end;
        mbDefNao: begin
                    frm.btnNao.TabOrder := 0;
                    frm.btnNao.Visible := True;
                    frm.btnNao.Left := LEFTBUTTONS[i];
                  end;
        mbSim: begin
                 frm.btnSim.Visible := True;
                 frm.btnSim.Left := LEFTBUTTONS[i];
               end;

        mbNao: begin
                 frm.BtnNao.Visible := True;
                 frm.BtnNao.Left := LEFTBUTTONS[i];
               end;

      else begin
          frm.BtnOK.Visible := True;
          frm.BtnOK.Left := LEFTBUTTONS[i];
      end;
      end;
    end;

     frm.ShowModal;

    case (frm.ModalResult) of
      mrOk, mrYes : result := True;
    else
        result := False;
    end;

  finally
    if (frm<>nil) then
      FreeAndNil(frm);
  end;

E Assim obtive o resultado esperado, Guilherme muito obrigada!

GOSTEI 0

POSTAR