Foros Club Delphi - Procedimiento para cambio de propiedades de Fonts

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)

- - Procedimiento para cambio de propiedades de Fonts (https://www.clubdelphi.com/foros/showthread.php?t=88384)

Procedimiento para cambio de propiedades de Fonts

En el programa que estoy haciendo hago referencia muchas veces a cambiar a un tipo de letra específico.
Necesito crear un procedure donde le pueda asignar propiedades Name, Color, Size y Style a una fuente para no repetir código innecesariamente.
Alguna solución (código) sencillo que me puedan pasar?

sac,

Cita:

Empezado por sac

...crear un procedure donde le pueda asignar propiedades Name, Color, Size y Style a una fuente...

:rolleyes:

Revisa este código:

Código Delphi [-]unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ChangeFont(F : TFont; Name : String; Color : TColor; Size : Byte; Style : TFontStyles);
begin
   F.Name := Name;
   F.Color := Color;
   F.Size := Size;
   F.Style := Style;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   S : String;

begin

   S := 'Ejemplo de cambio de propiedades de un Font';

   Label1.Caption := S;
   Edit1.Text := S;
   Memo1.Lines.Add(S)

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   FontName : String;
   FontColor : TColor;
   FontSize : Byte;
   FontStyle : TFontStyles;

begin

   FontName := 'Arial';;
   FontColor := clNavy;
   FontSize := 12;
   FontStyle := [];

   ChangeFont(Label1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Edit1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Memo1.Font, FontName, FontColor, FontSize, FontStyle);

end;

procedure TForm1.Button2Click(Sender: TObject);
var
   FontName : String;
   FontColor : TColor;
   FontSize : Byte;
   FontStyle : TFontStyles;

begin

   FontName := 'Arial Rounded MT';
   FontColor := clGreen;
   FontSize := 10;
   FontStyle := [fsBold];

   ChangeFont(Label1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Edit1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Memo1.Font, FontName, FontColor, FontSize, FontStyle);

end;

procedure TForm1.Button3Click(Sender: TObject);
var
   FontName : String;
   FontColor : TColor;
   FontSize : Byte;
   FontStyle : TFontStyles;

begin

   FontName := 'Elephant';
   FontColor := clBlue;
   FontSize := 10;
   FontStyle := [fsItalic, fsUnderline];

   ChangeFont(Label1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Edit1.Font, FontName, FontColor, FontSize, FontStyle);
   ChangeFont(Memo1.Font, FontName, FontColor, FontSize, FontStyle);

end;

end.

El código anterior en Delphi 7 sobre Windows 7 Professional x32, Permite modificar selectivamente las propiedades de un TFont, como se muestra en la siguiente imagen:

Espero sea útil :)

Nelson.

Muchas gracias por la respuesta... Probando

Pregunto... No se puede crear una variable de tipo TFont donde se cargue una sola vez las propiedades que te dije antes y que desde el programa haga referencia cambiando como por ejemplo :

Declarar
FuenteElegida:Tfont
y después algo así: fuente elegida.Name := 'Tahoma', Size, color , style etc.

y después, desde el programa ppal. una linea tipo memo1.lines.font:= fuenteElegida...

Algo así se podrá?

sac,

Cita:

Empezado por sac

...No se puede crear una variable de tipo TFont donde se cargue una sola vez las propiedades...

:rolleyes:

Revisa este código:

Código Delphi [-]unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FontBase : TFont;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
   S : String;

begin

   S := 'Ejemplo de cambio de propiedades de un Font';

   Label1.Caption := S;
   Edit1.Text := S;
   Memo1.Lines.Add(S);

   FontBase := TFont.Create;

   FontBase.Name := 'Tahoma';
   FontBase.Color := clBlue;
   FontBase.Size := 11;
   FontBase.Style := [fsBold, fsItalic, fsUnderline];

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Label1.Font := FontBase;
   Edit1.Font := FontBase;
   Memo1.Font := FontBase;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := caFree;
   FontBase.Free;
end;

end.

El código anterior en Delphi 7 sobre Windows 7 Professional x32, Permite modificar las propiedades de un TFont por medio de otro TFont, como se muestra en la siguiente imagen:

Espero sea útil :)

Nelson.

nlsgarcia, OJO con el asignar a TFont a otro.
En tu último ejemplo, si no me falla los conceptos, cualquier posterior modificación de FontBase afectará al TFont de Label1, Edit1, Memo1 ya que en realidad cuando se hace Objeto.Font := OtroFont se está apuntándo a éste.

Asi que habrá que tener cuidado de lo que se hace.

Si se quiere copiar el contenido de un Font a otro puede usarse AsingTo()

Saludos,

Hola Delphius.

Al tratar con apuntadores es totalmente correcta tu apreciación, como queda claro en este ejemplo:

Código Delphi [-]var
  f1, f2: TFont;
begin
  f1 := TFont.Create;
  f2 := TFont.Create;

  f2 := f1;   // (*) f2.Assign(f1) 
  f1.Free;

  f2.Color := clRed;  // ¡ Error, f2 no es un apuntador válido !

Lo correcto sería usar el método Assign (*), que copia las propiedades a la otra instancia de TFont.

Pero para el código anterior:

Código Delphi [-]   Label1.Font := FontBase;
   Edit1.Font := FontBase;
   Memo1.Font := FontBase;
  ...

Font , que estos componentes heredan de TControl, está definida como una propiedad:

Código Delphi [-]  TControl = class(TComponent)
  ...
    property Font: TFont read FFont write SetFont stored IsFontStored;
  ...
  end;
...
procedure TControl.SetFont(Value: TFont);
begin
  FFont.Assign(Value);  
end;

por lo que en el caso anterior, no se trataría de una asignación de punteros.

Saludos :)

Algo tan simple y, sin embargo, muy instructivo.

Problema Resuelto

Como dijera Casimiro muy instructivo todo. Con ustedes se aprende mucho.
Gracias.

Cita:

Empezado por ecfisa (Mensaje 492715)

Hola Delphius.

Al tratar con apuntadores es totalmente correcta tu apreciación, como queda claro en este ejemplo:
Código Delphi [-]var f1, f2: TFont; begin f1 := TFont.Create; f2 := TFont.Create; f2 := f1; // (*) f2.Assign(f1) f1.Free; f2.Color := clRed; // ¡ Error, f2 no es un apuntador válido !

Lo correcto sería usar el método Assign (*), que copia las propiedades a la otra instancia de TFont.

Pero para el código anterior:
Código Delphi [-] Label1.Font := FontBase; Edit1.Font := FontBase; Memo1.Font := FontBase; ...

Font , que estos componentes heredan de TControl, está definida como una propiedad:
Código Delphi [-] TControl = class(TComponent) ... property Font: TFont read FFont write SetFont stored IsFontStored; ... end; ... procedure TControl.SetFont(Value: TFont); begin FFont.Assign(Value); end;

por lo que en el caso anterior, no se trataría de una asignación de punteros.

Saludos :)

Vaya. Eso si que es una sorpresa. No recordaba que una asignación del TFont entre componentes (al menos en los TControl y descendientes) se procediera con el Asign().
Recuerdo de La Cara Oculta la advertencia que se daba justamente sobre TFont y por ello se me quedó en la cabeza que debía hacerse por medio de Assing().

Hagan de cuenta entonces que no dije nada.

En Lazarus, las cosas son un poquito diferentes:

Código Delphi [-]procedure TControl.SetFont(Value: TFont);
begin
  if FFont.IsEqual(Value) then exit;
  FFont.Assign(Value);
  Invalidate;
end;

Y de curioso me puse a ver como está implementado el Assign() y vaya código de extraño e intrincado, me imaginaba algo más directo de copiar:

Código Delphi [-]procedure TFont.Assign(Source: TPersistent);
begin
  if Source is TFont then
  begin
    //TODO:lock;
    try
      //TODO: TFont(Source).Lock;
      try
        BeginUpdate;
        try
          CharSet := TFont(Source).CharSet;
          SetColor(TFont(Source).Color, TFPCanvasHelper(Source).FPColor);
          if TFont(Source).PixelsPerInch <> FPixelsPerInch then
            // use size to convert source height pixels to current resolution
            Size := TFont(Source).Size
          else
            // use height which users could have changed directly
            Height := TFont(Source).Height;
          Name := TFont(Source).Name;
          Orientation := TFont(Source).Orientation;
          Pitch := TFont(Source).Pitch;
          Style := TFont(Source).Style;
          Quality := TFont(Source).Quality;
        finally
          EndUpdate;
        end;
      finally
        //TODO: TFont(Source).UnLock;
      end;
    finally
      //TODO: UnLock;
    end;
    Exit;
  end;

  inherited Assign(Source);
end;

Saludos,
PD: Se que no se debe hacer pero... ¿alguien más se anima a hecharle un ojo a mi hilo abierto hace unos días? :p

Sí que es raro, además esos beginupdate y endupdate, como si fuese una transacción :confused:

Cita:

Empezado por Casimiro Notevi (Mensaje 492725)

Sí que es raro, además esos beginupdate y endupdate, como si fuese una transacción :confused:

Hasta donde se esos BeginUpdate y EndUpdate son para llevar una copia segura. Creo que tiene algo que ver con intentos de acceso mientras se invoca a Assign.

OJO: esto es código Lazarus. Desconozco si en Delphi es similar.

Saludos,