Ver Mensaje Individual
  #2  
Antiguo 01-08-2004
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Reputación: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
No hay una forma sencilla de hacer esto ya que debes ser tú mismo quien se encargue de dibujar todo el título si quieres que se haga de forma distinta al estándar.

El código que te pongo a continuación puede servirte aunque posiblemente sólo funcione con ventanas con borde bsSizeable. Para otros casos tendrás que calcular la posición correcta del título.

Código Delphi [-]
type
  TForm1 = class(TForm)
  private
    (*
      Windows pinta el título en cualquiera de estos dos mensajes, así
      que hay que interceptarlos para dibujar el título nosotros mismos
    *)
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;

  public
    (* Método para dibujar el título *)
    procedure PaintCaption;
end;

implementation

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;
  PaintCaption; // Pintar el título
end;

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  PaintCaption; // Pintar el título
end;

procedure TForm1.PaintCaption;
var
  NewCaption: String;
  ncCanvas: TCanvas;
  cxSmIcon: Integer;
  cxSizeFrame: Integer;
  cySizeFrame: Integer;
  cyCaption: Integer;
  cyText: Integer;

begin
  { Título de la ventana }
  NewCaption := 'Foros del Club Delphi';

  ncCanvas := TCanvas.Create;
  try
    { Obtener un canvas que incluya el área no-cliente }
    ncCanvas.Handle := GetWindowDC(Handle);
    with ncCanvas do
    begin
      { Usar fondo transparente }
      Brush.Style := bsClear;

      { Fuente del título }
      Font.Name := 'Comic Sans MS';
      Font.Size := 8;
      Font.Color := clYellow;
      Font.Style := [fsBold];

      { Medidas para colocar el título }
      cxSmIcon := GetSystemMetrics(SM_CXSMICON);
      cxSizeFrame := GetSystemMetrics(SM_CXSIZEFRAME);
      cySizeFrame := GetSystemMetrics(SM_CYSIZEFRAME);
      cyCaption := GetSystemMetrics(SM_CYCAPTION);
      cyText := TextHeight(NewCaption);

      { Pintar el título }
      TextOut(cxSizeFrame + cxSmIcon + 4, cySizeFrame + ((cyCaption - cyText) div 2) - 1, NewCaption);
    end;
  finally
    ReleaseDC(Handle, ncCanvas.Handle);
    ncCanvas.Free;
  end;
end;

Para que funcione bien deberás borrar la propiedad Caption del formulario.

// Saludos
Responder Con Cita