Auf nonVCL Button Zeichnen Wie?

[ts_abc]

Hallo,

wollte gerade Posten das ich herausgefunden habe wie es geht. Aber trotzdem besten dank für eure Posts es war genau das was ich gesucht habe. Habe es so wie scp beschrieben hat gemacht. Obendrein war da noch das Problem dass wenn die Maus über dem Button schwebt kein WM_DRAWITEM ausgelöst wurde und ebenso nicht wenn Sie ihn verläst. Musste dies selbst implementieren in dem ich dem Button die WndProc geklaut habe. Poste dies mal hier noch mit falls noch jemand dieses Problem hat.

Delphi-Quellcode:

uses
  XPTheme,
  Windows,
  Messages,
  ...;

const
  IDC_BUTTON_1  = 19;

var
  hButton_1      : DWORD;

//
// "BtnWndProc"
//
var
  MsInBtn1,
  BtnLM          : Boolean;
  DefBtnProc     : Pointer;

function BtnWndProc(wnd: HWND; uMsg: UINT; wp: wParam; lp: LParam): LRESULT;
  stdcall;
var
  TME        : TTrackMouseEvent;
  TME_Proc   : function(var EventTrack: TTrackMouseEvent): BOOL; stdcall;
begin
  Result := 0;
  case uMsg of
    WM_LBUTTONDOWN:
      begin
        BtnLM := True;
        Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
      end;
    WM_LBUTTONUP:
      begin
        BtnLM := False;
        Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
      end;
    WM_MOUSEHOVER:
      begin
        if MsInBtn1 or BtnLM then exit;
        MsInBtn1 := True;
        RedrawWindow(wnd, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
        Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
      end;
    WM_MOUSELEAVE:
      begin
        if not MsInBtn1 or BtnLM then exit;
        MsInBtn1 := False;
        RedrawWindow(wnd, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
        Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
      end;
    WM_MOUSEMOVE:
      begin
        TME.cbSize := sizeof(TTrackMouseEvent);
        TME.dwFlags := TME_HOVER or TME_LEAVE;
        TME.dwHoverTime := 10;
        TME.hwndTrack := hButton_1;
        TME_Proc := @TrackMouseEvent;
        TME_Proc(TME);
        Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
      end;
  else
    Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
  end;
end;

//
// "WndProc"
//
function WndProc(wnd: HWND; uMsg: UINT; wp: wParam; lp: LParam): LRESULT;
  stdcall;
var
  Details    : TThemedElementDetails;
begin
  Result := 0;
  case uMsg of
    WM_CREATE:
      begin

        ...

        // Button erzeugen
        hButton_1 := CreateWindowEx(0, 'BUTTON', 'x', WS_VISIBLE or WS_CHILD or
          BS_OWNERDRAW, 255,0,13,13, Wnd, IDC_BUTTON_1, hInstance,nil);
        DefBtnProc := Pointer(GetWindowLong(hButton_1, GWL_WNDPROC));
        SetWindowLong(hButton_1, GWL_WNDPROC, Integer(@BtnWndProc));

        ... 
      end;
    WM_THEMECHANGED:
      UpdateThemes;
    WM_DRAWITEM:
      case wp of
        IDC_BUTTON_1:
          begin
            with PDrawItemStruct(lp)^ do
              if MsInBtn1 and not BtnLM then
                itemState := itemState or ODS_HOTLIGHT
              else
                itemState := itemState and not ODS_HOTLIGHT;

              Details := GetElementDetails(ttbButtonNormal);
              DrawParentBackground(hButton_1, hDC, @Details, True);
              DrawButton(hButton_1, PDrawItemStruct(lp)^);
            end;
          end;
      end;
    WM_COMMAND:
      case LOWORD(wp) of
        IDC_BUTTON_1:
          begin
            if HIWORD(wp) = BN_CLICKED then SendMessage(wnd,WM_CLOSE,0,0);
          end;
      end;
    WM_DESTROY:
      begin
        SetWindowLong(hButton_1, GWL_WNDPROC, Integer(DefBtnProc));
        DestroyThemeServices;
        PostQuitMessage(0);
      end;
  else
    Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;

Gruß Thomas