Windows - escrever ou desenhar na barra de titulo da janela

Top  Previous  Next

unit Unit1;

 

interface

 

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

 

type

  TForm1 = class(TForm)

  private

    procedure WMNCActivate(var M: TMessage); message WM_NCACTIVATE;

    procedure WMNCPaint(var M: TMessage); message WM_NCPAINT;

    procedure Titulo(wParam: Integer);

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Titulo(wParam: Integer);

var

  DC: THandle;

  R1, R2: TRect;

begin

  DC := GetWindowDC(Handle);

  try

    SetWindowText(Handle, nil);

    GetWindowRect(Handle, R2);

    R1.Left := GetSystemMetrics(SM_CXSIZE)

      + GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXFRAME);

    R1.Top := GetSystemMetrics(SM_CYFRAME);

    R1.Right := R2.Right - R2.Left - R1.Left

      - 2 * GetSystemMetrics(SM_CXSIZE);

    R1.Bottom := R1.Top + GetSystemMetrics(SM_CYSIZE);

    if wParam = 1 then

      SetBkColor(DC, GetSysColor(COLOR_ACTIVECAPTION))

    else

      SetBkColor(DC, GetSysColor(COLOR_INACTIVECAPTION));

    SetTextColor(DC, GetSysColor(COLOR_CAPTIONTEXT));

    DrawText(DC, 'A la izquierda', -1, R1, DT_LEFT or DT_VCENTER);

    DrawText(DC, 'A la derecha', -1, R1, DT_RIGHT or DT_VCENTER);

    DrawIcon(DC, R1.Left, R1.Top + 3, Application.Icon.Handle);

  finally

    ReleaseDC(Handle, DC);

  end;

end;

 

procedure TForm1.WMNCActivate(var M: TMessage);

begin

  DefWindowProc(Handle, M.Msg, M.wParam, M.lParam);

  Titulo(M.wParam);

  M.Result := 1;

end;

 

procedure TForm1.WMNCPaint(var M: TMessage);

begin

  DefWindowProc(Handle, M.Msg, M.wParam, M.lParam);

  Titulo(1);

end;

 

end.