| Autor |
Beitrag |
Andreas L.
  
Beiträge: 1703
Erhaltene Danke: 25
Windows Vista / Windows 10
Delphi 2009 Pro (JVCL, DragDrop, rmKlever, ICS, EmbeddedWB, DEC, Indy)
|
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?
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 15.02.03 12:27
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.
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. 
Beiträge: 1703
Erhaltene Danke: 25
Windows Vista / Windows 10
Delphi 2009 Pro (JVCL, DragDrop, rmKlever, ICS, EmbeddedWB, DEC, Indy)
|
Verfasst: Sa 15.02.03 14:08
DANKE, dass hat mir schon sehr geholfen, aber wie färbe ich jetzt die Titelleiste!
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 15.02.03 14:33
| 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.
Beiträge: 1703
Erhaltene Danke: 25
Windows Vista / Windows 10
Delphi 2009 Pro (JVCL, DragDrop, rmKlever, ICS, EmbeddedWB, DEC, Indy)
|
Verfasst: Sa 15.02.03 14:42
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 15.02.03 14:45
www.luckie-online.de...tutorials/gdi1.shtml
Ich habe die betreffende Prozedur für dich noch mal etwas angepaßt und verbessert.
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; |
|
|
|
