Post by coda on Nov 20, 2023 0:12:01 GMT -5
I need to unpick and learn some of the techniques from the article by Dennis McKinney in issue #86 of the very excellent LB Newsletter. Unfortunately, I have thus far been too busy trying to get the program to compile to learn anything from it.
I think some of the problems lie with changes to LB since the code was written but some of the errors seem mysterious.
Could someone please help me restore this sample program to working order in modern LB so that both myself and others may benefit from the knowledge locked therein?
Here is what I have so far attempted to do to get it working… some of it may not be correct.
1) The first error is that the programmer has used a Windows constant that does not appear to be known to LB. A quick search of the program text reveals that the author has failed to both a) assign a value for said constant and b) declare it as Global for use in his subs/functions. An internet search seemed to indicate that the value he should have assigned was -6, please correct this if I am wrong.
One needs to add a line like this at the start:
and thus, the reference to this value needs likewise to be changed to read:
instead of
(LB does not allow underscores in variable names). This code could never, therefore, have been compilable unless LB used to recognise _GWW_HINSTANCE as a known Windows constant but now does not for some bizarre reason.
As a side note, I am not sure why the author is bitwise ORing the value with 0. Correct me if I am wrong but this will have no effect other than to waste processor time. That said, I notice, however, that performing a bitwise OR operation on a negative number in LB DOES have an effect. For example, for ‘-1 OR 0’, LB returns 4294967295, which looks suspiciously like the 32-bit binary representation for -1 if it were interpreted instead as an unsigned integer… not, per se, the result of bitwise ORing it with 0 which should create no change.
ie. 1 = 00000000000000000000000000000001
1’s compliment = 11111111111111111111111111111110
2’s compliment = 11111111111111111111111111111111
If we interpret this last number as a signed integer, we get -1 as you would expect,
If we interpret it as a an unsigned integer, we get 4294967295 just like LB.
If we bitwise OR 00000000000000000000000000000000 with 11111111111111111111111111111111 we get 11111111111111111111111111111111 which is still -1 not 4294967295 unless we suddenly conclude we are dealing with an unsigned number when we were not before.
I have no doubt I am probably missing something but I am neither sure why LB returns the result of ‘-1 OR 0’ as an unsigned integer nor am I sure why the author of the program ORs the value with 0. Is it to convert between a signed and unsigned interpretation of the same bit pattern? But why would one do that when the API call takes a short integer and not an unsigned short integer??
2) Subsequently, there is a problem with the following continued line in the ‘createctl’ function:
I’m going to assume this is because LB has no dword data-type. Did it ever in the past? If not then this is a typo that would also always have prevented this file from ‘compiling’. I assume the correct syntax would be and should be corrected to:
3) Next error: This time the program crashes due to a module not found error. A bit of prodding around reveals that the following two lines are the cause:
I think this syntax used to be allowable (not sure) but there are 3 errors here, for modern LB not just one. While it is true that these dlls are no longer required to be opened by LB, opening them is still perfectly allowable.
For modern LB, the first line should read:
The second line should read:
Another way to correct this problem would be to comment out the above lines and also the following lines:
and use ‘find and replace’ to replace all instances of #user with #user32 and all instances of #gdi with #gdi32. I opted for the former.
4) Yet another error: This time a dll call error which requires me to fish around in the esoteric realm of the error log which is really more a place for Carl. It appears to have something to do with a call to ‘CreateWindow’ and it might be complaining that it wants to receive a short integer by way of return but can’t or that it doesn’t want to but that that is what it’s been asked to do… or maybe not… That’s my best guess. This unfortunately is where my ability to even attempt to fix the problems ends.
Help would be GREATLY appreciated.
I have posted the program TWICE below. The first is the original program from the newsletter, the second version is with my attempted corrections:
The published version:
The version with my alterations:
I think some of the problems lie with changes to LB since the code was written but some of the errors seem mysterious.
Could someone please help me restore this sample program to working order in modern LB so that both myself and others may benefit from the knowledge locked therein?
Here is what I have so far attempted to do to get it working… some of it may not be correct.
1) The first error is that the programmer has used a Windows constant that does not appear to be known to LB. A quick search of the program text reveals that the author has failed to both a) assign a value for said constant and b) declare it as Global for use in his subs/functions. An internet search seemed to indicate that the value he should have assigned was -6, please correct this if I am wrong.
One needs to add a line like this at the start:
Global GGW.HINSTANCE:GWW.HINSTANCE = -6and thus, the reference to this value needs likewise to be changed to read:
type = GWW.HINSTANCE or 0instead of
type = _GWW_HINSTANCE or 0(LB does not allow underscores in variable names). This code could never, therefore, have been compilable unless LB used to recognise _GWW_HINSTANCE as a known Windows constant but now does not for some bizarre reason.
As a side note, I am not sure why the author is bitwise ORing the value with 0. Correct me if I am wrong but this will have no effect other than to waste processor time. That said, I notice, however, that performing a bitwise OR operation on a negative number in LB DOES have an effect. For example, for ‘-1 OR 0’, LB returns 4294967295, which looks suspiciously like the 32-bit binary representation for -1 if it were interpreted instead as an unsigned integer… not, per se, the result of bitwise ORing it with 0 which should create no change.
ie. 1 = 00000000000000000000000000000001
1’s compliment = 11111111111111111111111111111110
2’s compliment = 11111111111111111111111111111111
If we interpret this last number as a signed integer, we get -1 as you would expect,
If we interpret it as a an unsigned integer, we get 4294967295 just like LB.
If we bitwise OR 00000000000000000000000000000000 with 11111111111111111111111111111111 we get 11111111111111111111111111111111 which is still -1 not 4294967295 unless we suddenly conclude we are dealing with an unsigned number when we were not before.
I have no doubt I am probably missing something but I am neither sure why LB returns the result of ‘-1 OR 0’ as an unsigned integer nor am I sure why the author of the program ORs the value with 0. Is it to convert between a signed and unsigned interpretation of the same bit pattern? But why would one do that when the API call takes a short integer and not an unsigned short integer??
2) Subsequently, there is a problem with the following continued line in the ‘createctl’ function:
style as dword,_I’m going to assume this is because LB has no dword data-type. Did it ever in the past? If not then this is a typo that would also always have prevented this file from ‘compiling’. I assume the correct syntax would be and should be corrected to:
style as word,_3) Next error: This time the program crashes due to a module not found error. A bit of prodding around reveals that the following two lines are the cause:
Open "user.dll" for dll as #user
open "gdi" for dll as #gdiI think this syntax used to be allowable (not sure) but there are 3 errors here, for modern LB not just one. While it is true that these dlls are no longer required to be opened by LB, opening them is still perfectly allowable.
For modern LB, the first line should read:
Open "user32.dll" for dll as #userThe second line should read:
Open "gdi32.dll" for dll as #gdiAnother way to correct this problem would be to comment out the above lines and also the following lines:
close #user
close #gdiand use ‘find and replace’ to replace all instances of #user with #user32 and all instances of #gdi with #gdi32. I opted for the former.
4) Yet another error: This time a dll call error which requires me to fish around in the esoteric realm of the error log which is really more a place for Carl. It appears to have something to do with a call to ‘CreateWindow’ and it might be complaining that it wants to receive a short integer by way of return but can’t or that it doesn’t want to but that that is what it’s been asked to do… or maybe not… That’s my best guess. This unfortunately is where my ability to even attempt to fix the problems ends.
Help would be GREATLY appreciated.
I have posted the program TWICE below. The first is the original program from the newsletter, the second version is with my attempted corrections:
The published version:
'Key portions of this code were written and posted by other members
'of the LB News group.
'Many thanks to all of you for making your knowledge and experience
'available for everyone's education.
'My contribution is mainly just stitching it all together and
'adding some useful functions and sub routines.
'A how-to demo for window-type windows:
'(or using the knowledge available from the LB News group)
'Tab to the next control.
'Define your own tab order for controls.
'Run a branch, sub, or function for a button if
'the enter key is pressed while that button has the focus.
'Use mouse and keyboard events for controls created with API.
'Know when left or right mouse button is down.
'Determine when left or right mouse clicks occur.
'Detect which control is clicked with the mouse.
'Know when the mouse pointer is moving.
'Detect when controls get or lose the focus.
'Detect key presses for any control.
'Remove tabs or carriage returns when entered into textboxes.
'Set the cursor at the end of text in a textbox when it gets the focus.
'Auto drop combobox lists.
'Use different branches, subs, functions for left click, right click,
'and return key press.
'Make global variables visible inside subs and functions.
NoMainWin
'use arrays as global variables when they need to be
'visible inside subs & functions
Dim hwndLast(1) 'for global control focus tracking
Dim staticVar(1) 'simulated static variable for Function FocusChanged() & [UpdateFocus] only
Ub(1) = 12 'global upperbound for Controls arrays
buffer$ = space$(256) + chr$(0) 'used in API calls
True = 1
False = 0
lBtnClick = False ''left mouse button clicked
rBtnClick = False 'right mouse button clicked
lBtnDown = False 'left mouse button down
rBtnDown = False 'right mouse button down
STRUCT point,_
x as short,_
y as short
STRUCT Rect,_
left as short,_
top as short,_
right as short,_
bottom as short
Dim CtlCoord(Ub(1),4) 'for storing control coordinates
'left, top, right, bottom.
'used for detecting when the mouse
'is over a particular control
Dim cbo1$(9) 'nonsense arrays for list and combo boxes
cbo1$(1) = "a"
cbo1$(2) = "b"
cbo1$(3) = "c"
cbo1$(4) = "d"
cbo1$(5) = "e"
cbo1$(6) = "f"
cbo1$(7) = "g"
cbo1$(8) = "h"
cbo1$(9) = "i"
Dim lst1$(9)
lst1$(1) = "1"
lst1$(2) = "2"
lst1$(3) = "3"
lst1$(4) = "4"
lst1$(5) = "5"
lst1$(6) = "6"
lst1$(7) = "7"
lst1$(8) = "8"
lst1$(9) = "9"
WindowWidth = 586
WindowHeight = 480
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
groupbox #form1, "GroupBox 1", 18, 150, 162, 120
textbox #form1.TextBox1, 18, 60, 228, 24
textbox #form1.TextBox2, 18, 90, 228, 24
radiobutton #form1.RadioButton1, "RadioButton1", [form1.RadioButton1.Set], [form1.RadioButton1.Reset], 30, 186, 114, 30
radiobutton #form1.RadioButton2, "RadioButton2", [form1.RadioButton2.Set], [form1.RadioButton2.Reset], 30, 222, 108, 30
checkbox #form1.CheckBox1, "CheckBox1", [form1.CheckBox1.Set], [form1.CheckBox1.Reset], 222, 156, 108, 30
checkbox #form1.CheckBox2, "CheckBox2", [form1.CheckBox2.Set], [form1.CheckBox2.Reset], 222, 198, 102, 30
listbox #form1.ListBox1, lst1$(, [form1.ListBox1.DoubleClick],426, 18, 138, 114
combobox #form1.ComboBox1, cbo1$(, [form1.ComboBox1.Click],264, 18, 144, 144
button #form1.Button1, "Button1", [form1.Button1.Click], UL, 18, 18, 102, 30
button #form1.Button2, "Button2", [form1.Button2.Click], UL, 132, 18, 114, 30
texteditor #form1.TextEditor1, 366, 150, 200, 132
statictext #form1.static1, "", 18, 320, 328, 24
statictext #form1.static2, "", 18, 350, 328, 24
statictext #form1.static3, "", 18, 380, 328, 24
statictext #form1.static4, "", 18, 410, 328, 24
Open "Control and Mouse Events for Window Controls" for Window as #form1
Print #form1, "trapclose [Quit]"
Print #form1.TextBox1, "!font MS_Sans_Serif 10"
Print #form1.TextBox2, "!font MS_Sans_Serif 10"
Print #form1.RadioButton1, "font MS_Sans_Serif 10"
Print #form1.RadioButton2, "font MS_Sans_Serif 10"
Print #form1.CheckBox1, "font MS_Sans_Serif 10"
Print #form1.CheckBox2, "font MS_Sans_Serif 10"
Print #form1.ListBox1, "font MS_Sans_Serif 10"
Print #form1.ComboBox1, "font MS_Sans_Serif 10"
Print #form1.Button1, "!font MS_Sans_Serif 10"
Print #form1.Button2, "!font MS_Sans_Serif 10"
Print #form1.static1, "!font MS_Sans_Serif 10"
Open "user.dll" for dll as #user
open "gdi" for dll as #gdi
hParent = hwnd(#form1)
pInst = GetParentInstance(hParent)
'create a push button by API
'define the style, type, and button text
style=_WS_CHILDWINDOW OR _WS_VISIBLE OR _BS_PUSHBUTTON
type$ = "BUTTON" + chr$(0)
caption$ = "API Button" + chr$(0)
'create the button
hPB3 = CreateCtl(type$,caption$,style,464,310,102,30,hParent,pInst)
'create the font for the button and assign it to the button.
'this is optional
ApiCtlFont = CreateCtlFont("MS Sans Serif",10,_FW_MEDIUM,0,1)
ret = SetFont(hPB3,ApiCtlFont)
'define the tab order for the controls.
'this array is also used for the focus events,
'running sub routines, and mouse events.
Dim Controls(Ub(1))
Controls(1) = hwnd(#form1.Button1)
Controls(2) = hwnd(#form1.Button2)
Controls(3) = hwnd(#form1.TextBox1)
Controls(4) = hwnd(#form1.TextBox2)
Controls(5) = hwnd(#form1.RadioButton1)
Controls(6) = hwnd(#form1.RadioButton2)
Controls(7) = hwnd(#form1.CheckBox1)
Controls(8) = hwnd(#form1.CheckBox2)
'Comboboxes return a different handle with Getfocus API.
print #form1.ComboBox1, "setfocus"
calldll #user, "GetFocus" , AltCbo1Hwnd AS short
Controls(9) = AltCbo1Hwnd
Controls(10) = hwnd(#form1.ListBox1)
Controls(11) = hwnd(#form1.TextEditor1)
Controls(12) = hPB3
cbo1Hwnd = hwnd(#form1.ComboBox1) 'still need for other calls
'define the branches to execute when return key pressed or
'a mouse button is clicked.
'either left or right click can be detected to add functionality
'to any almost control.
'match the indexes to the control hwnd's in the Controls() array.
Dim CtlBr$(Ub(1))
CtlBr$(1) = "[form1.Button1.Click]"
CtlBr$(2) = "[form1.Button2.Click]"
CtlBr$(3) = "" 'no branch
CtlBr$(4) = ""
CtlBr$(5) = "[form1.RadioButton1.Set]"
CtlBr$(6) = "[form1.RadioButton2.Set]"
CtlBr$(7) = "[form1.CheckBox1.Toggle]"
CtlBr$(8) = "[form1.CheckBox2.Toggle]"
CtlBr$(9) = ""
CtlBr$(10) = "[form1.ListBox1.Keypress]"
CtlBr$(11) = ""
CtlBr$(12) = "[form1.ApiButton.Click]"
'initialize hwndLast(1) & set focus there
hwndLast(1) = hwnd(#form1.Button1)
'this only works at this point if there isn't an LB text editor in the window
ret = SetFocusTo(hwndLast(1))
'store the left, top, right, and bottom coordinates
'for all controls in the window.
Gosub [InitCtlCoords]
[Main.Loop]
scan
Goto [ProcessMouse]
[PmReturn]
Goto [ProcessKeys]
GoTo [Main.Loop]
[Quit]
If ApiCtlFont <> 0 Then
calldll #gdi, "DeleteObject", ApiCtlFont as word, ret as short
End If
close #user
close #gdi
close #form1 : End
'**************************************
[ProcessKeys]
'If focus has moved to another control, handle 'lost focus' events
'for the previous control, handle any 'on focus' events
'you want to do for the newly focused control.
If FocusChanged() = True Then
Gosub [UpdateFocus]
'do clean up for previous Edit control
'Edit controls on this window are TextBoxes and the ComboBox.
If ClassOfCtl$(hwndLast(1)) = "Edit" Then
numChars = GetTextLen(hwndLast(1))
strTmp$ = GetText$(hwndLast(1),numChars)
'strip out tab character from text
strTmp$ = StripChr$(strTmp$, chr$(9))
'strip out carriage return & linefeed characters from text
strTmp$ = StripChr$(strTmp$, chr$(13))
strTmp$ = StripChr$(strTmp$, chr$(10))
ret = SetText(strTmp$, hwndLast(1))
End If
'this next line directs all further processing to the newly focused control
hwndLast(1) = FocusedCtl()
If ClassOfCtl$(FocusedCtl()) = "Edit" Then
txtLen = GetTextLen(FocusedCtl())
ret = CursorToEnd(hwndLast(1),txtLen)
End If
'auto drop combo if text is already entered
ret = DropCbo(cbo1Hwnd,AltCbo1Hwnd)
End If
'Process key presses.
calldll #user, "GetKeyboardState", buffer$ as ptr, ret as void
'handle text key presses
For Ascii = 33 to 127 'space to Z // ascii code + 1
Chk$ = mid$(buffer$,Ascii,1)
If asc(Chk$) > 127 Then
ret = DropCbo(cbo1Hwnd,AltCbo1Hwnd)
Ascii = 127
End If
Next Ascii
'handle return key press
cr$ = mid$(buffer$,14,1)
If asc(cr$) > 127 Then
[RescanCr]
'wait for return key to be released
calldLL #user, "GetAsyncKeyState",_VK_RETURN AS short, Keystate AS short
If Keystate < 0 Then [RescanCr] 'negative value when key is down
'Don't allow Return key to enter Cr Lf into textboxes
If ClassOfCtl$(FocusedCtl()) = "Edit" Then
'strip out carriage return & linefeed characters from text
numChars = GetTextLen(hwndLast(1))
strTmp$ = GetText$(FocusedCtl(),numChars)
strTmp$ = StripChr$(strTmp$, chr$(13))
strTmp$ = StripChr$(strTmp$, chr$(10))
ret = SetText(strTmp$, FocusedCtl())
txtLen = GetTextLen(FocusedCtl())
'move cursor to end of text
ret = CursorToEnd(hwndLast(1),txtLen)
End if
txtBr$ = GetBranch$(FocusedCtl())
If txtBr$ <> "" Then [RunBranch]
End If
'handle tab key press
'go to next control in tab order if Tab pressed
tab$ = mid$(buffer$,10,1)
If asc(tab$) > 127 Then
[Rescan]
'wait for tab key to be released
calldLL #user, "GetAsyncKeyState",_VK_TAB AS short, Keystate AS short
If Keystate < 0 Then [Rescan] 'negative value when key is down
'get next ctl hwnd
For j = 1 to Ub(1)
If Controls(j) = hwndLast(1) Then
x = j + 1: If x > Ub(1) Then x = 1
CurH = Controls(x)
j = Ub(1)
End If
Next j
'go to next ctl
ret = SetFocusTo(CurH)
End If
GoTo [Main.Loop]
[ProcessMouse]
'mouse clicks, pointer movement
lBtnClick = False
rBtnClick = False
'detect which button is down, if any, and button clicks.
calldLL #user, "GetAsyncKeyState",_VK_LBUTTON AS short, lbstate AS short
If lbstate >= 0 and lBtnDown = True Then
lBtnClick = True
lBtnDown = False
End If
If lbstate < 0 then lBtnDown = True
calldLL #user, "GetAsyncKeyState",_VK_RBUTTON AS short, rbstate AS short
If rbstate >= 0 and rBtnDown = True Then
rBtnClick = True
rBtnDown = False
End If
If rbstate < 0 then rBtnDown = True
If lBtnDown = True Then print #form1.static4, "Left Mouse Button Down"
If rBtnDown = True Then print #form1.static4, "Right Mouse Button Down"
If lBtnDown = False and rBtnDown = False Then print #form1.static4, ""
'get the mouse pointer position on the screen
calldll #user, "GetCursorPos", _
point as struct,_
result as void
'convert it to the position in the window
calldll #user, "ScreenToClient",_
hParent as word,_
point as struct,_
r as void
mouseX = point.x.struct
mouseY = point.y.struct
'detect if the mouse pointer is moving
If prevMouseX <> mouseX or prevMouseY <> mouseY Then
mouseMove = True
prevMouseX = mouseX
prevMouseY = mouseY
print #form1.static1, ""
print #form1.static3, ""
Else
mouseMove = False
End If
print #form1.static2, "MouseX = " + str$(mouseX) + " MouseY = " + str$(mouseY) + " Moving = " + str$(mouseMove)
'determine which control the mouse pointer is over.
MouseOver = 0 'reset
For mOver = 1 to Ub(1)
If mouseX > CtlCoord(mOver,1) And mouseX < CtlCoord(mOver,3) _
And mouseY > CtlCoord(mOver,2) And mouseY < CtlCoord(mOver,4) Then
MouseOver = Controls(mOver) 'control handle
mOver = Ub(1) 'exit
End If
Next mOver
'if the mouse pointer is over a control
'and the right button has been clicked, execute your code.
If rBtnClick = True and MouseOver <> 0 Then
txtBr$ = GetBranch$(MouseOver)
print #form1.static3, "Right Button Clicked. Mouse is Over hwnd " + str$(MouseOver)
If txtBr$ <> "" Then [RunRightClickBranch]
End If
'if the mouse pointer is over a control
'and the left button has been clicked, execute your code.
If lBtnClick = True and MouseOver <> 0 Then
txtBr$ = GetBranch$(MouseOver)
print #form1.static3, "Left Button Clicked. Mouse is Over hwnd " + str$(MouseOver)
If txtBr$ <> "" Then [RunLeftClickBranch]
End If
GoTo [PmReturn]
[GetWindowRect]
calldll #user,"GetWindowRect",_
hCtlRect as short,_ 'handle of control
Rect as struct,_
ret as void
Return
[InitCtlCoords]
'automatically fill the CtlCoord() array with the
'corner positions of all controls in the window
For ii = 1 to Ub(1)
'hwnd of control
hCtlRect = Controls(ii)
'fill Rect structure with screen coordinates of control
Gosub [GetWindowRect]
'assign left & top coords to point structure
point.x.struct = Rect.left.struct
point.y.struct = Rect.top.struct
'convert coords to client coords
calldll #user, "ScreenToClient",_
hParent as short, point as struct, ret as void
CtlCoord(ii,1)= point.x.struct
CtlCoord(ii,2)= point.y.struct
'do the same for right & bottom coords
point.x.struct = Rect.right.struct
point.y.struct = Rect.bottom.struct
calldll #user, "ScreenToClient",_
hParent as short, point as struct, ret as void
CtlCoord(ii,3)= point.x.struct
CtlCoord(ii,4)= point.y.struct
Next ii
Return
[RunLeftClickBranch]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.Click]
GoTo [Main.Loop]
[RunRightClickBranch]
If txtBr$ = "[form1.Button1.Click]" Then [form1.Button1.Click]
If txtBr$ = "[form1.Button2.Click]" Then [form1.Button2.Click]
If txtBr$ = "[form1.RadioButton1.Set]" Then [form1.RadioButton1.Toggle]
If txtBr$ = "[form1.RadioButton2.Set]" Then [form1.RadioButton2.Toggle]
If txtBr$ = "[form1.CheckBox1.Toggle]" Then [form1.CheckBox1.Toggle]
If txtBr$ = "[form1.CheckBox2.Toggle]" Then [form1.CheckBox2.Toggle]
If txtBr$ = "[form1.ListBox1.Keypress]" Then [form1.ListBox1.Keypress]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.RightClick]
GoTo [Main.Loop]
[RunBranch]
If txtBr$ = "[form1.Button1.Click]" Then [form1.Button1.Click]
If txtBr$ = "[form1.Button2.Click]" Then [form1.Button2.Click]
If txtBr$ = "[form1.RadioButton1.Set]" Then [form1.RadioButton1.Toggle]
If txtBr$ = "[form1.RadioButton2.Set]" Then [form1.RadioButton2.Toggle]
If txtBr$ = "[form1.CheckBox1.Toggle]" Then [form1.CheckBox1.Toggle]
If txtBr$ = "[form1.CheckBox2.Toggle]" Then [form1.CheckBox2.Toggle]
If txtBr$ = "[form1.ListBox1.Keypress]" Then [form1.ListBox1.Keypress]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.Enter]
GoTo [Main.Loop]
Function CreateCtlFont(fntName$,fntHeight,weight,italic,underline)
'In: font name, font height
'Out handle to the font
fntName$ = fntName$ + chr$(0)
Calldll #gdi, "CreateFont", fntHeight as word,_
0 as word, 0 as word, 0 as word,_
weight as word,_ 'usually _FW_MEDIUM or _FW_BOLD
italic as word,_ '1 = italic, 0 otherwise
underline as word,_ '1 = underline, 0 otherwise
0 as word, 0 as word, 0 as word, _
0 as word, 0 as word, 0 as word,_
fntName$ as PTR, hF as word
CreateCtlFont = hF
End Function
Function SetFont(hCtl,hFont)
'In: handle of control to set font for, handle of created font
'Out: nothing
calldll #user, "SendMessage", _
hCtl as word, _ 'handle of control
_WM_SETFONT as word,_ 'message
hFont as word, _ 'new font
1 as long,_ 'repaint=1, no repaint=0
ret as long 'not used
SetFont = 0
End Function
Function GetParentInstance(hWin)
'In: handle to parent window
'Out: instance handle of parent window
type = _GWW_HINSTANCE or 0
calldll #user, "GetWindowWord",_
hWin as word,_
type as short,_
inst as word
GetParentInstance = inst
End Function
Function CreateCtl(class$,caption$,style,left,top,width,height,hParent,pHinst)
'In: everything
'Out: handle to newly created control
calldll #user, "CreateWindow",_
class$ as ptr,_ 'class name
caption$ as ptr,_
style as dword,_ 'style(s) OR together
left as short,_
top as short,_
width as short,_ 'width
height as short,_ 'height
hParent as short,_ 'parent window
0 as short,_ 'handle to menu = 0 for class menu
pHinst as short,_ 'instance of parent window
"" as ptr,_
hnd as short
CreateCtl = hnd 'return handle of control
End Function
Function GetBranch$(hCtl)
'In: control hwnd
'Out: branch name from CtlBr$ array
For i = 1 to Ub(1)
If Controls(i) = hCtl Then
txtBr$ = CtlBr$(i)
i = Ub(1)
End If
Next i
GetBranch$ = txtBr$
End Function
Function DropCbo(hCbo,hCboAlt)
'In: both hwnds for a combobox
'Out: nothing
If FocusedCtl() = hCboAlt Then
If GetTextLen(hCbo) > 0 Then
calldll #user, "SendMessage", hCbo as word,_
_CB_SHOWDROPDOWN as word, 1 as word, 0 as long, ret as long
End If
End If
DropCbo = 0
End Function
Function StripChr$(Txt$, spec$)
'In: string to work with, character to remove
'Out: Txt$ without any spec$ characters in it
txtLen = len(Txt$)
For i = 1 to txtLen
char$ = mid$(Txt$,i,1)
If char$ <> spec$ Then
StripChr$ = StripChr$ + char$
End If
Next i
End Function
Function FocusChanged()
'In: nothing
'Out: True if focus is changed
If FocusedCtl() <> staticFoc(1) Then
FocusChanged = 1 'return True
End If
End Function
Function CursorToEnd(hEdit,txtLen)
'In: hwnd of edit control
'position the cursor to the end of text
'Out: nothing
lngTL = txtLen + txtLen * 65536 'convert to long integer.
calldll#user, "SendMessage",_
hEdit AS short,_
_EM_SETSEL AS short,_
0 AS short,_
lngTL AS long,_
ret AS void
CursorToEnd = 0
End Function
Function GetText$(hEdit,numChars)
'In: hwnd of Edit control or window
'Out: the control text or window caption
'numChars = GetTextLen(hEdit)
entry$ = space$(numChars) + Chr$(0)
lenEntry = Len(entry$)
calldll #user, "GetWindowText", _
hEdit as word, _
entry$ as ptr, _
lenEntry as short,_
ret as short
GetText$ = entry$
End Function
Function GetTextLen(hEdit)
'In: hwnd of Edit control or window
'Out: the length of control text or window caption
calldll #user, "GetWindowTextLength",_
hEdit as short,_
ret as short
GetTextLen = ret
End Function
Function SetText(txt$, hEdit)
'In: text to place into Edit control or window caption,
'hwnd of Edit Control or window
'Out: nothing
calldll #user, "SetWindowText", _
hEdit as word, _
txt$ as ptr, _
ret as void
SetText = 0
End Function
Function FocusedCtl()
'In: nothing
'Out: hwnd of control with the focus
calldll #user, "GetFocus" , FocusedCtl AS short
End Function
Function ClassOfCtl$(CtlHwnd)
'In: handle to control or window
'Out: class name of control or window
class$ = space$(255) + chr$(0)
length = len(class$)
calldll #user, "GetClassName",_
CtlHwnd AS word,_
class$ AS ptr,_
length AS word,_
returnLength AS word
ClassOfCtl$ = left$(class$, returnLength)
End Function
Function SetFocusTo(handle)
'In: hwnd of control or window to focus
'Out: nothing
calldll #user, "SetFocus",_
handle as word,_
ret as short
SetFocusTo = 0
End Function
[UpdateFocus]
calldll #user, "GetFocus" , sfoc AS short
staticFoc(1) = sfoc
Return
[form1.Button1.Click]
print #form1.static1, "Button 1 clicked"
GoTo [Main.Loop]
[form1.Button2.Click]
print #form1.static1, "Button 2 clicked"
GoTo [Main.Loop]
[form1.CheckBox1.Reset]
print #form1.static1, "Checkbox 1 Reset"
GoTo [Main.Loop]
[form1.CheckBox1.Set]
print #form1.static1, "Checkbox 1 Set"
GoTo [Main.Loop]
[form1.CheckBox2.Reset]
print #form1.static1, "Checkbox 2 Reset"
GoTo [Main.Loop]
[form1.CheckBox2.Set]
print #form1.static1, "Checkbox 2 Set"
GoTo [Main.Loop]
[form1.ComboBox1.Click]
GoTo [Main.Loop]
[form1.ListBox1.DoubleClick]
print #form1.static1, "Listbox Double Click Selection"
GoTo [Main.Loop]
[form1.RadioButton1.Reset]
GoTo [Main.Loop]
[form1.RadioButton1.Set]
print #form1.static1, "RadioButton 1 Set"
GoTo [Main.Loop]
[form1.RadioButton2.Reset]
GoTo [Main.Loop]
[form1.RadioButton2.Set]
print #form1.static1, "RadioButton 2 Set"
GoTo [Main.Loop]
[form1.CheckBox1.Toggle]
print #form1.CheckBox1, "value? result$"
If result$ = "set" Then
print #form1.CheckBox1, "reset"
print #form1.static1, "Checkbox 1 Reset by other means"
End If
If result$ = "reset" Then
print #form1.CheckBox1, "set"
print #form1.static1, "Checkbox 1 Set by other means"
End If
GoTo [Main.Loop]
[form1.CheckBox2.Toggle]
print #form1.CheckBox2, "value? result$"
If result$ = "set" Then
print #form1.CheckBox2, "reset"
print #form1.static1, "Checkbox 2 Reset by other means"
End If
If result$ = "reset" Then
print #form1.CheckBox2, "set"
print #form1.static1, "Checkbox 2 Set by other means"
End If
GoTo [Main.Loop]
[form1.RadioButton1.Toggle]
print #form1.RadioButton1, "value? result$"
If result$ = "reset" Then
print #form1.RadioButton1, "set"
print #form1.RadioButton2, "reset"
print #form1.static1, "RadioButton 1 Set by other means"
End If
GoTo [Main.Loop]
[form1.RadioButton2.Toggle]
print #form1.RadioButton2, "value? result$"
If result$ = "reset" Then
print #form1.RadioButton2, "set"
print #form1.RadioButton1, "reset"
print #form1.static1, "RadioButton 2 Set by other means"
End If
GoTo [Main.Loop]
[form1.ListBox1.Keypress]
print #form1.ListBox1, "selection? selected$"
If selected$ = "" Then
notice "No item is selected"
Else
print #form1.static1, "'" + selected$ + " selected by other means"
End IF
GoTo [Main.Loop]
[form1.ApiButton.Click]
print #form1.static1, "API button left clicked"
GoTo [Main.Loop]
[form1.ApiButton.RightClick]
print #form1.static1, "API button right clicked"
GoTo [Main.Loop]
[form1.ApiButton.Enter]
print #form1.static1, "API button pressed by Return key"
GoTo [Main.Loop]
[Misc.Info]
'font weight values
'_FW_DONTCARE 0
'_FW_THIN 100
'_FW_EXTRALIGHT 200
'_FW_ULTRALIGHT 200
'_FW_LIGHT 300
'_FW_NORMAL 400
'_FW_REGULAR 400
'_FW_MEDIUM 500
'_FW_SEMIBOLD 600
'_FW_DEMIBOLD 600
'_FW_BOLD 700
'_FW_EXTRABOLD 800
'_FW_ULTRABOLD 800
'_FW_BLACK 900
'_FW_HEAVY 900
The version with my alterations:
'Key portions of this code were written and posted by other members
'of the LB News group.
'Many thanks to all of you for making your knowledge and experience
'available for everyone's education.
'My contribution is mainly just stitching it all together and
'adding some useful functions and sub routines.
'A how-to demo for window-type windows:
'(or using the knowledge available from the LB News group)
'Tab to the next control.
'Define your own tab order for controls.
'Run a branch, sub, or function for a button if
'the enter key is pressed while that button has the focus.
'Use mouse and keyboard events for controls created with API.
'Know when left or right mouse button is down.
'Determine when left or right mouse clicks occur.
'Detect which control is clicked with the mouse.
'Know when the mouse pointer is moving.
'Detect when controls get or lose the focus.
'Detect key presses for any control.
'Remove tabs or carriage returns when entered into textboxes.
'Set the cursor at the end of text in a textbox when it gets the focus.
'Auto drop combobox lists.
'Use different branches, subs, functions for left click, right click,
'and return key press.
'Make global variables visible inside subs and functions.
NoMainWin
Global GGW.HINSTANCE:GWW.HINSTANCE = -6
'use arrays as global variables when they need to be
'visible inside subs & functions
Dim hwndLast(1) 'for global control focus tracking
Dim staticVar(1) 'simulated static variable for Function FocusChanged() & [UpdateFocus] only
Ub(1) = 12 'global upperbound for Controls arrays
buffer$ = space$(256) + chr$(0) 'used in API calls
True = 1
False = 0
lBtnClick = False ''left mouse button clicked
rBtnClick = False 'right mouse button clicked
lBtnDown = False 'left mouse button down
rBtnDown = False 'right mouse button down
STRUCT point,_
x as short,_
y as short
STRUCT Rect,_
left as short,_
top as short,_
right as short,_
bottom as short
Dim CtlCoord(Ub(1),4) 'for storing control coordinates
'left, top, right, bottom.
'used for detecting when the mouse
'is over a particular control
Dim cbo1$(9) 'nonsense arrays for list and combo boxes
cbo1$(1) = "a"
cbo1$(2) = "b"
cbo1$(3) = "c"
cbo1$(4) = "d"
cbo1$(5) = "e"
cbo1$(6) = "f"
cbo1$(7) = "g"
cbo1$(8) = "h"
cbo1$(9) = "i"
Dim lst1$(9)
lst1$(1) = "1"
lst1$(2) = "2"
lst1$(3) = "3"
lst1$(4) = "4"
lst1$(5) = "5"
lst1$(6) = "6"
lst1$(7) = "7"
lst1$(8) = "8"
lst1$(9) = "9"
WindowWidth = 586
WindowHeight = 480
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
groupbox #form1, "GroupBox 1", 18, 150, 162, 120
textbox #form1.TextBox1, 18, 60, 228, 24
textbox #form1.TextBox2, 18, 90, 228, 24
radiobutton #form1.RadioButton1, "RadioButton1", [form1.RadioButton1.Set], [form1.RadioButton1.Reset], 30, 186, 114, 30
radiobutton #form1.RadioButton2, "RadioButton2", [form1.RadioButton2.Set], [form1.RadioButton2.Reset], 30, 222, 108, 30
checkbox #form1.CheckBox1, "CheckBox1", [form1.CheckBox1.Set], [form1.CheckBox1.Reset], 222, 156, 108, 30
checkbox #form1.CheckBox2, "CheckBox2", [form1.CheckBox2.Set], [form1.CheckBox2.Reset], 222, 198, 102, 30
listbox #form1.ListBox1, lst1$(, [form1.ListBox1.DoubleClick],426, 18, 138, 114
combobox #form1.ComboBox1, cbo1$(, [form1.ComboBox1.Click],264, 18, 144, 144
button #form1.Button1, "Button1", [form1.Button1.Click], UL, 18, 18, 102, 30
button #form1.Button2, "Button2", [form1.Button2.Click], UL, 132, 18, 114, 30
texteditor #form1.TextEditor1, 366, 150, 200, 132
statictext #form1.static1, "", 18, 320, 328, 24
statictext #form1.static2, "", 18, 350, 328, 24
statictext #form1.static3, "", 18, 380, 328, 24
statictext #form1.static4, "", 18, 410, 328, 24
Open "Control and Mouse Events for Window Controls" for Window as #form1
Print #form1, "trapclose [Quit]"
Print #form1.TextBox1, "!font MS_Sans_Serif 10"
Print #form1.TextBox2, "!font MS_Sans_Serif 10"
Print #form1.RadioButton1, "font MS_Sans_Serif 10"
Print #form1.RadioButton2, "font MS_Sans_Serif 10"
Print #form1.CheckBox1, "font MS_Sans_Serif 10"
Print #form1.CheckBox2, "font MS_Sans_Serif 10"
Print #form1.ListBox1, "font MS_Sans_Serif 10"
Print #form1.ComboBox1, "font MS_Sans_Serif 10"
Print #form1.Button1, "!font MS_Sans_Serif 10"
Print #form1.Button2, "!font MS_Sans_Serif 10"
Print #form1.static1, "!font MS_Sans_Serif 10"
Open "user32.dll" for dll as #user
open "gdi32.dll" for dll as #gdi
hParent = hwnd(#form1)
pInst = GetParentInstance(hParent)
'create a push button by API
'define the style, type, and button text
style=_WS_CHILDWINDOW OR _WS_VISIBLE OR _BS_PUSHBUTTON
type$ = "BUTTON" + chr$(0)
caption$ = "API Button" + chr$(0)
'create the button
hPB3 = CreateCtl(type$,caption$,style,464,310,102,30,hParent,pInst)
'create the font for the button and assign it to the button.
'this is optional
ApiCtlFont = CreateCtlFont("MS Sans Serif",10,_FW_MEDIUM,0,1)
ret = SetFont(hPB3,ApiCtlFont)
'define the tab order for the controls.
'this array is also used for the focus events,
'running sub routines, and mouse events.
Dim Controls(Ub(1))
Controls(1) = hwnd(#form1.Button1)
Controls(2) = hwnd(#form1.Button2)
Controls(3) = hwnd(#form1.TextBox1)
Controls(4) = hwnd(#form1.TextBox2)
Controls(5) = hwnd(#form1.RadioButton1)
Controls(6) = hwnd(#form1.RadioButton2)
Controls(7) = hwnd(#form1.CheckBox1)
Controls(8) = hwnd(#form1.CheckBox2)
'Comboboxes return a different handle with Getfocus API.
print #form1.ComboBox1, "setfocus"
calldll #user, "GetFocus" , AltCbo1Hwnd AS short
Controls(9) = AltCbo1Hwnd
Controls(10) = hwnd(#form1.ListBox1)
Controls(11) = hwnd(#form1.TextEditor1)
Controls(12) = hPB3
cbo1Hwnd = hwnd(#form1.ComboBox1) 'still need for other calls
'define the branches to execute when return key pressed or
'a mouse button is clicked.
'either left or right click can be detected to add functionality
'to any almost control.
'match the indexes to the control hwnd's in the Controls() array.
Dim CtlBr$(Ub(1))
CtlBr$(1) = "[form1.Button1.Click]"
CtlBr$(2) = "[form1.Button2.Click]"
CtlBr$(3) = "" 'no branch
CtlBr$(4) = ""
CtlBr$(5) = "[form1.RadioButton1.Set]"
CtlBr$(6) = "[form1.RadioButton2.Set]"
CtlBr$(7) = "[form1.CheckBox1.Toggle]"
CtlBr$(8) = "[form1.CheckBox2.Toggle]"
CtlBr$(9) = ""
CtlBr$(10) = "[form1.ListBox1.Keypress]"
CtlBr$(11) = ""
CtlBr$(12) = "[form1.ApiButton.Click]"
'initialize hwndLast(1) & set focus there
hwndLast(1) = hwnd(#form1.Button1)
'this only works at this point if there isn't an LB text editor in the window
ret = SetFocusTo(hwndLast(1))
'store the left, top, right, and bottom coordinates
'for all controls in the window.
Gosub [InitCtlCoords]
[Main.Loop]
scan
Goto [ProcessMouse]
[PmReturn]
Goto [ProcessKeys]
GoTo [Main.Loop]
[Quit]
If ApiCtlFont <> 0 Then
calldll #gdi, "DeleteObject", ApiCtlFont as word, ret as short
End If
close #user
close #gdi
close #form1 : End
'**************************************
[ProcessKeys]
'If focus has moved to another control, handle 'lost focus' events
'for the previous control, handle any 'on focus' events
'you want to do for the newly focused control.
If FocusChanged() = True Then
Gosub [UpdateFocus]
'do clean up for previous Edit control
'Edit controls on this window are TextBoxes and the ComboBox.
If ClassOfCtl$(hwndLast(1)) = "Edit" Then
numChars = GetTextLen(hwndLast(1))
strTmp$ = GetText$(hwndLast(1),numChars)
'strip out tab character from text
strTmp$ = StripChr$(strTmp$, chr$(9))
'strip out carriage return & linefeed characters from text
strTmp$ = StripChr$(strTmp$, chr$(13))
strTmp$ = StripChr$(strTmp$, chr$(10))
ret = SetText(strTmp$, hwndLast(1))
End If
'this next line directs all further processing to the newly focused control
hwndLast(1) = FocusedCtl()
If ClassOfCtl$(FocusedCtl()) = "Edit" Then
txtLen = GetTextLen(FocusedCtl())
ret = CursorToEnd(hwndLast(1),txtLen)
End If
'auto drop combo if text is already entered
ret = DropCbo(cbo1Hwnd,AltCbo1Hwnd)
End If
'Process key presses.
calldll #user, "GetKeyboardState", buffer$ as ptr, ret as void
'handle text key presses
For Ascii = 33 to 127 'space to Z // ascii code + 1
Chk$ = mid$(buffer$,Ascii,1)
If asc(Chk$) > 127 Then
ret = DropCbo(cbo1Hwnd,AltCbo1Hwnd)
Ascii = 127
End If
Next Ascii
'handle return key press
cr$ = mid$(buffer$,14,1)
If asc(cr$) > 127 Then
[RescanCr]
'wait for return key to be released
calldLL #user, "GetAsyncKeyState",_VK_RETURN AS short, Keystate AS short
If Keystate < 0 Then [RescanCr] 'negative value when key is down
'Don't allow Return key to enter Cr Lf into textboxes
If ClassOfCtl$(FocusedCtl()) = "Edit" Then
'strip out carriage return & linefeed characters from text
numChars = GetTextLen(hwndLast(1))
strTmp$ = GetText$(FocusedCtl(),numChars)
strTmp$ = StripChr$(strTmp$, chr$(13))
strTmp$ = StripChr$(strTmp$, chr$(10))
ret = SetText(strTmp$, FocusedCtl())
txtLen = GetTextLen(FocusedCtl())
'move cursor to end of text
ret = CursorToEnd(hwndLast(1),txtLen)
End if
txtBr$ = GetBranch$(FocusedCtl())
If txtBr$ <> "" Then [RunBranch]
End If
'handle tab key press
'go to next control in tab order if Tab pressed
tab$ = mid$(buffer$,10,1)
If asc(tab$) > 127 Then
[Rescan]
'wait for tab key to be released
calldLL #user, "GetAsyncKeyState",_VK_TAB AS short, Keystate AS short
If Keystate < 0 Then [Rescan] 'negative value when key is down
'get next ctl hwnd
For j = 1 to Ub(1)
If Controls(j) = hwndLast(1) Then
x = j + 1: If x > Ub(1) Then x = 1
CurH = Controls(x)
j = Ub(1)
End If
Next j
'go to next ctl
ret = SetFocusTo(CurH)
End If
GoTo [Main.Loop]
[ProcessMouse]
'mouse clicks, pointer movement
lBtnClick = False
rBtnClick = False
'detect which button is down, if any, and button clicks.
calldLL #user, "GetAsyncKeyState",_VK_LBUTTON AS short, lbstate AS short
If lbstate >= 0 and lBtnDown = True Then
lBtnClick = True
lBtnDown = False
End If
If lbstate < 0 then lBtnDown = True
calldLL #user, "GetAsyncKeyState",_VK_RBUTTON AS short, rbstate AS short
If rbstate >= 0 and rBtnDown = True Then
rBtnClick = True
rBtnDown = False
End If
If rbstate < 0 then rBtnDown = True
If lBtnDown = True Then print #form1.static4, "Left Mouse Button Down"
If rBtnDown = True Then print #form1.static4, "Right Mouse Button Down"
If lBtnDown = False and rBtnDown = False Then print #form1.static4, ""
'get the mouse pointer position on the screen
calldll #user, "GetCursorPos", _
point as struct,_
result as void
'convert it to the position in the window
calldll #user, "ScreenToClient",_
hParent as word,_
point as struct,_
r as void
mouseX = point.x.struct
mouseY = point.y.struct
'detect if the mouse pointer is moving
If prevMouseX <> mouseX or prevMouseY <> mouseY Then
mouseMove = True
prevMouseX = mouseX
prevMouseY = mouseY
print #form1.static1, ""
print #form1.static3, ""
Else
mouseMove = False
End If
print #form1.static2, "MouseX = " + str$(mouseX) + " MouseY = " + str$(mouseY) + " Moving = " + str$(mouseMove)
'determine which control the mouse pointer is over.
MouseOver = 0 'reset
For mOver = 1 to Ub(1)
If mouseX > CtlCoord(mOver,1) And mouseX < CtlCoord(mOver,3) _
And mouseY > CtlCoord(mOver,2) And mouseY < CtlCoord(mOver,4) Then
MouseOver = Controls(mOver) 'control handle
mOver = Ub(1) 'exit
End If
Next mOver
'if the mouse pointer is over a control
'and the right button has been clicked, execute your code.
If rBtnClick = True and MouseOver <> 0 Then
txtBr$ = GetBranch$(MouseOver)
print #form1.static3, "Right Button Clicked. Mouse is Over hwnd " + str$(MouseOver)
If txtBr$ <> "" Then [RunRightClickBranch]
End If
'if the mouse pointer is over a control
'and the left button has been clicked, execute your code.
If lBtnClick = True and MouseOver <> 0 Then
txtBr$ = GetBranch$(MouseOver)
print #form1.static3, "Left Button Clicked. Mouse is Over hwnd " + str$(MouseOver)
If txtBr$ <> "" Then [RunLeftClickBranch]
End If
GoTo [PmReturn]
[GetWindowRect]
calldll #user,"GetWindowRect",_
hCtlRect as short,_ 'handle of control
Rect as struct,_
ret as void
Return
[InitCtlCoords]
'automatically fill the CtlCoord() array with the
'corner positions of all controls in the window
For ii = 1 to Ub(1)
'hwnd of control
hCtlRect = Controls(ii)
'fill Rect structure with screen coordinates of control
Gosub [GetWindowRect]
'assign left & top coords to point structure
point.x.struct = Rect.left.struct
point.y.struct = Rect.top.struct
'convert coords to client coords
calldll #user, "ScreenToClient",_
hParent as short, point as struct, ret as void
CtlCoord(ii,1)= point.x.struct
CtlCoord(ii,2)= point.y.struct
'do the same for right & bottom coords
point.x.struct = Rect.right.struct
point.y.struct = Rect.bottom.struct
calldll #user, "ScreenToClient",_
hParent as short, point as struct, ret as void
CtlCoord(ii,3)= point.x.struct
CtlCoord(ii,4)= point.y.struct
Next ii
Return
[RunLeftClickBranch]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.Click]
GoTo [Main.Loop]
[RunRightClickBranch]
If txtBr$ = "[form1.Button1.Click]" Then [form1.Button1.Click]
If txtBr$ = "[form1.Button2.Click]" Then [form1.Button2.Click]
If txtBr$ = "[form1.RadioButton1.Set]" Then [form1.RadioButton1.Toggle]
If txtBr$ = "[form1.RadioButton2.Set]" Then [form1.RadioButton2.Toggle]
If txtBr$ = "[form1.CheckBox1.Toggle]" Then [form1.CheckBox1.Toggle]
If txtBr$ = "[form1.CheckBox2.Toggle]" Then [form1.CheckBox2.Toggle]
If txtBr$ = "[form1.ListBox1.Keypress]" Then [form1.ListBox1.Keypress]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.RightClick]
GoTo [Main.Loop]
[RunBranch]
If txtBr$ = "[form1.Button1.Click]" Then [form1.Button1.Click]
If txtBr$ = "[form1.Button2.Click]" Then [form1.Button2.Click]
If txtBr$ = "[form1.RadioButton1.Set]" Then [form1.RadioButton1.Toggle]
If txtBr$ = "[form1.RadioButton2.Set]" Then [form1.RadioButton2.Toggle]
If txtBr$ = "[form1.CheckBox1.Toggle]" Then [form1.CheckBox1.Toggle]
If txtBr$ = "[form1.CheckBox2.Toggle]" Then [form1.CheckBox2.Toggle]
If txtBr$ = "[form1.ListBox1.Keypress]" Then [form1.ListBox1.Keypress]
If txtBr$ = "[form1.ApiButton.Click]" Then [form1.ApiButton.Enter]
GoTo [Main.Loop]
Function CreateCtlFont(fntName$,fntHeight,weight,italic,underline)
'In: font name, font height
'Out handle to the font
fntName$ = fntName$ + chr$(0)
Calldll #gdi, "CreateFont", fntHeight as word,_
0 as word, 0 as word, 0 as word,_
weight as word,_ 'usually _FW_MEDIUM or _FW_BOLD
italic as word,_ '1 = italic, 0 otherwise
underline as word,_ '1 = underline, 0 otherwise
0 as word, 0 as word, 0 as word, _
0 as word, 0 as word, 0 as word,_
fntName$ as PTR, hF as word
CreateCtlFont = hF
End Function
Function SetFont(hCtl,hFont)
'In: handle of control to set font for, handle of created font
'Out: nothing
calldll #user, "SendMessage", _
hCtl as word, _ 'handle of control
_WM_SETFONT as word,_ 'message
hFont as word, _ 'new font
1 as long,_ 'repaint=1, no repaint=0
ret as long 'not used
SetFont = 0
End Function
Function GetParentInstance(hWin)
'In: handle to parent window
'Out: instance handle of parent window
type = GWW.HINSTANCE or 0
calldll #user, "GetWindowWord",_
hWin as word,_
type as short,_
inst as word
GetParentInstance = inst
End Function
Function CreateCtl(class$,caption$,style,left,top,width,height,hParent,pHinst)
'In: everything
'Out: handle to newly created control
calldll #user, "CreateWindow",_
class$ as ptr,_ 'class name
caption$ as ptr,_
style as word,_ 'style(s) OR together
left as short,_
top as short,_
width as short,_ 'width
height as short,_ 'height
hParent as short,_ 'parent window
0 as short,_ 'handle to menu = 0 for class menu
pHinst as short,_ 'instance of parent window
"" as ptr,_
hnd as short
CreateCtl = hnd 'return handle of control
End Function
Function GetBranch$(hCtl)
'In: control hwnd
'Out: branch name from CtlBr$ array
For i = 1 to Ub(1)
If Controls(i) = hCtl Then
txtBr$ = CtlBr$(i)
i = Ub(1)
End If
Next i
GetBranch$ = txtBr$
End Function
Function DropCbo(hCbo,hCboAlt)
'In: both hwnds for a combobox
'Out: nothing
If FocusedCtl() = hCboAlt Then
If GetTextLen(hCbo) > 0 Then
calldll #user, "SendMessage", hCbo as word,_
_CB_SHOWDROPDOWN as word, 1 as word, 0 as long, ret as long
End If
End If
DropCbo = 0
End Function
Function StripChr$(Txt$, spec$)
'In: string to work with, character to remove
'Out: Txt$ without any spec$ characters in it
txtLen = len(Txt$)
For i = 1 to txtLen
char$ = mid$(Txt$,i,1)
If char$ <> spec$ Then
StripChr$ = StripChr$ + char$
End If
Next i
End Function
Function FocusChanged()
'In: nothing
'Out: True if focus is changed
If FocusedCtl() <> staticFoc(1) Then
FocusChanged = 1 'return True
End If
End Function
Function CursorToEnd(hEdit,txtLen)
'In: hwnd of edit control
'position the cursor to the end of text
'Out: nothing
lngTL = txtLen + txtLen * 65536 'convert to long integer.
calldll#user, "SendMessage",_
hEdit AS short,_
_EM_SETSEL AS short,_
0 AS short,_
lngTL AS long,_
ret AS void
CursorToEnd = 0
End Function
Function GetText$(hEdit,numChars)
'In: hwnd of Edit control or window
'Out: the control text or window caption
'numChars = GetTextLen(hEdit)
entry$ = space$(numChars) + Chr$(0)
lenEntry = Len(entry$)
calldll #user, "GetWindowText", _
hEdit as word, _
entry$ as ptr, _
lenEntry as short,_
ret as short
GetText$ = entry$
End Function
Function GetTextLen(hEdit)
'In: hwnd of Edit control or window
'Out: the length of control text or window caption
calldll #user, "GetWindowTextLength",_
hEdit as short,_
ret as short
GetTextLen = ret
End Function
Function SetText(txt$, hEdit)
'In: text to place into Edit control or window caption,
'hwnd of Edit Control or window
'Out: nothing
calldll #user, "SetWindowText", _
hEdit as word, _
txt$ as ptr, _
ret as void
SetText = 0
End Function
Function FocusedCtl()
'In: nothing
'Out: hwnd of control with the focus
calldll #user, "GetFocus" , FocusedCtl AS short
End Function
Function ClassOfCtl$(CtlHwnd)
'In: handle to control or window
'Out: class name of control or window
class$ = space$(255) + chr$(0)
length = len(class$)
calldll #user, "GetClassName",_
CtlHwnd AS word,_
class$ AS ptr,_
length AS word,_
returnLength AS word
ClassOfCtl$ = left$(class$, returnLength)
End Function
Function SetFocusTo(handle)
'In: hwnd of control or window to focus
'Out: nothing
calldll #user, "SetFocus",_
handle as word,_
ret as short
SetFocusTo = 0
End Function
[UpdateFocus]
calldll #user, "GetFocus" , sfoc AS short
staticFoc(1) = sfoc
Return
[form1.Button1.Click]
print #form1.static1, "Button 1 clicked"
GoTo [Main.Loop]
[form1.Button2.Click]
print #form1.static1, "Button 2 clicked"
GoTo [Main.Loop]
[form1.CheckBox1.Reset]
print #form1.static1, "Checkbox 1 Reset"
GoTo [Main.Loop]
[form1.CheckBox1.Set]
print #form1.static1, "Checkbox 1 Set"
GoTo [Main.Loop]
[form1.CheckBox2.Reset]
print #form1.static1, "Checkbox 2 Reset"
GoTo [Main.Loop]
[form1.CheckBox2.Set]
print #form1.static1, "Checkbox 2 Set"
GoTo [Main.Loop]
[form1.ComboBox1.Click]
GoTo [Main.Loop]
[form1.ListBox1.DoubleClick]
print #form1.static1, "Listbox Double Click Selection"
GoTo [Main.Loop]
[form1.RadioButton1.Reset]
GoTo [Main.Loop]
[form1.RadioButton1.Set]
print #form1.static1, "RadioButton 1 Set"
GoTo [Main.Loop]
[form1.RadioButton2.Reset]
GoTo [Main.Loop]
[form1.RadioButton2.Set]
print #form1.static1, "RadioButton 2 Set"
GoTo [Main.Loop]
[form1.CheckBox1.Toggle]
print #form1.CheckBox1, "value? result$"
If result$ = "set" Then
print #form1.CheckBox1, "reset"
print #form1.static1, "Checkbox 1 Reset by other means"
End If
If result$ = "reset" Then
print #form1.CheckBox1, "set"
print #form1.static1, "Checkbox 1 Set by other means"
End If
GoTo [Main.Loop]
[form1.CheckBox2.Toggle]
print #form1.CheckBox2, "value? result$"
If result$ = "set" Then
print #form1.CheckBox2, "reset"
print #form1.static1, "Checkbox 2 Reset by other means"
End If
If result$ = "reset" Then
print #form1.CheckBox2, "set"
print #form1.static1, "Checkbox 2 Set by other means"
End If
GoTo [Main.Loop]
[form1.RadioButton1.Toggle]
print #form1.RadioButton1, "value? result$"
If result$ = "reset" Then
print #form1.RadioButton1, "set"
print #form1.RadioButton2, "reset"
print #form1.static1, "RadioButton 1 Set by other means"
End If
GoTo [Main.Loop]
[form1.RadioButton2.Toggle]
print #form1.RadioButton2, "value? result$"
If result$ = "reset" Then
print #form1.RadioButton2, "set"
print #form1.RadioButton1, "reset"
print #form1.static1, "RadioButton 2 Set by other means"
End If
GoTo [Main.Loop]
[form1.ListBox1.Keypress]
print #form1.ListBox1, "selection? selected$"
If selected$ = "" Then
notice "No item is selected"
Else
print #form1.static1, "'" + selected$ + " selected by other means"
End IF
GoTo [Main.Loop]
[form1.ApiButton.Click]
print #form1.static1, "API button left clicked"
GoTo [Main.Loop]
[form1.ApiButton.RightClick]
print #form1.static1, "API button right clicked"
GoTo [Main.Loop]
[form1.ApiButton.Enter]
print #form1.static1, "API button pressed by Return key"
GoTo [Main.Loop]
[Misc.Info]
'font weight values
'_FW_DONTCARE 0
'_FW_THIN 100
'_FW_EXTRALIGHT 200
'_FW_ULTRALIGHT 200
'_FW_LIGHT 300
'_FW_NORMAL 400
'_FW_REGULAR 400
'_FW_MEDIUM 500
'_FW_SEMIBOLD 600
'_FW_DEMIBOLD 600
'_FW_BOLD 700
'_FW_EXTRABOLD 800
'_FW_ULTRABOLD 800
'_FW_BLACK 900
'_FW_HEAVY 900
