Как изменить шрифт и выравнивание в заголовке формы?

Note: The formDeactivate never gets called so when the form isn't active, sometimes the FormPaint isn't called. If anything causes the form to be repainted while in inactive, it draws correctly.

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

 TForm1 = class(TForm)

  procedure FormPaint(Sender: TObject);

  procedure FormResize(Sender: TObject);

  procedure FormDeactivate(Sender: TObject);

  procedure FormActivate(Sender: TObject);

 private

 public

  { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormPaint(Sender: TObject);

var

 LabelHeight, LabelWidth, Label: Integer;

 caption_height, border3d_y, button_width, border_thickness: Integer;

 MyCanvas: TCanvas;

 CaptionBarRect: TRect;

begin

 CaptionBarRect := Rect(0, 0, 0, 0);

 MyCanvas := TCanvas.Create;

 MyCanvas.Handle := GetWindowDC(Form1.Handle);

 border3d_y := GetSystemMetrics(SM_CYEDGE);

 button_width := GetSystemMetrics(SM_CXSIZE);

 border_thickness := GetSystemMetrics(SM_CYSIZEFRAME);

 caption_height := GetSystemMetrics(SM_CYCAPTION);

 LabelWidth := Form1.Canvas.TextWidth(Form1.Caption);

 LabelHeight := Form1.Canvas.TextHeight(Form1.Caption);

 Label := LabelHeight - (caption_height div 2);

 CaptionBarRect.Left := border_thickness + border3d_y + button_width;

 CaptionBarRect.Right := Form1.Width - (border_thickness + border3d_y)

        - (button_width * 4);

 CaptionBarRect. := border_thickness + border3d_y;

 CaptionBarRect.Bottom := caption_height;

 if Form1.Active then

  MyCanvas.Brush.Color := clActiveCaption

 else

  MyCanvas.Brush.Color := clInActiveCaption;

 MyCanvas.Brush.Style := bsSolid;

 MyCanvas.FillRect(CaptionBarRect);

 MyCanvas.Brush.Style := bsClear;

 MyCanvas.Font.Color := clCaptionText;

 MyCanvas.Font.Name := 'MS Sans Serif';

 MyCanvas.Font.Style := MyCanvas.Font.Style + [fsBold];

 DrawText(MyCanvas.Handle, PChar(' ' + Form1.Caption), Length(Form1.Caption) + 1,

  CaptionBarRect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);

 MyCanvas.Free;

end;

procedure TForm1.FormResize(Sender: TObject);

begin

 Form1.Paint;

end;

procedure TForm1.FormDeactivate(Sender: TObject);

begin

 Form1.Paint;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

 Form1.Paint;

end;

end.

{ ... }
type
 TForm1 = class(TForm)
 private
  procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
 public
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
 ACanvas: TCanvas;
begin
 inherited;
 ACanvas := TCanvas.Create;
 try
  ACanvas.Handle := GetWindowDC(Form1.Handle);
  with ACanvas do
  begin
  Brush.Color := clActiveCaption;
  Font.Name := 'Tahoma';
  Font.Size := 8;
  Font.Color := clred;
  Font.Style := [fsItalic, fsBold];
  TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
  Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2) + 1,
  ' Some Text');
  end;
 finally
  ReleaseDC(Form1.Handle, ACanvas.Handle);
  ACanvas.Free;
 end;
end;

Взято с Delphi Knowledge Base: http://www.baltsoft.com/

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...