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;