Tweet
The following code I got from Poffs (think it's Semen's code, not sure)
create a superclass.
Just after PBMAIN I have the following code. Everyone of these superclasses
initializes correctly except NEditNumber and it's procedure NEditNumberProc
In general what could I be looking for that would cause a superclassed instance
to fail to initialize.
The following code is similar to all the other ones that work ok.
Maybe a fresh pair of eyes can spot something. It worked fine
before lunch and something I did after lunch must have messed it up.
Bob Mechler
create a superclass.
Code:
FUNCTION CreateSuperClass(OldClassName AS STRING, NewClassName AS STRING, lpfnNewWndProc AS LONG, cbWndExtra AS LONG) AS LONG
LOCAL wc AS WNDCLASSEX
wc.cbSize = SIZEOF(wc)
IF GetClassInfoEx(BYVAL 0&, BYVAL STRPTR(OldClassName), wc) THEN
CallWindowProc lpfnNewWndProc, 0, 0, wc.lpfnWndProc, wc.cbWndExtra
wc.hInstance = GetModuleHandle(BYVAL 0&)
wc.lpszClassName = STRPTR(NewClassName)
wc.lpfnWndProc = lpfnNewWndProc
wc.cbWndExtra = wc.cbWndExtra + cbWndExtra
FUNCTION = RegisterClassEx(wc)
END IF
END FUNCTION
initializes correctly except NEditNumber and it's procedure NEditNumberProc
In general what could I be looking for that would cause a superclassed instance
to fail to initialize.
Code:
IF ISFALSE(CreateSuperClass("EDIT", "NEdit", CODEPTR(NEditProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NEditActnr", CODEPTR(NEditActnrProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NEditCusip", CODEPTR(NEditCusipProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NEditRelParty", CODEPTR(NEditRelPartyProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NDate", CODEPTR(NDateProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NVSet", CODEPTR(NVsetProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NPos", CODEPTR(NPosProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("EDIT", "NEditNumber", CODEPTR(NEditNumberProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NCusipButton", CODEPTR(NCusipButtonProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NCusipButtonA", CODEPTR(NCusipButtonAProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NActnrButton", CODEPTR(NActnrButtonProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NRelPartyButton", CODEPTR(NRelPartyButtonProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NDateButton", CODEPTR(NDateButtonProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NGoButton", CODEPTR(NGoButtonProc), 4)) THEN EXIT FUNCTION
IF ISFALSE(CreateSuperClass("BUTTON", "NNumCalcButton", CODEPTR(NNumCalcButtonProc), 4)) THEN EXIT FUNCTION
Code:
CALLBACK FUNCTION NEditNumberProc
STATIC OldProc AS LONG, OffsetWndExtra AS LONG
LOCAL FieldL AS LONG,FieldD AS LONG
LOCAL V_NKEYPOS AS LONG,sTXT AS STRING,Txt AS ASCIIZ * %MAX_PATH, zfName AS ASCIIZ * %MAX_PATH
LOCAL ValidNumKeys AS STRING,FieldId as LONG
LOCAL NumID AS LONG,V_DECPT AS LONG, V_TXTLEN AS LONG,Value AS DOUBLE
DIM Tlen AS LOCAL LONG
IF CBHNDL = 0 THEN OldProc = CBWPARAM: OffsetWndExtra = CBLPARAM: EXIT FUNCTION
ValidNumKeys$ = "-.0123456789" + CHR$(8)
ValidNumKeysAbbrev$ = "[.-0-9]"
'Control Id and Handle of Num
NumID& = getdlgctrlid(CBHNDL)
CONTROL GET USER GetParent(CBHNDL),NumID&,1 TO FieldL
CONTROL GET USER GetParent(CBHNDL),NumID&,2 TO FieldD
'When I create the control I store the Field length and Decimal length
'in the control with CONTROL SET USER. I do this in all the other
'superclassed controls without a problem. Here they return 0
SELECT CASE CBMSG
CASE %WM_GETDLGCODE
FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
CASE %WM_KEYUP
CONTROL SEND GetParent(CBHNDL),NumID&, %EM_GETSEL, 0, 0 TO V_NKEYPOS& 'Used to detect when field is filled
IF LOWRD(V_NKEYPOS&) = FieldL THEN
SetFocus GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, 0) 'all ok, move to the next field
EXIT FUNCTION
END IF
CASE %WM_KEYDOWN
SELECT CASE CBWPARAM
CASE %VK_UP,%VK_DOWN,%VK_RETURN,%VK_TAB
IF CBWPARAM = %VK_UP OR (CBWPARAM = %VK_TAB AND GetAsyncKeyState(%VK_SHIFT)) THEN
SetFocus GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, -1)
ELSE
SetFocus GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, 0)
END IF
EXIT FUNCTION
CASE %VK_INSERT
IF NOT V_INSOVR THEN
V_INSOVR = -1
SetWindowText GetParent(CBHNDL),"OVR"
ELSEIF V_INSOVR THEN
V_INSOVR = 0
SetWindowText GetParent(CBHNDL),"INS"
END IF
END SELECT
CASE %WM_CHAR
GetWindowText CBHNDL, Txt, %MAX_PATH
sTxt = TRIM$(Txt)
IF INSTR(ValidNumKeys$,CHR$(CBWPARAM)) = 0 THEN EXIT FUNCTION
KeyState = GetAsyncKeyState(%VK_OEM_MINUS) OR GetAsyncKeyState(%VK_OEM_PLUS)
'IF INSTR("+-",CHR$(CBWPARAM)) > 0 AND KeyState <> &H8001 THEN EXIT FUNCTION
IF CBWPARAM = %VK_RETURN THEN EXIT FUNCTION
IF CBWPARAM = %VK_TAB THEN EXIT FUNCTION
IF LEN(sTxt) > 0 AND INSTR(sTxt,"-") AND CHR$(CBWPARAM) = "-" THEN EXIT FUNCTION
IF LEN(sTxt) > 0 AND INSTR(sTxt,"-") = 0 AND CHR$(CBWPARAM) = "-" THEN EXIT FUNCTION
IF INSTR(sTxt,".") > 0 AND CHR$(CBWPARAM) = "." THEN EXIT FUNCTION 'allow only one decimal point
IF CHR$(CBWPARAM) = "." AND FieldD = 0 THEN EXIT FUNCTION 'whole numbers only
IF V_INSOVR THEN
SendMessage CBHNDL, %EM_GETSEL, 0, 0 TO V_NKEYPOS& 'Used to detect when field is filled
V_NKEYPOS& = LOWRD(V_NKEYPOS&)
SendMessage CBHNDL, %EM_SETSEL,V_NKEYPOS&,V_NKEYPOS& + 1 'Selects current character
SendMessage CBHNDL, %WM_CLEAR,0,0 'If nothing to clear doesn't act
END IF
GetWindowText CBHNDL,Txt,%MAX_PATH
sTxt = TRIM$(Txt)
IF LEN(sTxt) - INSTR(-1,sTxt,".") = FieldD - 1 AND INSTR(sTxt,".") > 0 AND CBWPARAM <> 8 THEN
sTxt = sTxt + CHR$(CBWPARAM)
SetWindowText CBHNDL, BYCOPY sTxt
SetFocus GetNextDlgTabItem(GetParent(CBHNDL), CBHNDL, 0)
EXIT FUNCTION
END IF
CASE %WM_SETFOCUS
GetWindowText CBHNDL, Txt, %MAX_PATH
Txt = REMOVE$(Txt,",")
IF VAL(Txt) = 0 THEN
Txt = ""
END IF
SetWindowText CBHNDL, Txt
SendMessage CBHNDL, %EM_SETSEL, 0, -1
Value# = 0
CASE %WM_KILLFOCUS
GetWindowText CBHNDL, Txt, %MAX_PATH
sTxt = TRIM$(Txt)
IF FieldD > 0 THEN
sTxt = FORMAT$(Val(sTxt), "0,." + STRING$(FieldD,"0"))
ELSE
STxt = FORMAT$(VAL(sTxt),"0")
END IF
SetWindowText CBHNDL, BYCOPY sTxt
END SELECT
FUNCTION = CallWindowProc(OldProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION
before lunch and something I did after lunch must have messed it up.
Bob Mechler
Comment