Ver Mensaje Individual
  #2  
Antiguo 20-06-2014
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 38
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola bulc.

Según entiendo, no podes cambiar el tamaño del font de un InputBox, pero nada impide hacerte una unidad con una función similar que sí lo permita.

Código Delphi [-]
(* 
  El siguiente código de ejemplo está basado en el original de Delphi (unit Dialogs.pas)  
*)
unit uMiMensaje;

interface

uses Windows, Graphics;

type
  TMiMensaje = class
  private
    FLabelFont, FEditFont: TFont;
    function GetAveCharSize(Canvas: TCanvas): TPoint;
    function InputQuery(const ACaption, APrompt: string;var Value: string): Boolean;
  public
    property LabelFont: TFont read FLabelFont write FLabelFont;
    property EditFont: TFont read FEditFont write FEditFont;
    constructor Create;
    function InputBox(const ACaption, APrompt, ADefault: string): string;
    destructor Destroy; override;
  end;

implementation

uses  SysUtils, CommDlg, Forms, Controls, StdCtrls;

constructor TMiMensaje.Create;
begin
  inherited Create;
  FLabelFont:= TFont.Create;
  FEditFont:= TFont.Create;
end;

function TMiMensaje.GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[i] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function TMiMensaje.InputQuery(const ACaption, APrompt: string;var Value: string): Boolean;
const
  SMsgDlgOK = 'OK';
  SMsgDlgCancel = 'Cancel';
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
    try
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Font.Assign(FLabelFont);
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Font.Assign(FEditFont);
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Value;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgOK;
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := SMsgDlgCancel;
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        Value := Edit.Text;
        Result := True;
      end;
    finally
      Form.Free;
    end;
end;

function TMiMensaje.InputBox(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  InputQuery(ACaption, APrompt, Result);
end;

destructor TMiMensaje.Destroy;
begin
  FLabelFont.Free;
  FEditFont.Free;
  inherited;
end;

end.

Ejemplo de uso:
Código Delphi [-]
...
implementation

uses uMiMensaje;

procedure TForm1.Button1Click(Sender: TObject);
var
  sDato: string;
begin
  with TMiMensaje.Create do
  try
    LabelFont.Size:= 14;
    LabelFont.Name:= 'Segoe Script';
    EditFont.Size:= 9;
    EditFont.Name:= 'Segoe Print';
    sDato:= InputBox('Introduce el número base...', 'Número:', sDato);
    ShowMessage(sDato);
  finally
    Free;
  end;
end;

Saludos
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita