Содержание материала

 

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.

Примечание: formDeactivate никогда не вызывается, когда форма не активна, иногда FormPaint не называется. Если что-то вызывает форму, чтобы быть перекрашены в то время как в неактивном, он правильно рисует.

Code:

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, LabelTop: 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);

LabelTop := 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.Top := 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.


Code:

{ ... }

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;

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить