Titelleiste färben! Wie?

Andreas L. · Verfasst: Sa 15.02.03 12:02

Hi,
wie kann ich die blaue Titelleiste in meinen Programm färben bzw. ganz verändern! Andere Programme sollen davon nix abbekommen, nur meins. Gibts da eine Kompo?

Ehemaliges Mitglied Erhaltene Danke: 1

Hier mal etwas Code der einen Fenstertitel zentriert in der Titelleiste ausgibt und ein eigenes Bitmap als Schließen-Button in die Titelleiste zeichnet. Die Form sollte im OI keine Caption haben und alle BorderIcons auf FALSE setzen.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMACTIVATE(var Msg: TMessage); Message WM_ACTIVATE;
    procedure WMNCHITTEST(var Msg: TWMNChittest); Message WM_NCHITTEST;
    procedure WMNCLBUTTONDOWN(var Msg: TMessage); Message WM_NCLBUTTONDOWN;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  bHit: Boolean;

procedure TForm1.WMNCHITTEST(var Msg: TWMNChittest);
var
  x,y: SmallInt;
  dc: HDC;
  rect: TRect;
begin
  DefaultHandler(Msg);
  x := Msg.XPos-Left;
  y := Msg.YPos-Top;
  GetWindowRect(Handle, rect);
  if (x <= width) and (x >= width-21)
    and (y >= 0) and
    (y <= GetSystemmetrics(SM_CYEDGE)+14) then
  begin
    bHit := TRUE;
  end
  else
    bHit := FALSE;
end;

procedure TForm1.WMNCLBUTTONDOWN(var Msg: TMessage);
begin
  if bHit = TRUE then Close
  else
    inherited;
end;

procedure TForm1.WMACTIVATE(var Msg: TMessage);
var
  rgn: HRGN;
  rect, btnrect: TRect;
  dc: HDC;
  szBuffer: array[0..255] of Char;
  bmp: TBITMAP;
begin
  if Msg.Msg = WM_ACTIVATE then
  begin
    dc := GetWindowDC(Handle);
    rect.Left := GetSystemmetrics(SM_CXEDGE);
    rect.Top := GetSystemmetrics(SM_CYFRAME);
    rect.Right := Form1.Width;
    rect.Bottom := Getsystemmetrics(SM_CYCAPTION);
    try
      bmp := TBITMAP.Create;
      bmp.loadfromfile('.\MyButton.bmp');
      btnrect.Left := Width-21;
      btnrect.Top := rect.Top+1;
      StretchBlt(dc, btnrect.Left, btnrect.Top, bmp.Width, bmp.Height,
        bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, SRCCOPY);
      lstrcpy(szBuffer, 'Meine Fenstercaption');
      SetBkMode(dc, TRANSPARENT);
      SetTextColor(dc, RGB(255,255,255));
      DrawText(dc, szBuffer, lstrlen(szBuffer), rect, DT_CENTER);
    finally
      bmp.Free;
    end;
  end
  else
    Inherited;
  ReleaseDc(Handle, dc);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PostMessage(Handle, WM_ACTIVATE, 0, 0);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  SendMessage(handle, WM_ACTIVATE, 0 , 0);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  SendMessage(handle, WM_ACTIVATE, 0 , 0);
end;

end.

Nur gefallen wird es mir nicht. Ich mag es nicht, wenn Programme an Dingen rumdrehen, an denen sie nichts zu drehen haben. Das was ich gemacht habe, liegt aber noch in den akzeptierbaren Grenzen.

Andreas L. · Verfasst: Sa 15.02.03 14:08

DANKE, dass hat mir schon sehr geholfen, aber wie färbe ich jetzt die Titelleiste!

Ehemaliges Mitglied Erhaltene Danke: 1

onlinehome hat folgendes geschrieben:

DANKE, dass hat mir schon sehr geholfen, aber wie färbe ich jetzt die Titelleiste!

Na ja so richtig aber wohl noch nicht. Versuch es mal mit der API Rectangle:

Zitat:

Rectangle
The Rectangle function draws a rectangle. The rectangle is outlined by using the current pen and filled by using the current brush.

Andreas L. · Verfasst: Sa 15.02.03 14:42

und wie geht das?

Ehemaliges Mitglied Erhaltene Danke: 1

www.luckie-online.de...tutorials/gdi1.shtml

Ich habe die betreffende Prozedur für dich noch mal etwas angepaßt und verbessert.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

procedure TForm1.WMACTIVATE(var Msg: TMessage);
var
  rgn: HRGN;
  rect, btnrect: TRect;
  dc: HDC;
  szBuffer: array[0..255] of Char;
  bmp: TBITMAP;
  brush : HBRUSH;
begin
  if Msg.Msg = WM_ACTIVATE then
  begin
    dc := GetWindowDC(Handle);
    rect.Left := GetSystemmetrics(SM_CXEDGE);
    rect.Top := GetSystemmetrics(SM_CYEDGE);
    rect.Right := Form1.Width-GetSystemmetrics(SM_CYEDGE);
    rect.Bottom := Getsystemmetrics(SM_CYCAPTION)+GetSystemmetrics(SM_CYFRAME);
    try
      bmp := TBITMAP.Create;
      bmp.loadfromfile('.\MyButton.bmp');
      btnrect.Left := Width-21;
      btnrect.Top := rect.Top+1;
      brush := CreateSolidBrush(RGB(255,0,0));
      SelectObject(dc, brush);
      Rectangle(dc, rect.Left, rect.Top, rect.Right, rect.Bottom);
      StretchBlt(dc, btnrect.Left, btnrect.Top+2, bmp.Width, bmp.Height,
        bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, SRCCOPY);
      lstrcpy(szBuffer, 'Meine Fenstercaption');
      SetBkMode(dc, TRANSPARENT);
      SetTextColor(dc, RGB(255,255,255));
      DrawText(dc, szBuffer, lstrlen(szBuffer), rect, DT_CENTER or DT_VCENTER);
    finally
      bmp.Free;
    end;
      ReleaseDC(Handle, dc);
  end
  else
    Inherited;
  ReleaseDc(Handle, dc);
end;

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme