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. |