Сабклассинг кнопки

[jungle]

Хотел изменить цвет кнопки, как оказалось, сделать через WM_CTLCOLORBTN это можно только если у кнопки стиль BS_OWNERDRAW. Получилось не совсем то, что было нужно. Попробовал сделать сабклассинг, изменился только курсор. Конечно, кнопку можно нарисовать самому, но может просто я что-то не правильно сделал?

program Sup;

uses
  Windows, Messages;

var
  wClass: TWndClassEx;
  Msg: TMsg;
  Button: HWND;
  OldProc: Pointer;

function ButtonWinProc(hWin, Msg, wParam, lParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY, WM_CLOSE: Exit;
  end;
  // вызов оригинальной оконной процедуры:
  Result := CallWindowProc(OldProc, hWin, Msg, wParam, lParam);
end;

function WindowProc(hWin, Msg, wParam, lParam: Integer): Integer; stdcall;
var
  TButtonClass: TWndClassEx;
begin
  case Msg of

    WM_CREATE:
    begin
      // суперклассинг:
      GetClassInfoEx(0, 'button', TButtonClass);
      OldProc := TButtonClass.lpfnWndProc;  // запоминаем старую оконную процедуру

      TButtonClass.cbSize           := Sizeof(TButtonClass);  // модификация класса
      TButtonClass.lpfnWndProc   := @ButtonWinProc;
      TButtonClass.hCursor          := LoadCursor(0, IDC_CROSS);
      TButtonClass.hbrBackground := CreateSolidBrush(rgb(255, 0, 0));
      TButtonClass.lpszClassName := 'ButtonWindowClass';

      RegisterClassEx(TButtonClass);
      Button := CreateWindowEx(0, 'ButtonWindowClass', 'Кнопка',
        WS_CHILD or WS_VISIBLE, 240, 160, 80, 20, hWin, 0, hInstance, nil);
      SendMessage(Button, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);
    end;

    WM_DESTROY:
    begin
      UnregisterClass('ButtonWindowClass', hInstance);  // уничтожение класса
      PostQuitMessage(0);
    end;

  end;
  Result := DefWindowProc(hWin, Msg, wParam, lParam)
end;

begin
  wClass.cbSize           := Sizeof(wClass);
  wClass.lpfnWndProc   :=  @WindowProc;
  wClass.hCursor          := LoadCursor(0,IDC_ARROW);
  wClass.hbrBackground := 1;
  wClass.lpszClassName := 'CN';

  RegisterClassEx(wClass);

  CreateWindowEx(0, 'CN', 'Кнопка', WS_OVERLAPPEDWINDOW or WS_VISIBLE,
    450, 300, 340, 220, 0, 0, hInstance, nil);

  while GetMessage(Msg, 0, 0, 0) do
    DispatchMessage(Msg)
end.

[jungle]

Вот так еще делал, результат тот же:

program Sub;

uses
  Windows, Messages;

var
  wClass: TWndClassEx;
  Msg: TMsg;
  Button: HWND;

function ButtonWinProc(hWin, Msg, wParam, lParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case Msg of
    WM_DESTROY, WM_CLOSE: Exit;
  end;
  // вызов оригинальной оконной процедуры:
  Result := CallWindowProc(Pointer(GetWindowLong(hWin, GWL_USERDATA)), hWin, Msg, wParam, lParam);
end;

function WindowProc(hWin, Msg, wParam, lParam: Integer): Integer; stdcall;
begin
  case Msg of

    WM_CREATE:
    begin
      Button := CreateWindowEx(0, 'Button', 'Кнопка',
        WS_CHILD or WS_VISIBLE, 240, 160, 80, 20, hWin, 0, hInstance, nil);
      SendMessage(Button, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);

      SetClassLong(Button, GCL_HCURSOR, LoadCursor(0, IDC_CROSS));  // сабклассинг
      SetClassLong(Button, GCL_HBRBACKGROUND, CreateSolidBrush(RGB(255, 0, 0)));  // сабклассинг
    end;

    WM_DESTROY:
    begin
      UnregisterClass('ButtonWindowClass', hInstance);  // уничтожение класса
      PostQuitMessage(0);
    end;

  end;
  Result := DefWindowProc(hWin, Msg, wParam, lParam)
end;

begin
  wClass.cbSize        := Sizeof(wClass);
  wClass.lpfnWndProc   :=  @WindowProc;
  wClass.hCursor       := LoadCursor(0,IDC_ARROW);
  wClass.hbrBackground := 1;
  wClass.lpszClassName := 'CN';

  RegisterClassEx(wClass);

  CreateWindowEx(0, 'CN', 'Кнопка', WS_OVERLAPPEDWINDOW or WS_VISIBLE,
    450, 300, 340, 220, 0, 0, hInstance, nil);

  while GetMessage(Msg, 0, 0, 0) do
    DispatchMessage(Msg)
end.

[Stilet]

http://www.delphiworld.narod.ru/base/colour_button.html
Рекомендую по изучать.