|
Post by Walt Decker on Feb 20, 2022 15:07:51 GMT -5
The functions contained in the zip are almost useless in Liberty Basic 4x and will probaly be the same in 5x. However, they will give you an idea of what can be done with matricies. The zip contains: INSTRUCTIONS.TXT <--- how to use MATRIX_DATA.TXT <--- sample data MAT_FUNCTION_SPECS.TXT <--- function descriptions and specs MATRIX_FUNCTIONS_SRC.TXT <--- function source code MISC.TXT <--- look at it if you have trouble
|
|
|
Post by Walt Decker on Feb 21, 2022 15:01:37 GMT -5
EDIT CONTROL TRICKS (TEXTBOX)
EDIT: Just press the ENTER key, DO NOT press CTRL + ENTER at the same time. It will produce a double CRLF pair if you do.
' '################################################################################# ' MULTI-LINE EDIT CONTROL (TEXTBOX) '#################################################################################
'<------------------------- CONTROL STYLES --------------> WS.VSCROLL = HEXDEC("&H00200000") WS.HSCROLL = HEXDEC("&H00100000")
ES.MULTILINE = HEXDEC("&H0004") ES.AUTOHSCROLL = HEXDEC("&H0080") ES.AUTOVSCROLL = HEXDEC("&H0040") ES.WANTRETURN = HEXDEC("&H1000") ES.NOHIDESEL = HEXDEC("&H0100")
'<--------------------- VIRTUAL KEY CODES -----------------> VK.RETURN = HEXDEC("&H0D") '<--- keyboard enter key
'------------------ EDIT CONTROL MESSAGES ------------> EM.GETSEL = HEXDEC("&H00B0") EM.REPLACESEL = HEXDEC("&H00C2") EM.SETSEL = HEXDEC("&H00B1")
OPEN "User32.DLL" FOR DLL AS #USER OPEN "NUMBERMANDLL" FOR DLL AS #NUM '<--- for chr positions
[DECLARE.GLOBALS] GLOBAL CRLF$ '<--- chrarcter return/line feed pair
DIM CtrlHndls(0)
[END.GLOBALS]
CRLF$ = CHR$(13) + CHR$(10)
'<----------------- ADD STYLE --------------------> Style = ES.MULTILINE OR ES.AUTOVSCROLL OR ES.WANTRETURN OR ES.NOHIDESEL
'<----------------- REMOVE STYLE ----------------> RemStyle = ES.AUTOHSCROLL OR WS.HSCROLL
STYLEBITS #DMO.TXB, Style, RemStyle, 0, 0 '<--- set edit control style TEXTBOX #DMO.TXB, 5, 5, 200, 300
OPEN "TXT BOX TRICKS" FOR WINDOW AS #DMO CtrlHndls(0) = FN.GetHandle("DMO.TXB") '<--- get textbox handle
PRINT #DMO.TXB, "!SETFOCUS" '<--- make textbox active
[BEGIN.TIMER] TIMER 100, [KEY.SCAN] '<--- check for key presses
[END.TIMER] WAIT
[KEY.SCAN] TIMER 0
Key = 0 Key = FN.KeyState(VK.RETURN) '<--- check key press
IF Key THEN Hndl = CtrlHndls(0) '<--- text box handle
'<------------- GET CURRENT TEXT POSITION ---------------> CALLDLL #USER, "SendMessageA", Hndl AS ULONG, EM.GETSEL AS ULONG, 0 AS LONG, _ 0 AS LONG, ChrPos AS LONG
'<--------------- SEPERATE 4-BYTES INTO 2-BYTES ----------------> CALLDLL #NUM, "FN_GetLowWord", ChrPos AS LONG, Chr1 AS LONG CALLDLL #NUM, "FN_GetHiWord", ChrPos AS LONG, Chr2 AS LONG
'<--------------- SET POSITION FOR CRLF PAIR -----------------> CALLDLL #USER, "SendMessageA", Hndl AS ULONG, EM.SETSEL AS ULONG, _ Chr1 AS LONG, Chr1 AS LONG, RetVal AS VOID
'<----------------- INSERT CRLF PAIR --------------------------------> CALLDLL #USER, "SendMessageA", Hndl AS ULONG, EM.REPLACESEL AS ULONG, _ 1 AS BOOLEAN, CRLF$ AS PTR, RetVal AS VOID
GOTO [BEGIN.TIMER] END IF GOTO [BEGIN.TIMER] [END.KEY.SCAN]
'----------------------------------------------------------------- '-----------------------------------------------------------------
FUNCTION FN.CheckHandle$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckHandle$ = Tag$ END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.GetHandle(WinTag$)
Handle = 0 WinTag$ = FN.CheckHandle$(WinTag$)
Handle = HWND(#WinTag$) FN.GetHandle = Handle END FUNCTION
'-------------------------------------------------------------------- '--------------------------------------------------------------------
FUNCTION FN.KeyState(Vkey) '################################################################ ' Determine whether Vkey is pressed '################################################################
VK.SHIFT = HEXDEC("&H10") '<--- keyboard shift key VK.CONTROL = HEXDEC("&H11") '<--- keyboard control key
KeyPressed = 0
Value = 0
Mask = HEXDEC("&H8000") '<--- value used to determine if the 'pressed bit is set
'<--- the following checks to see if 2 keys are pressed at the same time ---> CALLDLL #USER, "GetAsyncKeyState", VK.SHIFT AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN FN.KeyState = 2 EXIT FUNCTION END IF END IF
CALLDLL #USER, "GetAsyncKeyState", VK.CONTROL AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN FN.KeyState = 2 EXIT FUNCTION END IF END IF
'<--- only the Vkey parameter is pressed -----------> CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN FN.KeyState = 1
END FUNCTION
'
|
|
|
Post by tsh73 on Feb 21, 2022 16:14:58 GMT -5
Re: EDIT CONTROL TRICKS (TEXTBOX) looks really intetresting but on my machine I quite often get two new lines in a row. Is it just me?
|
|
|
Post by Walt Decker on Feb 21, 2022 16:36:42 GMT -5
You will probably get double CRLF pairs if you press CTRL + ENTER or SHIFT + ENTER at the same time. Another possibility is in the timer. Increase the TIMER interval and see what happens.
|
|
|
Post by Walt Decker on Feb 22, 2022 16:02:04 GMT -5
' '########################################################################## ' LISTBOX TRICKS ' ' Provides a keyboard selection interface for listboxes. However, for some ' reason the parent window does not receive input with this type interface. ' '##########################################################################
LBS.DISABLENOSCROLL = HEXDEC("&H1000") '<--- listbox style to keep the 'vertical scroll bar visible at 'all times
VK.LBUTTON = 1 '<--- left mouse button VK.RETURN = HEXDEC("&H0D") '<--- keyboard enter key
WinHndl = 0 LbxHndl = 0
RetVal = 0
SelItem = 0 Clicked = 0
OPEN "User32.dll" FOR DLL AS #USER OPEN "E:\PBWIN10\DLLS\NUMBERMANDLL" FOR DLL AS #NUM
STYLEBITS #DMO.LBXL, LBS.DISABLENOSCROLL, 0, 0, 0
LISTBOX #DMO.LBXL, Lft$(), SYNC, 5, 5, 75, 65
OPEN "LBX" FOR WINDOW AS #DMO
WinHndl = FN.GetHandle("DMO") LbxHndl = FN.GetHandle("#DMO.LBXL")
RetVal = FN.PopulateListBox(LbxHndl)
PRINT #DMO.LBXL, "RELOAD" PRINT #DMO, "TRAPCLOSE END.DMO"
PRINT #DMO.LBXL, "SELECTINDEX 1" '<--- set initial list box item PRINT #DMO.LBXL, "SETFOCUS"
[BEGIN.TIMER] '<--- begin event trap TIMER 100, [GET.STATE]
WAIT
'------------------------------------------------------ '------------------------------------------------------
[GET.STATE]
TIMER 0 Clicked = 0 Clicked = FN.KeyState(VK.LBUTTON) '<--- has left mouse button been clicked?
IF Clicked THEN Ok = 0 Ok = FN.QueryListBox(LbxHndl, SelItem)
IF Ok THEN '<--- cursor not in listbox client area GOTO [CHECK.ENTER] END IF
CALL SYNC "#DMO.LBXL"
GOTO [BEGIN.TIMER]
END IF
[CHECK.ENTER]
Clicked = 0 Clicked = FN.KeyState(VK.RETURN) IF Clicked THEN CALL SYNC "#DMO.LBXL" END IF
GOTO [BEGIN.TIMER] [GET.STATE.END]
'------------------------------------------------------ '------------------------------------------------------
SUB SYNC LbxHndl$ '####################################################### ' Get the selected item from the list box '#######################################################
Item = 0
ItmStr$ = ""
PRINT #LbxHndl$, "selectionindex? Item"
PRINT #LbxHndl$, "selectindex "; Item PRINT #LbxHndl$, "selection? ItmStr$"
PRINT ItmStr$
END SUB
'----------------------------------------------------- '-----------------------------------------------------
SUB END.DMO Win$
CLOSE #USER CLOSE #NUM CLOSE #DMO END END SUB
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.CheckHandle$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckHandle$ = Tag$ END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.GetHandle(WinTag$)
Handle = 0 WinTag$ = FN.CheckHandle$(WinTag$)
Handle = HWND(#WinTag$) FN.GetHandle = Handle END FUNCTION
'-------------------------------------------------------------------- '--------------------------------------------------------------------
FUNCTION FN.PopulateListBox(Hndl)
DATA "Peter" DATA "Piper" DATA "picked" DATA "a peck" DATA "of pickled" DATA "peppers." DATA "If Peter" DATA "Piper" DATA "picked" DATA "a peck" DATA "of pickled" DATA "peppers," DATA "how many" DATA "pickled" DATA "peppers" DATA "did Peter" DATA "Piper" DATA "Pick" DATA "999"
LB.ADDSTRING = HEXDEC("&H0180")
RetVal = 0 Txt$ = ""
[POP.BEGIN] READ Txt$
IF Txt$ = "999" THEN RetVal = FN.SetLbArray(Hndl) EXIT FUNCTION END IF
CALLDLL #USER, "SendMessageA", Hndl AS ULONG, LB.ADDSTRING AS LONG, _ 0 AS LONG, Txt$ AS PTR, RetVal AS LONG GOTO [POP.BEGIN]
END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.SetLbArray(LbxHndl) '##################################################################### ' POPULATE ARRAY ASSOCIATED WITH A LISTBOX ' ' IMO this is a waste of resources '#####################################################################
LB.GETTEXT = HEXDEC("&H0189") '<--- listbox messages LB.GETTEXTLEN = HEXDEC("&H018A") LB.GETCOUNT = HEXDEC("&H018B")
ItemCount = 0 '<--- # of items in listbox TextLen = 0 '<--- length of text at listbox row I = 0 '<--- counter
TxtIn$ = "" '<--- text data at listbox row is inserted in array
'<------------------ retrieve # of items in listbox ---------------------> CALLDLL #USER, "SendMessageA", LbxHndl AS ULONG, LB.GETCOUNT AS ULONG, _ 0 AS LONG, 0 AS LONG, ItemCount AS LONG ItemCount = ItemCount - 1
REDIM Lft$(ItemCount) '<--- define array size
'<-------- retrieve listbox data ---------> FOR I = 0 TO ItemCount
'<----------------- get data length at row "I" of listbox -----------------> CALLDLL #USER, "SendMessageA", LbxHndl AS ULONG, LB.GETTEXTLEN AS ULONG, _ I AS LONG, 0 AS LONG, TextLen AS LONG
TxtIn$ = SPACE$(TextLen) '<--- set to data length
'<------------------ retrieve data at row "I" -----------------------> CALLDLL #USER, "SendMessageA", LbxHndl AS ULONG, LB.GETTEXT AS ULONG, _ I AS LONG, TxtIn$ AS PTR, TextLen AS LONG
Lft$(I) = TxtIn$ '<--- set array element "I" NEXT I
END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.QueryListBox(Hndl, Item)
LB.ITEMFROMPOINT = HEXDEC("&H01A9") '<--- list box message to find the 'list box item from the mouse cursor 'position
RetVal = 0 CursPos = 0
LbxIndex = 0 InClient = 0
Cpx = 0 Cpy = 0
RetVal = FN.CursorPos(Cpx, Cpy) '<--- get location of the mouse cursor 'the position is in screen coordinates
RetVal = FN.ScreenToClient(Hndl, Cpx, Cpy) '<--- translate cursor 'position to list box '<--------- prepare to find the nearest list box item -----------> CALLDLL #NUM, "FN_SetLong", Cpx AS SHORT, Cpy AS SHORT, _ CursPos AS LONG
'<----- find the neares list box item to the mouse cursor --------> CALLDLL #USER, "SendMessageA", Hndl AS ULONG, _ LB.ITEMFROMPOINT AS ULONG, 0 AS LONG, CursPos AS LONG, _ RetVal AS LONG '<--- the zero-base index item is in the low word of the retrun value -----> CALLDLL #NUM, "FN_GetLowWord", RetVal AS LONG, LbxIndex AS LONG CALLDLL #NUM, "FN_GetHiWord", RetVal AS LONG, InClient AS LONG
'####################################################################### ' If "InClient" is zero the cursor is inside the client area of the ' listbox. ' ' If "Inclient" is 1 the cursor is outside the client area of the ' listbox. '#######################################################################
Item = LbxIndex + 1 FN.QueryListBox = InClient END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.KeyState(Vkey) '################################################################ ' Determine whether Vkey is pressed '################################################################
VK.SHIFT = HEXDEC("&H10") '<--- keyboard shift key VK.CONTROL = HEXDEC("&H11") '<--- keyboard control key
KeyPressed = 0
Value = 0
Mask = HEXDEC("&H8000") '<--- value used to determine if the 'pressed bit is set
'<--- the following checks to see if 2 keys are pressed at the same time ---> CALLDLL #USER, "GetAsyncKeyState", VK.SHIFT AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN FN.KeyState = 2 EXIT FUNCTION END IF END IF
CALLDLL #USER, "GetAsyncKeyState", VK.CONTROL AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT IF KeyPressed AND Mask THEN FN.KeyState = 2 EXIT FUNCTION END IF END IF
'<--- only the Vkey parameter is pressed -----------> CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN FN.KeyState = 1
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.CursorPos(BYREF Cpx, BYREF Cpy) '################################################################ ' Retrieve the position of the mouse cursor. The position is ' in screen coordinates. '################################################################
STRUCT tPnt, _ X AS LONG, _ Y AS LONG
RetVal = 0 CALLDLL #USER, "GetCursorPos", tPnt AS STRUCT, RetVal AS VOID
Cpx = tPnt.X.struct Cpy = tPnt.Y.struct
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.ScreenToClient(WinHndl, BYREF Cpx, BYREF Cpy) '################################################################ ' Translate screen coordinates to window or control client ' coordinates. Client coordinages are those coordinates that ' are not caption or border. '################################################################
STRUCT tPnt, _ X AS LONG, _ Y AS LONG
RetVal = 0 tPnt.X.struct = Cpx tPnt.Y.struct = Cpy
CALLDLL #USER, "ScreenToClient", WinHndl AS ULONG, tPnt AS STRUCT, _ RetVal AS VOID
Cpx = tPnt.X.struct Cpy = tPnt.Y.struct END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------ '
|
|
|
Post by Walt Decker on Mar 4, 2022 16:31:06 GMT -5
' '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' SIMPLE NUMERIC FORMATTING MASK ' ' NOTE: There is a function in NUMBERMANDLL ' that will round decimal values to a provied ' decimal place. ' '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! A = 0 '<--- decimal number B$ = "" '<--- decimal number string FMTmask$ = "" '<--- print format
A = RND(0) * 10000000 '<--- create random decimal number B$ = STR$(A) B$ = FN.Ltrim$(B$) '<--- trim leading spaces if necessary FMTmask$ = FN.Mask$(B$) '<--- create print format
PRINT USING(FMTmask$, A) WAIT
'------------------------------------------- '-------------------------------------------
FUNCTION FN.Ltrim$(C$) '########################################### ' REMOVE LEADING SPACES FROM A STRING '###########################################
I = 0 LenC = 0 SPC$ = " "
LenC = LEN(C$) I = 1
[STRT.TRIM] '<--- check for leading spaces IF MID$(C$, I, 1) = SPC$ THEN C$ = MID$(C$, I + 1] '<--- shorten string by one character GOTO [STRT.TRIM] END IF
FN.Ltrim$ = C$ END FUNCTION
'------------------------------------------- '-------------------------------------------
FUNCTION FN.Mask(C$, NumDecimals) '############################################ ' CREATE PRINT FORMAT MASK (STRING) ' ARGUMENTS: ' C$: String containing decimal number ' NumDecimals: Number of decimal places to right of ' decimal poing or number of integer ' places if C$ is an integer '############################################ I = 0 '<--- counter LftLen = 0 '<--- length of intger part NumGroup = 0 '<--- groups of 3 in integer part Remainder = 0 '<--- what is left over in integer part
Lft$ = "" '<--- left side of decimal point Rgt$ = "" '<--- right side of decimal point Mask$ = "" '<--- return string LftMask = "" '<--- left (integer) formatting mask RgtMask = "" '<--- right (decimal) formatting mask
I = INSTR(C$, ".") '<--- find decimal point IF I = 0 THEN LftLen = LEN(C$) NumGroup = INT(LftLen / 3) '<--- how many groups of three 'in intger part Remainder = INT(LftLen - NumGroup * 3) '<--- how many 'left over 'characters in 'integer part
LftMask$ = FN.REPEAT$("#", Remainder) + "," '<--- left over 'characters FOR I = 1 TO NumGroup - 1 '<--- make into groups of three LftMask$ = Lftmask$ + FN.REPEAT$("#", 3) + "," NEXT I
FN.Mask = Mask$ EXIT FUNCTION END IF Lft$ = LEFT$(C$, I - 1) '<--- split into integer and decimal 'parts Rgt$ = MID$(C$, I + 1)
RgtMask$ = FN.REPEAT$("#", NumDecimals) '<--- create the 'decimaol format LftLen = LEN(Lft$) '<--- how many characters in intger part NumGroup = INT(LftLen / 3) '<--- how many groups of three 'in intger part Remainder = INT(LftLen - NumGroup * 3) '<--- how many 'left over characters 'in integer part
LftMask$ = FN.REPEAT$("#", Remainder) + "," '<--- left over 'characters FOR I = 1 TO NumGroup - 1 '<--- make into groups of three LftMask$ = Lftmask$ + FN.REPEAT$("#", 3) + "," NEXT I
LftMask$ = Lftmask$ + FN.REPEAT$("#", 3) '<--- last group of 'three Mask$ = Lftmask$ + "." + RgtMask$ '<--- put 'em together
FN.Mask$ = Mask$ '<--- return result END FUNCTION
'---------------------------------------- '----------------------------------------
FUNCTION FN.REPEAT$(StrIn$, Ntimes) '############################################ ' CREATE A STRING Ntimes '############################################
I = 0 StrOut$ = ""
FOR I = 1 TO ABS(Ntimes) StrOut$ = StrOut$ + StrIn$ NEXT I
FN.REPEAT$ = StrOut$ END FUNCTION '
|
|
|
Post by Walt Decker on Mar 7, 2022 17:45:31 GMT -5
Alternate numeric formatting: ' '<----------- EDIT CONTROL STYLES -------------> WS.HSCROLL = HEXDEC("&H00100000") WS.VSCROLL = HEXDEC("&H00200000")
ES.MULTILINE = HEXDEC("&H0004") ES.AUTOHSCROLL = HEXDEC("&H0080") ES.AUTOVSCROLL = HEXDEC("&H0040") ES.WANTRETURN = HEXDEC("&H1000")
Dot = 0
A = 0 I = 0
Nmin = 0 Nmax = 0
B$ = "" C$ = ""
CRLF$ = CHR$(13) + CHR$(10) SPC$ = " "
DIM NumAry(9)
FOR I = 0 TO 9 IF I MOD 2 THEN NumAry(I) = RND(0) * 1000000 IF RND(0) <= 0.50 THEN NumAry(I) = NumAry(I) * -1 END IF ELSE NumAry(I) = RND(0) * 10000000 * -1 IF RND(0) <= 0.50 THEN NumAry(I) = NumAry(I) * -1 END IF
B$ = STR$(NumAry(I)) Dot = INSTR(B$, ".") B$ = LEFT$(B$, Dot - 1)
IF LEFT$(B$, 1) = "-" THEN B$ = MID$(B$, 2) END IF
WindowWidth = LEN(B$) Nmax = MAX(Nmax, WindowWidth)
NEXT I
C$ = "" FOR I = 0 TO 9 B$ = FN.Format$("$ ", ",", ".", " Tons", NumAry(I), 3, Nmax) C$ = C$ + B$ + CRLF$ NEXT I
WindowWidth = DisplayWidth * 0.5 WindowHeight = DisplayHeight * 0.5
STYLEBITS #USING.EDC, WS.VSCROLL OR WS.AUTOVSCROLL OR ES.MULTILINE OR _ ES.WANTRETURN, WS.AUTOHSCROLL, 0, 0 TEXTBOX #USING.EDC, 5, 5, WindowWidth - 28, WindowHeight - 50
UpperLeftX = 200 UpperLeftY = 175
OPEN "USING" FOR WINDOW AS #USING PRINT #USING.EDC, "!FONT COURIER_NEW 10" PRINT #USING.EDC, C$ WAIT
'----------------------------------------------------------------- '-----------------------------------------------------------------
FUNCTION FN.Format$(Ftag$, Sep$, Decm$, Btag$, NumberIn, NumDecmi, MaxLen) '#################################################################### ' PURPOSE: Format numeric data so decimal points will line up ' ' ARGUMENTS: ' Ftag$: Character(s) to place in front of the number string ' Examples: $ + " ", Lsterling + " ", nothing ' Sep$: Seperator character(s) between hundreds ' Examples: " ", ",", ".", "/" ' Decm$: Character(s) to use for the decimal point ' Examples: ".", ",", " " ' Btag$: Character(s) to place at the end of the number string ' Examples: "%", "deg F", "C", "K", "per ton", "Ft^3" ' NumberIn: Number to format ' NumDecmi: Number of decimal places to show ' MaxLen: Length of longest number string for padding calculations '#################################################################### SPC$ = " " Lft$ = "" '<--- integer side of number Rgt$ = "" '<--- decimal side of number
NumIn$ = "" '<--- numeric string Minus$ = "-" '<--- negative number indicator
Dot = 0
NumIn$ = STR$(NumberIn) '<--- make the number a string
Dot = INSTR(NumIn$, ".") '<--- find decimal point IF Dot THEN '<--- set integer and decimal parts Rgt$ = MID$(NumIn$, Dot + 1) Lft$ = LEFT$(NumIn$, Dot - 1) ELSE Lft$ = NumIn$ END IF
SELECT CASE LEFT$(Lft$, 1) CASE Minus$ '<--- a negative number Lft$ = MID$(Lft$, 2) '<--- make positive Lft$ = FN.Pad$(Lft$, MaxLen) '<--- prepend zeros if necessary Lft$ = FN.SetHundreds$(Lft$, Sep$) '<--- seperate number into hundreds
IF LEN(Rgt$) THEN Rgt$ = FN.DecimalPos$(Rgt$, NumDecmi) '<--- set decimal part to number 'of decimal positions END IF
NumIn$ = Ftag$ + Minus$ + Lft$ + Decm$ + Rgt$ + Btag$ '<--- return CASE ELSE Lft$ = FN.Pad$(Lft$, MaxLen) Lft$ = FN.SetHundreds$(Lft$, Sep$)
IF LEN(Rgt$) THEN Rgt$ = FN.DecimalPos$(Rgt$, NumDecmi) END IF
NumIn$ = Ftag$ + SPC$ + Lft$ + Decm$ + Rgt$ + Btag$ END SELECT
FN.Format$ = NumIn$ END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SetHundreds$(StrIn$, Seperator$) '###################################################### ' PURPOSE: seperate a number string into 100s ' ' ARGUMENTS: ' StrIn$: Number string 'Seperator$: Character(s) to use as 100s seperator '######################################################
I = 0 '<--- counter StrPosn = 3 '<--- number of characters in string to make 100s NumGroups = 0 '<--- number of 100 groups Insertpos = 0 '<--- where to insert seperator
NumGroups = INT(LEN(StrIn$) / StrPosn) '<--- calculate # of 100 groups FOR I = 1 TO NumGroups Insertpos = LEN(StrIn$) - StrPosn '<--- where to insert the seperator StrIn$ = FN.INSERTSTR$(StrIn$, Seperator$, Insertpos) '<--- insert the 'seperator StrPosn = StrPosn + 3 + I '<--- increase the insert position NEXT I
FN.SetHundreds$ = StrIn$ '<--- return END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.Pad$(B$, Nmax)
Padding = Nmax - LEN(B$) '<--- needed padding
IF Padding THEN B$ = (FN.REPEAT$("0", Padding) + B$) '<--- prepend padding character END IF
FN.Pad$ = B$ END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.DecimalPos$(Rgt$, NumDecimals) '############################################################## ' PURPOSE: set the decimal part to the number of requested ' decimal positions ' ARGUMENTS: ' Rgt$: decimal part of number 'NumDecimals: number of decimal positions requested '##############################################################
Zero$ = "0" '<--- character to subtend if necessary RgtLen = LEN(Rgt$) '<--- length of decimal string
SELECT CASE CASE NumDecimals > 0 IF NumDecimals > RgtLen THEN '<--- subtend zeros if necessary NumDecimals = NumDecimals - RgtLen Rgt$ = Rgt$ + FN.REPEAT$(Zero$, NumDecimals) GOTO [POSN.EXIT] END IF
IF RgtLen > NumDecimals THEN Rgt$ = LEFT$(Rgt$, NumDecimals) '<--- trim string CASE NumDecimals = 0 '<--- erase decimal string Rgt$ = "" CASE NumDecimals < 0 Rgt$ = "" END SELECT
[POSN.EXIT] FN.DecimalPos$ = Rgt$ END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.REPEAT$(StrIn$, Ntimes) '############################################ ' CREATE A STRING Ntimes '############################################
I = 0 StrOut$ = ""
FOR I = 1 TO ABS(Ntimes) StrOut$ = StrOut$ + StrIn$ NEXT I
FN.REPEAT$ = StrOut$ END FUNCTION
'---------------------------------------- '----------------------------------------
FUNCTION FN.INSERTSTR$(MainStr$, StrIn$, Posn) '######################################################### ' INSERT CHARACTERS AT THE REQUESTED POSITION (Posn) '#########################################################
Lft$ = "" Rgt$ = ""
'<--- split the string ----------> Lft$ = LEFT$(MainStr$, Posn) Rgt$ = MID$(MainStr$, Posn + 1)
Lft$ = Lft$ + StrIn$ '<--- subtend the character(s) MainStr$ = Lft$ + Rgt$ '<--- combine them
FN.INSERTSTR$ = MainStr$ '<--- return END FUNCTION '
|
|
|
Post by Walt Decker on Mar 24, 2022 13:00:28 GMT -5
Before any one asks: "Can I programmatically minimize, restore, and maximize my windows?" the answer is YES.
There are two ways:
1) use the user32.dll function ShowWindow(WinHndl, ShowState) where WinHndl is the numeric handle of the target window and ShowState is the appropriate SW_ message and
2) use user32.dll function SendMessage(WinHndl, Message, wParam, lParam) where WinHndl is the numrtic handle of the target window, Message is WM_SYSCOMMAND, wParam is the appropriate SC_message, and lParam = 0.
In the code below I have chosen to use method 2. It should be fairly obvious what is going on so I have not commented the code.
' WM.SYSCOMMAND = HEXDEC("&H0112") SC.MINIMIZE = HEXDEC("&HF020") SC.MAXIMIZE = HEXDEC("&HF030") SC.RESTORE = HEXDEC("&HF120")
RetVal = 0 GRAPHICBOX #DMO.GFX, 0, 0, 100, 100 TRACE 2 OPEN "SEGMENTS" FOR WINDOW AS #DMO Hndl = HWND(#DMO) CALLDLL #user32, "SendMessageA", Hndl AS ULONG, WM.SYSCOMMAND AS ULONG, _ SC.MINIMIZE AS ULONG, 0 AS LONG, RetVal AS VOID
SegNum = FN.GetSeg("#DMO.GFX")
PRINT #DMO.GFX, "DOWN" PRINT #DMO.GFX, "FILL 0 255 0" RetVal = FN.DelSeg("#DMO.GFX", SegNum) PRINT #DMO.GFX, "FLUSH"
SegNum = FN.GetSeg("#DMO.GFX")
PRINT #DMO.GFX, "COLOR ";255;" ";0;" ";0 PRINT #DMO.GFX, "PLACE 0 0" PRINT #DMO.GFX, "DOWN" PRINT #DMO.GFX, "LINE 0 0 100 100" RetVal = FN.DelSeg("#DMO.GFX", SegNum) PRINT #DMO.GFX, "FLUSH"
PRINT #DMO, "TRAPCLOSE END.SEGS"
CALLDLL #kernel32, "Sleep", 8000 AS LONG, RetVal AS VOID
RetVal = FN.RestoreWin(Hndl) CALLDLL #kernel32, "Sleep", 8000 AS LONG, RetVal AS VOID
RetVal = FN.MaximizeWin(Hndl) [WAIT.FOR.EVENT] WAIT
'----------------------------------------- '-----------------------------------------
SUB END.SEGS Whndl$
CLOSE #Whndl$ END END SUB
'----------------------------------------- '-----------------------------------------
FUNCTION FN.GetSeg(WinTag$)
SegNum = 0 PRINT #WinTag$, "segment SegNum"
FN.DefSeg = SegNum END FUNCTION
'----------------------------------------- '-----------------------------------------
FUNCTION FN.DelSeg(WinTag$, SegTag)
PRINT #WinTag$, "delsegment ";SegTag - 1 END FUNCTION
'----------------------------------------- '-----------------------------------------
FUNCTION FN.RestoreWin(WinHndl)
WM.SYSCOMMAND = HEXDEC("&H0112") SC.RESTORE = HEXDEC("&HF120")
RetVal = 0 CALLDLL #user32, "SendMessageA", WinHndl AS ULONG, WM.SYSCOMMAND AS ULONG, _ SC.RESTORE AS ULONG, 0 AS LONG, RetVal AS VOID END FUNCTION
'----------------------------------------- '-----------------------------------------
FUNCTION FN.MaximizeWin(WinHndl)
WM.SYSCOMMAND = HEXDEC("&H0112") SC.MAXIMIZE = HEXDEC("&HF030")
RetVal = 0 CALLDLL #user32, "SendMessageA", WinHndl AS ULONG, WM.SYSCOMMAND AS ULONG, _ SC.MAXIMIZE AS ULONG, 0 AS LONG, RetVal AS VOID
END FUNCTION '
|
|
|
Post by Walt Decker on Apr 12, 2022 16:53:15 GMT -5
Keyboard functions for use with graphic control function "when characterInput". _VK_NUMPAD appears to be failing on the odd numbers, so I have included work-around code.
I was in a slight rush (and had one of those senior moments) when I posted this so a little more explanation is in order. Unless the NUMLOCK key is pressed, the LB Inkey$ function should not work at all when a number on the number pad is pressed, but it does and interprets the odd numbers as something different. The even numbers it interprets as arrow keys, hence there is no additional choice for the even numbers.
' GRAPHICBOX #DMO.GFX, 0, 0, 150, 150 OPEN "KYBD" FOR WINDOW AS #DMO PRINT #DMO, "TRAPCLOSE END.DMO" PRINT #DMO.GFX, "SETFOCUS" PRINT #DMO.GFX, "when characterInput CHAR.IN" WAIT END
'------------------------------------------------------- '-------------------------------------------------------
SUB CHAR.IN GfxTag$, KeyIn$ KeyPressed$ = ""
Action = 0 ChrLen = 0
PRINT #GfxTag$, "when characterInput" KeyPressed$ = KeyIn$ ChrLen = LEN(KeyPressed$)
SELECT CASE CASE ChrLen < 2 Action = FN.LeftChar(KeyPressed$, Nx, Ny) CASE ChrLen > 1 PRINT "KP = "; RIGHT$(KeyPressed$, 1) Action = FN.RightChar(KeyPressed$, Nx, Ny) END SELECT PRINT Nx, Ny PRINT #GfxTag$, "when characterInput CHAR.IN" END SUB
'------------------------------------------------------- '-------------------------------------------------------
SUB END.DMO DmoHndl$ CLOSE #DmoHndl$ END END SUB
'------------------------------------------------------- '-------------------------------------------------------
FUNCTION FN.LeftChar(Key$, BYREF NewPosX, BYREF NewPosY)
NewPosX = 0 NewPosY = 0 Action = 0
Char$ = LEFT$(Key$, 1)
SELECT CASE UPPER$(Char$) CASE "L", "4" NewPosX = -1 Action = 1 CASE "R", "6" NewPosX = 1 Action = 1 CASE "U", "8" NewPosY = -1 Action = 1 CASE "D", "2" NewPosY = 1 Action = 1 CASE "7" NewPosX = -1 NewPosY = -1 Action = 1 CASE "9" NewPosX = 1 NewPosY = -1 Action = 1 CASE "3" NewPosX = 1 NewPosY = 1 Action = 1 CASE "1" NewPosX = -1 NewPosY = 1 Action = 1 END SELECT
FN.LeftChar = Action END FUNCTION
'--------------------------------------------- '---------------------------------------------
FUNCTION FN.RightChar(Key$, BYREF NewPosX, BYREF NewPosY)
DQ$ = CHR$(34)
NewPosX = 0 NewPosY = 0 Action = 0
Char$ = RIGHT$(Key$, 1)
SELECT CASE Char$ CASE Chr$(_VK_LEFT) NewPosX = -1 Action = 1 CASE Chr$(_VK_RIGHT) NewPosX = 1 Action = 1 CASE Chr$(_VK_DOWN) NewPosY = 1 Action = 1 CASE Chr$(_VK_UP) NewPosY = -1 Action = 1 CASE Chr$(_VK_UP) NewPosY = -1 Action = 1 CASE Chr$(_VK_NUMPAD1), "#" NewPosX = -1 NewPosY = 1 Action = 1 CASE Chr$(_VK_NUMPAD4) NewPosX = -1 Action = 1 CASE Chr$(_VK_NUMPAD7), "$" NewPosX = -1 NewPosY = -1 Action = 1 CASE Chr$(_VK_NUMPAD8) NewPosY = 1 Action = 1 CASE Chr$(_VK_NUMPAD9), "!" NewPosX = 1 NewPosY = -1 Action = 1 CASE Chr$(_VK_NUMPAD6) NewPosX = 1 Action = 1 CASE Chr$(_VK_NUMPAD3), DQ$ NewPosX = 1 NewPosY = 1 Action = 1 CASE Chr$(_VK_NUMPAD2) NewPosY = 1 Action = 1 END SELECT
FN.RightChar = Action END FUNCTION '
|
|
|
Post by Walt Decker on Sept 6, 2022 9:50:59 GMT -5
The following function will return the compass direction between any two points.
' FUNCTION FN.Azimuth(X1, Y1, X2, Y2) '############################################ ' Returns the compass direction from X1, Y1 to ' X2, Y2 ' 0 (zero) is at the top of the compass (circle), ' 90 is at the right of the compass (circle), ' 180 is at the bottom of the compass (circle), ' 270 is at the left of the compass (circle). '############################################
Deg = 0.0 X = 0.0 Y = 0.0
Deg = 180.0 / (4 * ATN(1)) X = X2 - X1 Y = Y2 - Y1
SELECT CASE CASE Y < 0.0
FN.Azimuth = -1 * (ATN(X / Y) * Deg) IF X < 0.0 THEN FN.Azimuth = 360.0 - (ATN(X / Y) * Deg)
CASE Y > 0.0 FN.Azimuth = 180.0 - (ATN(X / Y) * Deg)
CASE Y = 0.0 IF X > 0.0 THEN FN.Azimuth = 90.0 IF X < 0.0 THEN FN.Azimuth = 270.0 END SELECT
END FUNCTION '
|
|
|
Post by Walt Decker on Sept 6, 2022 16:00:31 GMT -5
Some form window and control functions.
' 'FUNCTION FN.WindowGetLoc(WinTag$, BYREF Locx, BYREF Locy) ' Retrieves the screen location of a form window ' 'FUNCTION FN.WindowGetSize(WinTag$, BYREF Sizex, BYREF Sizey) ' Retrieves the size of a form window ' 'FUNCTION FN.WindowGetClient(WinTag$, BYREF CliSizex, BYREF CliSizey) ' Retrieves the client size of a form window ' 'FUNCTION FN.WindowSetLoc(WinTag$, Ux, Uy) ' Sets the screen location of a form window ' 'FUNCTION FN.WindowSetSize(WinTag$, NewWide, NewHigh) ' Sets the size of a form window ' 'FUNCTION FN.WindowSetClient(WinTag$, NewWide, NewHigh) ' Sets the client size of a form window and the overall size of the ' form window ' 'FUNCTION FN.CtrlGetLoc(CtlTag$, BYREF Ulx, BYREF Uly) ' Retrieves the location of a control on its parent form window ' 'FUNCTION FN.CtrlGetSize(CtlTag$, CtrlWide, CtrlHigh) ' Retrieves the overall size of a control ' 'FUNCTION FN.CtrlGetClient(CtlTag$, BYREF CliWide, BYREF CliHigh) ' Retrieves the client size of a control (the size within its ' borders 'FUNCTION FN.CtrlSetLoc(CtlTag$, Ulx, Uly) ' Sets the location of a control on its parent form window ' 'FUNCTION FN.CtrlSetSize(CltTag$, NewSizex, NewSizey) ' Sets the overall size of a control ' 'FUNCTION FN.CtrlSetClient(CtlTag$, NewSizex, NewSizey) ' Sets the size of the area in side a controls border and as a ' consequence sets the overall size of the control ' 'FUNCTION FN.WinTxtLen(Tag$) ' Retrieves the number of characters associated with the title of a ' control. ' In the case of an edit control it retrieves the entire text ' in the control Must be used BEFORE FN.GetWinText(). ' 'FUNCTION FN.GetWinTxt$(Tag$, TextLength) ' Retrieves the text associated with the title of a control. In ' the case of an edit control the function retrieves the entire ' text contained in the control. ' 'FUNCTION FN.SetWinTxt(Tag$, TxtOut$) ' Sets the text associated with the title of a control. In the case ' of an edit control it populates the control with the text.
'################################################################## ' FORM WINDOW FUNCTIONS '##################################################################
FUNCTION FN.WindowGetLoc(WinTag$, BYREF Locx, BYREF Locy)
RetVal = 0 RetVal = FN.WindowRect(WinTag$, Locx, Locy, 0, 0)
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.WindowGetSize(WinTag$, BYREF Sizex, BYREF Sizey)
RetVal = 0
Ulx = 0 Uly = 0
RetVal = FN.WindowRect(WinTag$, Ulx, Uly, Sizex, Sizey)
Sizex = Sizex - Ulx Sizey = Sizey - Uly
END FUNCTION
'---------------------------------------------------- '----------------------------------------------------
FUNCTION FN.WindowGetClient(WinTag$, BYREF CliSizex, BYREF CliSizey)
RetVal = 0 RetVal = FN.ClientRect(WinTag$, CliSizex, CliSizey)
END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.WindowSetLoc(WinTag$, Ux, Uy)
RetVal = 0 Szx = 0 Szy = 0
RetVal = FN.WindowRect(WinTag$, 0, 0, Szx, Szy) RetVal = FN.MoveWindow(WinTag$, Ux, Uy, Szx, Szy)
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.WindowSetSize(WinTag$, NewWide, NewHigh)
Ux = 0 Uy = 0 RetVal = FN.WindowRect(WinTag$, Ux, Uy, 0, 0) RetVal = FN.MoveWindow(WinTag$, Ux, Uy, NewWide, NewHigh)
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.WindowSetClient(WinTag$, NewWide, NewHigh)
RetVal = 0
OldWide = 0 OldHigh = 0
Ulx = 0 Uly = 0 Brx = 0 Bry = 0
DifWide = 0 DifHigh = 0
RetVal = FN.WindowRect(WinTag$, Ulx, Uly, Brx, Bry) RetVal = FN.ClientRect(WinTag$, OldWide, OldHigh)
DifWide = NewWide - OldWide DifHigh = NewHigh - OldHigh Brx = Brx - Ulx + DifWide Bry = Bry - Uly + DifHigh
RetVal = FN.MoveWindow(WinTag$, Ulx, Uly, Brx, Bry)
END FUNCTION
'################################################################## ' CONTROL WINDOW FUNCTIONS '##################################################################
FUNCTION FN.CtrlGetLoc(CtlTag$, BYREF Ulx, BYREF Uly)
WinTag$ = ""
WinHndl = 0 RetVal = 0
RetVal = INSTR(CtlTag$, ".") WinTag$ = LEFT$(CtlTag$, RetVal - 1) WinHndl = FN.GetHndl(WinTag$)
RetVal = FN.WindowRect(CtlTag$, Ulx, Uly, 0, 0) RetVal = FN.MapPoints(0, WinHndl, Ulx, Uly, 0, 0)
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.CtrlGetSize(CtlTag$, CtrlWide, CtrlHigh)
RetVal = 0
Ulx = 0 Uly = 0
RetVal = FN.WindowRect(CtlTag$, Ulx, Uly, CtrlWide, CtrlHigh)
CtrlWide = CtrlWide - Ulx CtrlHigh = CtrlHigh - Uly
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.CtrlGetClient(CtlTag$, BYREF CliWide, BYREF CliHigh)
RetVal = 0 RetVal = FN.ClientRect(CtlTag$, CliWide, CliHigh)
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.CtrlSetLoc(CtlTag$, Ulx, Uly)
WinTag$ = ""
RetVal = 0 Xsize = 0 Ysize = 0
RetVal = FN.CtrlGetSize(CtlTag$, Xsize, Ysize)
RetVal = INSTR(CtlTag$, ".") WinTag$ = LEFT$(CtlTag$, RetVal - 1) WinTag$ = FN.CheckTag$(WinTag$)
#CtlTag$, "!LOCATE ";Ulx;" ";Uly;" ";Xsize;" ";Ysize #WinTag$, "REFRESH"
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.CtrlSetSize(CltTag$, NewSizex, NewSizey)
WinTag$ = ""
RetVal = 0
Ulx = 0 Uly = 0
RetVal = FN.CtrlGetLoc(CtlTag$, Ulx, Uly)
RetVal = INSTR(CtlTag$, ".") WinTag$ = LEFT$(CtlTag$, RetVal - 1) WinTag$ = FN.CheckTag$(WinTag$)
#CtlTag$, "!LOCATE ";Ulx;" ";Uly;" ";NewSizex;" ";NewSizey #WinTag$, "REFRESH"
END FUNCTION
'--------------------------------------------------- '---------------------------------------------------
FUNCTION FN.CtrlSetClient(CtlTag$, NewSizex, NewSizey)
WinTag$ = ""
RetVal = 0
Ulx = 0 Uly = 0
CtlWide = 0 CtlHigh = 0 OldWide = 0 OldHigh = 0 DifWide = 0 DifHigh = 0
RetVal = FN.CtrlGetLoc(CtlTag$, Ulx, Uly) RetVal = FN.CtrlGetSize(CtlTag$, CtlWide, CtlHigh) RetVal = FN.CtrlGetClient(CtlTag$, OldWide, OldHigh)
DifWide = NewSizex - OldWide DifHigh = NewSizey - OldHigh CtlWide = CtlWide + DifWide CtlHigh = CtlHigh + DifHigh
RetVal = INSTR(CtlTag$, ".") WinTag$ = LEFT$(CtlTag$, RetVal - 1)
#CtlTag$, "!LOCATE ";Ulx;" ";Uly;" ";CtlWide;" ";CtlHigh #WinTag$, "REFRESH"
END FUNCTION
'################################################################## ' WINDOW TEXT FUNCTIONS '##################################################################
FUNCTION FN.WinTxtLen(Tag$)
WinHndl = 0 TxtLen = 0
WinHndl = FN.GetHndl(Tag$)
CALLDLL #user32, "GetWindowTextLengthA", WinHndl AS ULONG, TxtLen AS LONG
FN.WinTxtLen = TxtLen END FUNCTION
'------------------------------------------------------- '-------------------------------------------------------
FUNCTION FN.GetWinTxt$(Tag$, TextLength)
WinHndl = 0 NumChrs = 0
TxtOut$ = ""
WinHndl = FN.GetHndl(Tag$) NumChrs = TextLength + 1 TxtOut$ = SPACE$(NumChrs) CALLDLL user32, "GetWindowTextA", WinHndl AS ULONG, TxtOut$ AS STRUCT, _ NumChrs AS LONG, TextLength AS LONG
TxtOut$ = LEFT$(TxtOut$, TextLength) FN.GetWinTxt$ = TxtOut$ END FUNCTION
'------------------------------------------------------- '-------------------------------------------------------
FUNCTION FN.SetWinTxt(Tag$, TextOut$)
RetVal = 0
WinHndl = FN.GetHndl(Tag$)
CALLDLL #user32, "SetWindowTextA", WinHndl AS ULONG, TextOut$ AS PTR, _ RetVal AS VOID END FUNCTION
'################################################################## ' SUPPORT FUNCTIONS '##################################################################
FUNCTION FN.WindowRect(WinTag$, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
RetVal = 0
WinHndl = FN.GetHndl(WinTag$) RetVal = FN.ZeroRect(0, 0, 0, 0)
'<======= get overall size of window (form or control) ============> CALLDLL #user32, "GetWindowRect", WinHndl AS ULONG, tRect AS STRUCT, _ RetVal AS VOID Ux = tRect.X.struct Uy = tRect.Y.struct Bx = tRect.X1.struct By = tRect.Y1.struct
END FUNCTION
'--------------------------------------------- '---------------------------------------------
FUNCTION FN.ClientRect(WinTag$, BYREF Bx, BYREF By)
RetVal = 0
WinHndl = FN.GetHndl(WinTag$) RetVal = FN.ZeroRect(0, 0, 0, 0)
'<========= get client size of window (form or control =============> CALLDLL #user32, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, _ RetVal AS VOID Bx = tRect.X1.struct By = tRect.Y1.struct END FUNCTION
'--------------------------------------------- '---------------------------------------------
FUNCTION FN.CheckTag$(WinTag$)
IF LEFT$(WinTag$, 1) <> "#" THEN WinTag$ = "#" + WinTag$
FN.CheckTag$ = WinTag$ END FUNCTION
'--------------------------------------------- '---------------------------------------------
FUNCTION FN.GetHndl(WinTag$)
WinHndl = 0
WinTag$ = FN.CheckTag$(WinTag$) WinHndl = HWND(#WinTag$)
FN.GetHndl= WinHndl END FUNCTION
'--------------------------------------------- '---------------------------------------------
FUNCTION FN.MapPoints(FromHndl, ToHndl, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
RetVal = 0 FromHndl = 0 ToHndl = 0
RetVal = FN.ZeroRect(Ux, Uy, Bx, By)
'<======== translate coordinates from FromHndl to those of ToHndl ===========> CALLDLL #user32, "MapWindowPoints", FromHndl AS ULONG, ToHndl AS ULONG, _ tRect AS STRUCT, 2 AS LONG, RetVal AS VOID
Ux = tRect.X.struct Uy = tRect.Y.struct Bx = tRect.X1.struct By = tRect.Y1.struct
END FUNCTION
'------------------------------------------ '------------------------------------------
FUNCTION FN.MoveWindow(WinTag$, Ulx, Uly, Xwide, Yhigh)
WinHndl = FN.GetHndl(WinTag$) RetVal = 0 CALLDLL #user32, "MoveWindow", WinHndl AS ULONG, Ulx AS LONG, Uly AS LONG, _ Xwide AS LONG, Yhigh AS LONG, 1 AS LONG, RetVal AS VOID
END FUNCTION
'------------------------------------ '------------------------------------
FUNCTION FN.ZeroRect(r1, r2, r3, r4)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
tRect.X.struct = r1 tRect.Y.struct = r2 tRect.X1.struct = r3 tRect.Y1.struct = r4
END FUNCTION
'[code]
|
|
|
Post by Walt Decker on Oct 30, 2022 15:48:25 GMT -5
The following 3 functions can be used to retrieve or set the caption of any window or control. With list boxes the caption returned may be empty because of the way the list box is leveraged. With combo boxes the caption returned will be the text contained in the edit control portion of the combo box. With edit controls, the text returned will be the entire contents of the edit control.
WinTag$ = the string representation of the window or control creation tag. For example:
TEXTBOX #MYWIN.EDT .....
the WinTag$ = "#MYWIN.EDT"
OPEN "MY WIN" FOR WINDOW AS #MYWIN
the WinTag$ = "#MYWIN"
'
FUNCTION FN.GetCaptionLen(WinTag$)
NumChrs = 0
WinHndl = HWND(#WinTag$) CALLDLL #user32, "GetWindowTextLengthA", WinHndl AS ULONG, NumChrs AS LONG
FN.GetCaptionLen = NumChrs END FUNCTION
'-------------------------------- '--------------------------------
FUNCTION FN.GetCaptionTxt$(WinTag$)
WinHndl = 0 NumChrs = 0
TxtOut$ = ""
NumChrs = FN.GetCaptionLen(WinTag$)
WinHndl = HWND(#WinTag$) TxtOut$ = SPACE$(NumChrs + 1) CALLDLL #user32, "GetWindowTextA", WinHndl AS ULONG, TxtOut$ AS STRUCT, _ NumChrs AS LONG TxtOut$ = LEFT$(TxtOut$, NumChrs)
FN.GetCaptionTxt$ = TxtOut$ END FUNCTION
'-------------------------------- '--------------------------------
FUNCTION FN.SetCaptionTxt(WinTag$, TxtOut$)
RetVal = 0
WinHndl = HWND(#WinTag$)
CALLDLL #user32, "SetWindowTextA", WinHndl AS ULONG, TxtOut$ AS PTR, RetVal AS VOID
END FUNCTION
'
|
|
|
Post by Walt Decker on Nov 4, 2022 10:31:31 GMT -5
Resizeable controls:
The following will work with all of LB's controls EXCEPT combobox, bmpbutton, static, and group.
' WindowWidth = 400 WindowHeight = 400
WS.THICKFRAME = HEXDEC("&H00040000")
DIM A$(49) FOR I = 0 TO 49 A$(I) = "LINE NO. " + STR$(I +1) NEXT I
STYLEBITS #TST.TXT, WS.THICKFRAME, 0, 0, 0 TEXTBOX #TST.TXT, 5, 5, 50, 25
OPEN "TEST" FOR WINDOW AS #TST WAIT
SUB TST.BTN BTNHNDL$ END SUB '
|
|