nimforum mirror - MS Windows Subclassing

geezer9 (orginal) [2016-07-26T21:01:44+02:00] view original

Dear oldwinapi experts:

I am trying to subclass the standard MS Windows "BUTTON" class, but wierd stuff keeps happening. The code shown below compiles and runs. The top button works, but the button below does not change state. WORSE, once it is exercised, whatever was done wrong now stops the top button from working.

There must be something about using a LONG_PTR variable as a WNDPROC in CallWindowProc that I am doing wrong.

BTW I am developing on Linux using Wine, the compilation command is:

nim --cpu:i386 --os:windows -o:msnb2forum.exe -r c msnb2forum.nim

and the nim.cfg file in the source folder is:

i386.windows.gcc.path = "/usr/bin"
i386.windows.gcc.exe = "i686-w64-mingw32-gcc"
i386.windows.gcc.linkerexe = "i686-w64-mingw32-gcc"

H E L P !

import strutils
import windows
var appInstance*:HINST = 0

proc makeWinClass(name:string,wndProc:WNDPROC,backgnd:HANDLE) =
    if appInstance==0:
        appInstance = GetModuleHandle(nil)
    var wndclass:WNDCLASS
    wndclass.style         = CS_HREDRAW or CS_VREDRAW
    wndclass.lpfnWndProc   = wndProc
    wndclass.cbClsExtra    = 0
    wndclass.cbWndExtra    = 0
    wndclass.hInstance     = appInstance
    wndclass.hIcon         = LoadIcon(0, IDI_APPLICATION)
    wndclass.hCursor       = LoadCursor(0, IDC_CROSS)
    wndclass.hbrBackground = backgnd        # GetStockObject(WHITE_BRUSH)
    wndclass.lpszMenuName  = nil
    wndclass.lpszClassName = name
    if RegisterClass(addr wndclass) == 0:
        raise newException(Exception,"makeWinClass FAILS")

proc bareWndProc(hWnd:HWND,message:WINUINT,wParam:WPARAM,lParam:LPARAM): LRESULT{.stdcall.} =
    return DefWindowProc(hWnd, message, wParam, lParam)

var btnwndpr:LONG_PTR

proc bscWndProc(hWnd:HWND,message:WINUINT,wParam:WPARAM,lParam:LPARAM): LRESULT{.stdcall.} =
    echo("in bscWndProc hWnd=",hWnd.toHex(8)," message=",message.toHex(4))
    var cwpRes = CallWindowProc(cast[WNDPROC](btnwndpr),hWnd,message,wParam,lParam)
    echo("cwpRes=",cwpRes.toHex(8))
    return cwpRes

makeWinClass("BARE",bareWndProc,GetStockObject(WHITE_BRUSH))

proc mainLoop*() =
    var msg:MSG
    while GetMessage(addr msg, 0, 0, 0) != 0:
        discard TranslateMessage(addr msg)
        discard DispatchMessage(addr msg)

var hmain:HWND = CreateWindowEx(
    0.DWORD,    # extended window style
    "BARE","Bare Bones",WS_THICKFRAME or WS_MAXIMIZEBOX or WS_MINIMIZEBOX or WS_SYSMENU,
    20.DWORD,30.DWORD,300.DWORD,200.DWORD,
    0.HWND,0.HMENU,appInstance,cast[LPVOID](0))

var btn1:HWND = CreateWindowEx(
    0.DWORD,    # extended window style
    "BUTTON","quit app",WS_CHILD or WS_VISIBLE,
    10.DWORD,10.DWORD,80.DWORD,24.DWORD,
    hmain,0.HMENU,appInstance,cast[LPVOID](0))

btnwndpr = GetWindowLongPtr(btn1,GWL_WNDPROC)
makeWinClass("BTNSC",bscWndProc,GetStockObject(GRAY_BRUSH))

var btn2:HWND = CreateWindowEx(
    0.DWORD,    # extended window style
    "BTNSC","sub btn",WS_CHILD or WS_VISIBLE,
    10.DWORD,40.DWORD,80.DWORD,24.DWORD,
    hmain,0.HMENU,appInstance,cast[LPVOID](0))

discard ShowWindow(hmain, SW_SHOW)

mainLoop()

Mirror of forum.nim-lang.org

2412 :: MS Windows Subclassing