Redimensionar Tform de acordo com o tamanho da string em um Tlabel.
08/05/2020
0
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?
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
Curtir tópico
+ 0
Responder
Post mais votado
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
Arquivo Unit7.pas
Pegue e coloque a unit no seu projeto
Exemplo de uso:
Acho que isto deve te ajudar ou a te guiar numa outra solução.
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.
Guilherme Wiethaus
Responder
Mais Posts
12/05/2020
Vanessa Cruz
Para colegas que também estejam com a mesma dificuldade, modifiquei da a função CalcRecLabel da seguinte maneira:
E Assim obtive o resultado esperado, Guilherme muito obrigada!
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!
Responder
Clique aqui para fazer login e interagir na Comunidade :)
Inserção de url
Descrição
Url