Wer unter WindowsXP programmiert und sein Programm so anlegt, das es die Visuellen Styles von XP benutzt, wird festgestellt haben, das der Gedrückt-Status eines TToolButtons nicht gezeichnet wird, wenn er den Style "tbsDropDown" hat (dies betrifft nicht den Teil des Buttons, der das dazugehörige DropDownMenu öffnet).
Da der ThemeManager von Mike Lischke leider hier keine Abhilfe schafft, habe ich in der Unit "ComCtrls.pas" einige kleine Änderungen eingefügt, welche dafür sorgen, das auch dann der Button korrekt dargestellt wird.
Damit keine Mißverständnisse auftreten, poste ich hier die komplette Procedure "TToolbar.WndProc". Die von mir gemachten Änderungen sind gekennzeichnet.
( Änderungen stehen zwischen { <<< ANFANG >>> } und { <<< ENDE >>> } )
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:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
| procedure TToolBar.WndProc(var Message: TMessage);
var
Control: TControl;
CapControl: TControl;
Msg: TMsg;
{ <<< ANFANG >>> }
State: Integer;
MousePos: TPoint;
function IsWinXP: Boolean;
var
osVersionInfo: TOSVersionInfo;
begin
osVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(osVersionInfo) then Result := ((osVersionInfo.dwMajorVersion = 5) and
(osVersionInfo.dwMinorVersion > 0)) or (osVersionInfo.dwMajorVersion > 5)
else
Result := False;
end;
{ <<< ENDE >>> }
function IsToolButtonMouseMsg(var Message: TWMMouse): Boolean;
begin
if GetCapture = Handle then
begin
CapControl := GetCaptureControl;
if (CapControl <> nil) and (CapControl.Parent <> Self) then
CapControl := nil;
end
else
CapControl := nil;
Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
Result := (Control <> nil) and (Control is TToolButton) and
not Control.Dragging;
end;
procedure SendDropdownMsg(Button: TToolButton);
var
Msg: TNMToolBar;
begin
FillChar(Msg, SizeOf(Msg), 0);
with Msg, hdr do
begin
hwndFrom := Handle;
idFrom := Handle;
code := TBN_DROPDOWN;
iItem := Button.Index;
end;
SendMessage(Handle, WM_NOTIFY, Handle, Longint(@Msg));
end;
begin
if not (csDesigning in ComponentState) then
begin
case Message.Msg of
WM_MOUSEMOVE:
begin
if IsToolButtonMouseMsg(TWMMouse(Message)) then
begin
if TControlAccess(Control).DragMode <> dmAutomatic then DefaultHandler(Message);
{ <<< ANFANG >>> }
if IsWinXP and (TToolButton(Control).Style = tbsDropDown) then
begin
GetCursorPos(MousePos);
MousePos := ScreenToClient(MousePos);
with TToolButton(Control) do
begin
if (MousePos.X < Left) or (MousePos.X > Left + Width) or
(MousePos.Y < Top) or (MousePos.Y > Top + Height) then
begin
State := SendMessage(Handle, TB_GETSTATE, Index, 0);
State := State and not TB_PRESSBUTTON;
SendMessage(Handle, TB_SETSTATE, Index, MakeLong(State, 0));
end;
end;
end;
{ <<< ENDE >>> }
end
else
DefaultHandler(Message);
end;
WM_LBUTTONUP:
if IsToolButtonMouseMsg(TWMMouse(Message)) then
begin
State := SendMessage(Handle, TB_GETSTATE, TToolButton(Control).Index, 0);
{ <<< ANFANG >>> }
if State and TB_PRESSBUTTON <> 0 then DefaultHandler(Message);
{ <<< ENDE >>> }
if (CapControl = Control) { <<< ANFANG >>> } or
(IsWinXP and (TToolButton(Control).Style = tbsDropDown)) { <<< ENDE >>> } then
begin
with TToolButton(Control) do
begin
if Down and Grouped and AllowAllUp and (Style = tbsCheck) then Down := False;
UpdateButtonStates;
{ <<< ANFANG >>> }
if IsWinXP and (Style = tbsDropDown) and (State and TB_PRESSBUTTON <> 0) then
Click;
{ <<< ENDE >>> }
end;
end
else if (CapControl is TToolButton) or
(TToolButton(Control).Style = tbsDropDown) then Exit;
end;
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if IsToolButtonMouseMsg(TWMMouse(Message)) then
begin
with TToolButton(Control) do
begin
if FInMenuLoop and Self.MouseCapture then MouseCapture := True;
if (Style <> tbsDropDown) or
(GetComCtlVersion >= ComCtlVersionIE4) and
(TWMMouse(Message).XPos < Left + ButtonWidth) then
begin
{ <<< ANFANG >>> }
if IsWinXP and (Style = tbsDropDown) then
begin
State := SendMessage(Handle, TB_GETSTATE, Index, 0);
State := State or TB_PRESSBUTTON and not TB_INDETERMINATE;
SendMessage(Handle, TB_SETSTATE, Index, MakeLong(State, 0));
end
else
{ <<< ENDE >>> }
inherited WndProc(Message);
end;
end;
if not Control.Dragging then DefaultHandler(Message);
if (TToolButton(Control).Style <> tbsDropDown) and
((TToolButton(Control).DropdownMenu <> nil) or
(TToolButton(Control).MenuItem <> nil)) then
begin
try
SendDropDownMsg(TToolButton(Control));
finally
Msg.Message := 0;
if PeekMessage(Msg, Handle, WM_LBUTTONDOWN, WM_LBUTTONDOWN,
PM_REMOVE) and (Msg.Message = WM_QUIT) then PostQuitMessage(Msg.WParam)
else
begin
Message.Msg := WM_LBUTTONUP;
Dispatch(Message);
end;
end;
end;
Exit;
end;
end
end;
inherited WndProc(Message);
end; |
Damit die Änderungen aktiv werden können, muss anschliessend das VCL-Verzeichnis noch zum Library-Pfad hinzugefügt werden, am Besten an erster Stelle stehend.
Gruss, Burgpflanze
>>>>> Jetzt wird das Click-Ereignis ausgelöst.
>>>>> Button wird jetzt korrekt gezeichnet, wenn man mit gedrückter Maustaste einen Button verläßt.
>>>>> Jetzt wird auch kein falsches Click-Ereignis mehr ausgelöst.
