|
Post by Walt Decker on Nov 19, 2021 16:44:58 GMT -5
For those who want tabs without the convenience of a tab control, I have created the following Tabs without Control:
' '<------------------------- window styles -------------> WS.CHILD = HEXDEC("&H40000000") WS.VISIBLE = HEXDEC("&H10000000") WS.CLIPCHILDREN = HEXDEC("&H02000000") WS.DLGFRAME = HEXDEC("&H00400000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000") WS.THICKFRAME = HEXDEC("&H00040000")
'<----------------------- button styles --------------> BS.AUTORADIOBUTTON = HEXDEC("&H00000009") BS.PUSHLIKE = HEXDEC("&H00001000") BS.FLAT = HEXDEC("&H00008000") BS.BUTTON = WS.GROUP OR WS.TABSTOP OR BS.AUTORADIOBUTTON OR _ BS.FLAT OR BS.PUSHLIKE
'<----------------- tab flags -------------> GLOBAL Repair.Tab, _ Repair.Lst, _ Cost.Tab, _ Cost.Lst
'<---------------- bottm of buttons ----------> GLOBAL RepairBtnLow, _ CostBtnLow
GLOBAL RepairBx, _ RepairBy
'<-------------- tab controls ---------------> DIM RepairTab$(2, 1) DIM CostTab$(1,1)
RepairTab$(0, 0) = "#MAKE" RepairTab$(0, 1) = "#REPAIR.MAKE" RepairTab$(1, 0) = "#MODL" RepairTab$(1, 1) = "#REPAIR.MODL" RepairTab$(2, 0) = "#COST" RepairTab$(2, 1) = "#REPAIR.COST"
CostTab$(0, 0) = "#PARTS" CostTab$(0, 1) = "#COST.PARTS" CostTab$(1, 0) = "#LABOR" CostTab$(1, 1) = "#COST.LABOR"
Style = WS.CHILE OR WS.VISIBLE OR WS.DLGFRAME
OPEN "User32.dll" FOR DLL AS #USER
'<------------------- create tabs ------------------> STYLEBITS #REPAIR.MAKE, BS.BUTTON, 0, 0, 0 STYLEBITS #REPAIR.MODL, BS.BUTTON, 0, 0, 0 STYLEBITS #REPAIR.COST, BS.BUTTON, 0, 0, 0
STYLEBITS #COST.PARTS, BS.BUTTON, 0, 0, 0 STYLEBITS #COST.LABOR, BS.BUTTON, 0, 0, 0
RADIOBUTTON #REPAIR.MAKE, "MAKE", REP.BTN, REP.BTN, 5, 5, 45, 20 RADIOBUTTON #REPAIR.MODL, "MODEL", REP.BTN, REP.BTN, 45, 5, 45, 20 RADIOBUTTON #REPAIR.COST, "COST", REP.BTN, REP.BTN, 85, 5, 45, 20
RADIOBUTTON #COST.PARTS, "PARTS", COST.BTN, COST.BTN, 5, 5, 45, 20 RADIOBUTTON #COST.LABOR, "LABOR", COST.BTN, COST.BTN, 45, 5, 45, 20
'<-------------- destinguish one tab window from another ----------> STATICTEXT #MAKE.STAT, "THIS IS MAKE WINDOW", 25, 25, 150, 20 STATICTEXT #MODL.STAT, "THIS IS MODEL WINDOW", 25, 25, 150, 20 STATICTEXT #PARTS.STAT, "THIS IS PARTS WINDOW", 25, 25, 150, 20 STATICTEXT #LABOR.STAT, "THIS IS LABOR WINDOW", 25, 25, 150, 20
'<---------------- create windows -----------------> STYLEBITS #REPAIR, 0, WS.THICKFRAME, 0, 0 '<--- main window
'<------------------------- tab windows---------------> STYLEBITS #COST, 0, WS.THICKFRAME, 0, 0 STYLEBITS #MAKE, 0, WS.THICKFRAME, 0, 0 STYLEBITS #MODL, 0, WS.THICKFRAME, 0, 0 STYLEBITS #PARTS, 0, WS.THICKFRAME, 0, 0 STYLEBITS #LABOR, 0, WS.THICKFRAME, 0, 0
OPEN "REPAIR" FOR WINDOW AS #REPAIR
'<------------------ get size of main window ------------> RetVal = FN.ClientSize("#REPAIR", RepairBx, RepairBy)
'<------------------ get size of tab buttons ------------> RetVal = FN.WindowSize("#REPAIR.MAKE", Ux, Uy, Bx, By) RepairBtnLow = By
'<---------------- translate bottom of button to window ------> RetVal = FN.ScreenToClient("#REPAIR", 0, RepairBtnLow)
OPEN "MAKE" FOR WINDOW AS #MAKE OPEN "MODEL" FOR WINDOW AS #MODL OPEN "COST" FOR WINDOW AS #COST OPEN "PARTS" FOR WINDOW AS #PARTS OPEN "LABOR" FOR WINDOW AS #LABOR
'<----------------- hide tab windows ------------> RetVal = FN.Hide("#MODL") RetVal = FN.Hide("#COST") RetVal = FN.Hide("#PARTS") RetVal = FN.Hide("#LABOR")
'<---------- set tab windows to main window -------> RetVal = FN.SetParent("#MAKE", "#REPAIR") RetVal = FN.Style("#MAKE", Style, 0) RetVal = FN.ClientSize("#MAKE", 0, Z)
Z = Z - RepairBntLow - 30 RetVal = FN.MoveWin("#MAKE", 0, RepairBtnLow, RepairBx, Z, 1)
RetVal = FN.SetParent("#MODL", "#REPAIR") RetVal = FN.Style("#MODL", Style, 0) RetVal = FN.MoveWin("#MODL", 0, RepairBtnLow, RepairBx, Z, 1)
'<------------------- set tab windows to tab window ----------> RetVal = FN.SetParent("#PARTS", "#COST") RetVal = FN.Style("#PARTS", Style, 0) RetVal = FN.MoveWin("#PARTS", 0, RepairBtnLow, RepairBx, Z, 1)
RetVal = FN.SetParent("#LABOR", "#COST") RetVal = FN.Style("#LABOR", Style, 0) RetVal = FN.MoveWin("#LABOR", 0, RepairBtnLow, RepairBx, Z, 1)
'<--------------- set tab window to main window -----------> RetVal = FN.SetParent("#COST", "#REPAIR") RetVal = FN.Style("#COST", Style, 0) RetVal = FN.MoveWin("#COST", 0, RepairBtnLow, RepairBx, Z, 1)
'<-- get control ID number for calculations in event handlers -----> Repair.Tab = FN.GetCtrlId("#REPAIR.MAKE") Repair.Lst = Repair.Tab
Cost.Tab = FN.GetCtrlId("#COST.PARTS") Cost.Lst = Cost.Tab
'<--------------- hide windows again --------> RetVal = FN.Hide("#PARTS") RetVal = FN.Hide("#LABOR") RetVal = FN.Hide("#COST") RetVal = FN.Hide("#MODL") RetVal = FN.Show("#MAKE")
'<-------------- set radio buttons (tabs) -----------> PRINT #REPAIR.MAKE, "SET" PRINT #COST.PARTS, "SET" RetVal = FN.Hide("#PARTS")
PRINT #REPAIR, "TRAPCLOSE QUIT.REPAIR" WAIT
'------------------------------------------------------------------- '-------------------------------------------------------------------
SUB REP.BTN BtnHndl$
CurBtn = 0 LstBtn = 0 RetVal = 0
BtnName$ = "" WinName$ = ""
CurBtn = FN.GetCtrlId(BtnHndl$) '<--- get tab ID number
IF CurBtn = RePair.Lst THEN EXIT SUB
LstBtn = Repair.Lst - Repair.Tab '<--- calculate last tab index
WinName$ = RepairTab$(LstBtn, 0) '<--- name of last tab window BtnName$ = RepairTab$(LstBtn, 1) '<--- name of last tab
PRINT #BtnName$, "RESET" '<--- deactivate the last tab
RetVal = FN.Hide(WinName$) '<--- hide the window LstBtn = CurBtn - Repair.Tab '<--- calculate curren tab index WinName$ = RepairTab$(LstBtn, 0) '<--- name of current tab window RetVal = FN.Show(WinName$) '<--- activate current tab window
PRINT #BtnHndl$, "SET" '<--- set current tab Repair.Lst = CurBtn '<--- save it for later use
IF LstBtn = 2 THEN WinName$ = CostTab$(0, 0) '<--- show tab within tab RetVal = FN.Show(WinName$) END IF
END SUB
'------------------------------------------------------------------- '-------------------------------------------------------------------
SUB COST.BTN BtnHndl$ '########################################### ' see SUB REP.BTN '###########################################
CurBtn = 0 LstBtn = 0 RetVal = 0
BtnName$ = "" WinName$ = ""
CurBtn = FN.GetCtrlId(BtnHndl$)
IF CurBtn = Cost.Lst THEN EXIT SUB
LstBtn = Cost.Lst - Cost.Tab
WinName$ = CostTab$(LstBtn, 0) BtnName$ = CostTab$(LstBtn, 1)
PRINT #BtnName$, "RESET"
RetVal = FN.Hide(WinName$) LstBtn = CurBtn - Cost.Tab WinName$ = CostTab$(LstBtn, 0) RetVal = FN.Show(WinName$)
PRINT #BtnHndl$, "SET" Cost.Lst = CurBtn
END SUB
'------------------------------------------------------------------- '-------------------------------------------------------------------
SUB QUIT.REPAIR WinHndl$ '############################################ ' Kill ALL '############################################
CLOSE #USER CLOSE #REPAIR CLOSE #MAKE CLOSE #MODL CLOSE #COST CLOSE #PARTS CLOSE #LABOR END END SUB
'------------------------------------------------------------------- '-------------------------------------------------------------------
FUNCTION FN.ClientSize(WinName$, BYREF Bx, BYREF By)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$)
CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, _ RetVal AS VOID
Bx = tRect.X1.struct By = tRect.Y1.struct
END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.WindowSize(WinName$, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$)
CALLDLL #USER, "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.SetParent(Child$, NewParent$)
KidHndl = 0 NewHndl = 0
OrigParent = 0
IF LEFT$(Child$, 1) <> "#" THEN Child$ = "#" + Child$ IF LEFT$(NewParent$, 1) <> "#" THEN NewParent$ = "#" + NewParent$
KidHndl = HWND(#Child$) NewHndl = HWND(#NewParent$)
CALLDLL #USER, "SetParent", KidHndl AS ULONG, NewHndl AS ULONG, _ OrigParent AS ULONG
FN.SetParent = OrigParent END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.ScreenToClient(WinName$, BYREF PosX, BYREF PosY)
STRUCT tPnt, _ X AS LONG, _ Y AS LONG
WinHndl = 0 RetVal = 0
tPnt.X.struct = PosX tPnt.Y.struct = PosY
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$) CALLDLL #USER, "ScreenToClient", WinHndl AS ULONG, tPnt AS STRUCT, _ RetVal AS VOID PosX = tPnt.X.struct PosY = tPnt.Y.struct END FUNCTION
'---------------------------------------------------------------------- '----------------------------------------------------------------------
FUNCTION FN.MoveWin(WinName$, Ux, Uy, Wide, High, Redraw)
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$) CALLDLL #USER, "MoveWindow", WinHndl AS ULONG, Ux AS LONG, Uy AS LONG, _ Wide AS LONG, High AS LONG, Redraw AS LONG, _ RetVal AS VOID END FUNCTION
'------------------------------------------------------------ '------------------------------------------------------------
FUNCTION FN.GetCtrlId(CtlName$)
CtlHndl = 0 CtlId = 0
IF LEFT$(CtlName$, 1) <> "#" THEN CtlName$ = "#" + CtlName$
CtlHndl = HWND(#CtlName$) CALLDLL #USER, "GetDlgCtrlID", CtlHndl AS ULONG, CtlHndl AS LONG
FN.GetCtrlId = CtlHndl END FUNCTION
'------------------------------------------------------------ '------------------------------------------------------------
FUNCTION FN.Show(WinName$)
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$) CALLDLL #USER, "ShowWindow", WinHndl AS ULONG, 1 AS LONG, _ RetVal AS VOID
END FUNCTION
'------------------------------------------------------------ '------------------------------------------------------------
FUNCTION FN.Hide(WinName$)
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$) CALLDLL #USER, "ShowWindow", WinHndl AS ULONG, 0 AS LONG, _ RetVal AS VOID
END FUNCTION
'------------------------------------------------------------ '------------------------------------------------------------
FUNCTION FN.Style(WinName$, Style, ExStyle)
GWL.STYLE = -16 GWL.EXSTYLE = -20
WinHndl = 0 RetVal = 0
IF LEFT$(WinName$, 1) <> "#" THEN WinName$ = "#" + WinName$
WinHndl = HWND(#WinName$) CALLDLL #USER, "SetWindowLongA", WinHndl AS ULONG, GWL.STYLE AS LONG, _ Style AS ULONG, RetVal AS VOID CALLDLL #USER, "SetWindowLongA", WinHndl AS ULONG, GWL.EXSTYLE AS LONG, _ ExStyle AS ULONG, RetVal AS VOID
END FUNCTION '
|
|
|
Post by dan1101 on Nov 22, 2021 11:03:19 GMT -5
Very handy. I like how it remembers which child-window (parts or labor in the example) was used most recently and reopens with the same sub-window open when you select the parent tab again. Logical and user-friendly. Thanks for adding another useful snippet to my growing library.
|
|
|
Post by Walt Decker on Nov 22, 2021 11:29:42 GMT -5
You are welcome. Personally, I would never use that code. A real tab control is more convenient.
Do not just copy and paste. It takes some thought to get stuff in the right order.
|
|
|
Post by Walt Decker on Dec 1, 2021 13:41:38 GMT -5
Get a handle for a form window or control:
CtlHndl = FN.GetHandle("#WIN.GFX")
WinHndl = FN.GetHandle("WIN")
FUNCTION FN.GetHandle(WinTag$)
Handle = 0
IF LEFT$(WinTag$, 1) <> "#" THEN WinTag$ = "#" + WinTag$
Handle = HWND(#WinTag$)
FN.GetHandle = Handle END FUNCTION
|
|
|
Post by Walt Decker on Dec 4, 2021 10:42:04 GMT -5
Some generic graphics functions.
BmpHndl = FN.BmpLoad("YOUR TAG", "YOUR BITMAP FILE NAME")
FUNCTION FN.BmpLoad(Tag$, BmpName$) '################################################ ' Load a bitmap from mass storage '################################################
BmpHndl = 0 LOADBMP Tag$, BmpName$
BmpHndl = HBMP(Tag$)
FN.BmpLoad = BmpHndl END FUNCTION
X = 5 Y = 5 RetVal = FN.BmpRender("YOUR TAG", "#YOUR GRAPHIC CONTROL", X, Y)
FUNCTION FN.BmpRender(Tag$, CtlTag$, PosX, PosY) '################################################ ' Display a bitmap in a graphic with the upper ' left corner at PosX, PosY '################################################
IF LEFT$(CtlTag$, 1) <> "#" THEN CtlTag$ = "#" + CtlTag$
PRINT #CtlTag$, "down" PRINT #CtlTag$, "drawbmp ";Tag$;" ";PosX;" ";PosY PRINT #CtlTag$, "flush"
END FUNCTION
X = 5 Y = 5 X1 = 50 Y1 = 50
RetVal = FN.CaptureGfx("YOUR TAG", "#YOUR GFX CONTROL", _ X, Y, X1, Y1)
FUNCTION FN.CaptureGfx(Tag$, CtlTag$, Sx, Sy, Ex, Ey) '################################################ ' Create a memory bitmap from all or a portion of ' a graphic control '################################################
IF LEFT$(CtlTag$, 1) <> "#" THEN CtlTag$ = "#" + CtlTag$
PRINT #CtlTag, "getbmp ";Tag$;" ",Sz;" ";Sy;" ";Ex;" ";Ey
END FUNCTION
|
|
|
Post by Walt Decker on Dec 13, 2021 13:42:50 GMT -5
Change caret size in an edit control (LB's TEXTBOX)
TEXTBOX #DMO.EDT, 5, 5, 125, 25
OPEN "CARET" FOR WINDOW AS #DMO PRINT #DMO.EDT, "!setfocus" EdtHndl = FN.GetHandle("DMO.EDT")
RetVal = FN.SetCaretSize(EdtHndl, 2, 20) '<--- 2 pix wide by 20 pix high WAIT
'---------------------------------------------- '----------------------------------------------
FUNCTION FN.GetHandle(Tag$)
Hndl = 0
Tag$ = FN.CheckTag$(Tag$)
Hndl = HWND(#Tag$) FN.GetHandle = Hndl END FUNCTION
'----------------------------------------------- '-----------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$ END FUNCTION
'----------------------------------------------- '-----------------------------------------------
FUNCTION FN.SetCaretSize(EdtHandle, Wide, High)
RetVal = 0 CALLDLL #user32, "CreateCaret", EdtHandle AS ULONG, 0 AS LONG, _ Wide AS LONG, High AS LONG, RetVal AS VOID
CALLDLL #user32, "ShowCaret", EdtHandle AS ULONG, RetVal AS VOID END FUNCTION
I do not use LB's TEXTEDITOR, but I imagine it will work for that also although I think the handle of the parent window of the control will have to be obtained instead of the handle of the control.
The CreateCaret() function and others can be found in the thread "Things You Do Not Want to Know..." in topic "DEVICES" sub-topic "KEYBOARD CARET". If you do not have the reader you can get it at post 35 of that thread.
|
|
|
Post by Walt Decker on Dec 15, 2021 13:18:26 GMT -5
A couple of little swap functions.
Use FN.If.Swap() to check the input variables and swap them if necessary. Use FN.Swap() to swap variables regardless of their values.
Bry = 10 Uly = 75
RetVal = FN.If.Swap(Uly, Bry) FUNCTION FN.If.Swap(BYREF Varb1, BYREF Varb2)
TmpVarb = 0
IF Varb1 > Varb2 THEN TmpVarb = Varb1 Varb1 = Varb2 Varb2 = TmpVarb END IF
FN.If.Swap = TmpVarb '<--- if swap occured TmpVarb <> zero END FUNCTION
Uly = 75 Bry = 125
RetVal = FN.Swap(Uly, Bry)
FUNCTION FN.Swap(BYREF Varb1, BYREF Varb2)
TmpVarb = Varb2 Varb1 = Varb2 Varb2 = TmpVarb
FN.Swap = Varb1 * Varb2 END FUNCTION
|
|
|
Post by Walt Decker on Dec 18, 2021 14:23:30 GMT -5
A couple of useful string functions:
'
A$ = "Peter Piper " B$ = FN.StrRepeat$(A$, 5) PRINT B$
END FUNCTION FN.StrRepeat$(StrIn$, Repeat)
I = 0
OutStr$ = ""
FOR I = 1 TO Repeat OutStr$ = OutStr$ + StrIn$ NEXT I
FN.StrRepeat$ = OutStr$ END FUNCTION
'
' A$ = "Peter Piper " B$ = FN.StrInsert$(A$, "is a ", 6) PRINT B$ END
FUNCTION FN.StrInsert$(MainStr$, StrIn$, After)
MainLen = 0 OutStr$ = ""
MainLen = LEN(MainStr$) IF After > MainLen THEN OutStr$ = MainStr$ + StrIn$ FN.StrInsert$ = OutStr$ EXIT FUNCTION END IF
IF After < 1 THEN OutStr$ = StrIn$ + MainStr$ FN.StrInsert$ = OutStr$ EXIT FUNCTION END IF
OutStr$ = LEFT$(MainStr$, After) + StrIn$ + MID$(MainStr$, After + 1)
FN.StrInsert$ = OutStr$ END FUNCTION '
|
|
|
Post by Walt Decker on Jan 14, 2022 15:56:29 GMT -5
' '############################################################### ' SYNCRONIZED EDIT CONTROLS ' NUMBERMANDLL IS HERE: https://libertybasiccom.proboards.com/thread/1400/numbers ' CTL_COLOR IS HERE: https://libertybasiccom.proboards.com/board/9/api-dll-code '###############################################################
'<-------------- CONTROL STYLES -----------> WS.VSCROLL = HEXDEC("&H00200000") WS.HSCROLL = HEXDEC("&H00100000") WS.VISIBLE = HEXDEC("&H10000000") WS.CHILD = HEXDEC("&H40000000")
ES.MULTILINE = HEXDEC("&H0004") ES.AUTOHSCROLL = HEXDEC("&H0080") ES.AUTOVSCROLL = HEXDEC("&H0040") ES.WANTRETURN = HEXDEC("&H1000") ES.NOHIDESEL = HEXDEC("&H0100")
'<--------- EDIT CONTROL MESSAGES ----------> EM.GETTHUMB = HEXDEC("&H00BE") EM.LINEFROMCHAR = HEXDEC("&H00C9") EM.GETSEL = HEXDEC("&H00B0") EM.LINESCROLL = HEXDEC("&H00B6")
VK.LBUTTON = 1 '<--- left mouse button VK.RETURN = HEXDEC("&H0D") '<--- keyboard enter key
SB.VERT = 1 '<--- scroll bar type
'<--------- COLORS ----------> TXTRED = 255 TXTCORNSILK = HEXDEC("&HDCF8FF")
OPEN "User32.dll" FOR DLL AS #USER OPEN "NUMBERMANDLL" FOR DLL AS #NUM OPEN "CTL_COLOR.DLL" FOR DLL AS #CLRCTRL
I = 0 '<--- counters J = 0 K = 0
CtlHndl = 0
CtlLow = 0 '<--- lowest control ID number 'each control on a form window 'is given a unique ID number. 'this is used to calculate the 'element of Handles$() to use.
LstThumb = 0 '<--- scroll bar thumb position. The 'thumb is the box in the scroll bar. LstCtrl = 0 '<--- the control that last had the focus 'used if none of the list boxes has the 'focus. LstLine = 0 Ubnd = 2 '<--- number of row elements in Handles$()
CRLF$ = CHR$(13) + CHR$(10)
DIM Lft$(50) DIM Mdl$(50) DIM Rgt$(50) DIM Handles$(2, 2)
'<--------------- FILL ARRAY FOR INSERTION INTO EACH CONTROL ------> J = 50 K = 50 FOR I = 0 TO 50 Lft$(I) = STR$(I) + CRLF$ '<--- add CRLF for each line K = K + 1 Mdl$(I) = STR$(K) + CRLF$ J = J - 1 Rgt$(I) = STR$(J) + CRLF$ NEXT I
Handles$(0, 0) = "#DMO.TXBL" Handles$(1, 0) = "#DMO.TXBM" Handles$(2, 0) = "#DMO.TXBR"
Style = WS.VSCROLL OR ES.MULTILINE OR ES.AUTOVSCROLL OR ES.WANTRETURN OR _ ES.CHILD OR ES.WANTRETURN OR ES.NOHIDESEL
STYLEBITS #DMO.TXBL, Style, WS.HSCROLL OR ES.AUTHOHSCROLL, 0, 0 STYLEBITS #DMO.TXBM, Style, WS.HSCROLL OR ES.AUTHOHSCROLL, 0, 0 STYLEBITS #DMO.TXBR, Style, WS.HSCROLL OR ES.AUTHOHSCROLL, 0, 0
TEXTBOX #DMO.TXBL, 5, 5, 75, 65 TEXTBOX #DMO.TXBM, 80, 5, 75, 65 TEXTBOX #DMO.TXBR, 155, 5, 75, 65
OPEN "TBX" FOR WINDOW AS #DMO
Handles$(0, 1) = STR$(FN.GetHandle("DMO.TXBL")) '<--- get edit control handles Handles$(1, 1) = STR$(FN.GetHandle("DMO.TXBM")) Handles$(2, 1) = STR$(FN.GetHandle("DMO.TXBR"))
CtlHndl = FN.GetHandle("#DMO.TXBL") LstCtrl = CtlHndl
CtlId = FN.GetCtlId(CtlHndl) '<--- get listbox control ID number 'the fist listbox defined will have the 'lowest ID number CtlLow = CtlId '<--- set for later calculations
'<-------- SET EDIT CONTROL PROPERTIES FOR CTL_COLOR.DLL -------------> RetVal = FN.SetCtrlColor("#DMO.TXBL", "TEXT", "BKG", TXTRED, TXTCORNSILK) RetVal = FN.SetCtrlColor("#DMO.TXBM", "TEXT", "BKG", 1, TXTCORNSILK) RetVal = FN.SetCtrlColor("#DMO.TXBR", "TEXT", "BKG", 1, TXTCORNSILK)
'<----------- INITIALIZE CTL_COLOR.DLL --------------> RetVal = FN.InitClrCtrl("#DMO", "TEXT", "BKG", 0, 0)
'<-------------- PUT DATA IN EDIT CONTROLS ----------> RetVal = FN.PopulateCtrl("#DMO.TXBL", 50, 1) RetVal = FN.PopulateCtrl("#DMO.TXBM", 50, 2) RetVal = FN.PopulateCtrl("#DMO.TXBR", 50, 3)
'<--------- SET THE CARET TO THE TOP ----------> RetVal = FN.SetSelect("DMO.TXBL", 0, 0) RetVal = FN.SetSelect("DMO.TXBM", 0, 0) RetVal = FN.SetSelect("DMO.TXBR", 0, 0)
'<---------- SCROLL THE TEXT INTO VIEW --------> RetVal = FN.ScrollCaret("DMO.TXBL") RetVal = FN.ScrollCaret("DMO.TXBM") RetVal = FN.ScrollCaret("DMO.TXBR")
PRINT #DMO, "TRAPCLOSE END.DMO"
PRINT #DMO.TXBL, "!SETFOCUS"
[BEGIN.TIMER] '<--- begin event trap TIMER 100, [GET.SCROLL]
WAIT
'------------------------------------------------------ '------------------------------------------------------
[GET.SCROLL] '##################################################### ' This is the work-horse of the demo. It is similar to ' a windows callback function except it does not fire ' all the time. Normally I would put most of this in ' functions but I think that keeping it together is a ' little more instructive. '#####################################################
RetVal = 0 '<--- mostly a dummy variable CtlHndl = 0 '<--- handle of current control ArayPos = 0 '<--- row element of Handles$() 'calculated using the current 'control Id and CtlLow AryElm = 0
CurScroll= 0 '<--- current position of the 'scroll bar thumb Clicked = 0 '<--- value indicating whether the 'left mouse button was clicked LineNum = 0 LineLen = 0 ChrIdx = 0
Ulx = 0 '<--- control size/position Uly = 0 Brx = 0 Bry = 0
Cpx = 0 '<--- client position of mouse cursor Cpy = 0
Wcpx = 0 '<--- screen position of mouse cursor Wcpy = 0
I = 0 '<--- counter
HndlStr$ = "" '<--- control tag e. g. "#DMO.LBXL"
CtlHndl = FN.GetFocus() '<--- control or window with focus CtlId = FN.GetCtlId(CtlHndl) '<--- control ID number ArayPos = CtlId - CtlLow '<--- calculate row element of Handles$()
IF (ArayPos < 0) OR (ArayPos > Ubnd) THEN '<--- if a control looses RetVal = FN.SetFocus(LstCtrl) 'the focus set it back to GOTO [BEGIN.TIMER] 'the last control END IF
LstCtrl = CtlHndl '<--- set the last control to the current control
Clicked = FN.KeyState(VK.LBUTTON) '<--- check left mouse button
IF Clicked THEN RetVal = FN.ClientSize(CtlHndl, Brx, Bry) '<--- get edit client area RetVal = FN.CursorPos(Cpx, Cpy) '<--- where the cursor is Wcpx = Cpx '<--- save position for possible later use Wcpy = Cpy
RetVal = FN.ScreenToClient(CtlHndl, Cpx, Cpy) '<--- translate mouse coords IF (Cpx >= 0) AND (Cpx <= Brx) THEN '<--- is mouse in client area IF (Cpy >= 0) AND (Cpy <= Bry) THEN
RetVal = FN.GetSel(Handles$(ArayPos, 0)) '<--- where the caret is
'<---------------- GET CHARACTER POSITION ---------------------> CALLDLL #NUM, "FN_GetLowWord", RetVal AS LONG, Wcpx AS LONG CALLDLL #NUM, "FN_GetHiWord", RetVal AS LONG, Wcpy AS LONG
'<--------- LINE WHERE THE CARET IS ------------------------> LineNum = FN.GetLine(Handles$(ArayPos, 0), Wcpx, 0)
FOR I = 0 TO Ubnd ChrIdx = FN.LineChrIndex(Handles$(I, 0), LineNum) '<--- 1st character on 'line LineLen = FN.GetLineLen(Handles$(I, 0), LineNum) '<--- line length '<--------------- select the line --------------> RetVal = FN.SetSelect(Handles$(I, 0), ChrIdx, ChrIdx + LineLen) RetVal = FN.ScrollCaret(Handles$(I, 0)) '<--- scroll line into view 'may be a slight offset in 'other edit controls NEXT I GOTO [BEGIN.TIMER] END IF ELSE '<--- mouse cursor is not in client area CtlHndl = FN.WinFromPnt(Wcpx, Wcpy, Ubnd, AryElm) '<--- where the cursor is
IF CtlHndl < 0 THEN GOTO [BEGIN.TIMER] '<--- something else was clicked
RetVal = FN.SetFocus(CtlHndl) '<--- focus on new ctrl LstThumb = FN.SetThumb(CtlHndl, AryElm, Ubnd) '<--- scroll other 'edit controls END IF END IF
GOTO [BEGIN.TIMER] [GET.SCROLL.END]
'------------------------------------------------------ '------------------------------------------------------
SUB END.DMO Win$
WinHndl = FN.GetHandle(Win$) CALLDLL #CLRCTRL, "FN_CLOSE", WinHndl AS ULONG CLOSE #USER CLOSE #CLRCTRL 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.GetCtlId(CtlHndl) '################################################################ ' Each control has a numeric ID number. This module gets that ' ID number '################################################################
CtlId = 0 CALLDLL #USER, "GetDlgCtrlID", CtlHndl AS ULONG, CtlId AS LONG
FN.GetCtlId = CtlId END FUNCTION
'-------------------------------------------------------------------- '--------------------------------------------------------------------
FUNCTION FN.GetFocus() '################################################################ ' This module finds the control or window that has the focus. ' Only a window or control that has the focus can receive input ' vias the keyboard or the mouse. '################################################################
CtlHndl = 0 CALLDLL #USER, "GetFocus", CtlHndl AS ULONG
FN.GetFocus = CtlHndl END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SetFocus(CtrlHndl) '################################################################ ' This module sets the window or control so it can receive input ' from the mouse or keyboard '################################################################
RetVal = 0 CALLDLL #USER, "SetFocus", CtrlHndl AS ULONG, RetVal AS VOID
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.ScrollPos(CtlHndl) '################################################################ ' Retrieve the position of the scroll bar thumb, i. e. then box ' in the scroll bar. The API function GetScrollPos() is obsolete ' but can still be used. The preferred method is to use the ' GetScrollInfo() function, but GetScrollPos() is a little ' easier to understand. '################################################################
SB.VERT = 1
CurPos = 0 CALLDLL #USER, "GetScrollPos", CtlHndl AS ULONG, SB.VERT AS LONG, _ CurPos AS LONG
FN.ScrollPos = CurPos
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.ClientSize(WinHndl, BYREF Bx, BYREF By) '################################################################ ' Retrieve the client area of a window (form or control). Since ' the upper left corner of the client area is always zero, zero ' the size of the client area is determined by the lower right ' corner of the client rectangle. ' ' ARGUMENTS: ' WinHndl: Handle of the window (form or control). ' Bx, By: Lower right corner of the client rectangle '################################################################
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 '<--- dummy variable CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, _ RetVal AS VOID
Bx = tRect.X1.struct By = tRect.Y1.struct END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.WindowSize(Hndl, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By) '################################################################ ' Retrieve the total size of the window or control '################################################################
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
CALLDLL #USER, "GetWindowRect", Hndl 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.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
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.FindLbx(NumElms, Cpx, Cpy) '################################################################ ' Find the list box that contains the mouse cursor when the left ' mouse button was clicked. This module uses the entire window ' size since the mouse coordinates are in window coordinates. '################################################################
Ulx = 0 Uly = 0 Brx = 0 Bry = 0 Crx = 0 Cry = 0
RetVal = 0 CtlHndl = 0
FOR I = 0 TO NumElms CtlHndl = VAL(Handles$(I, 1))
'<---- get the window coordinates of the list box -------> RetVal = FN.WindowSize(CtlHndl, Ulx, Uly, Brx, Bry)
IF (Cpx >= Ulx) AND (Cpx <= Brx) THEN '<--- is the mouse cursor in this IF (Cpy >= Uly) AND (Cpy <= Bry) THEN 'list box? FN.FindLbx = CtlHndl EXIT FUNCTION END IF END IF NEXT I END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.PopulateCtrl(CtrlTag$, UbndAry, Idx) '################################################# ' Populate edit controls '#################################################
EM.SETSEL = HEXDEC("&H00B1") '<--- edti control messages EM.REPLACESEL = HEXDEC("&H00C2")
NumChrs = 0 '<--- total number of characters in edit control RetVal = 0 '<--- dummy value
TxtOut$ = "" '<--- add to edit control
CtlHndl = FN.GetHandle(CtrlTag$)
FOR I = 0 TO UbndAry '<------ # of characters in control ----------> CALLDLL #USER, "GetWindowTextLengthA", CtlHndl AS ULONG, NumChrs AS LONG NumChrs = NumChrs + 1 '<------------ set character position for insert --------> CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.SETSEL AS ULONG, _ NumChrs AS LONG, NumChrs AS LONG, RetVal AS VOID
SELECT CASE Idx '<--- which array to use CASE 1 TxtOut$ = Lft$(I) CASE 2 TxtOut$ = Mdl$(I) CASE 3 TxtOut$ = Rgt$(I) END SELECT
'<---------- insert text at end of total text in control ---------> CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.REPLACESEL AS ULONG, _ 1 AS LONG, TxtOut$ AS PTR, RetVal AS VOID next I END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SetCtrlColor(CtlTag$, TxtKey$, BkgKey$, TxtClr, BkgClr)
CtrlHndl = 0 RetVal = 0
CtrlHndl = FN.GetHandle(CtlTag$)
CALLDLL #USER, "SetPropA", CtrlHndl AS ULONG, TxtKey$ AS PTR, _ TxtClr AS ULONG, RetVal AS LONG CALLDLL #USER, "SetPropA", CtrlHndl AS ULONG, BkgKey$ AS PTR, _ BkgClr AS ULONG, RetVal AS LONG
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.InitClrCtrl(WinTag$, TxtKey$, BkgKey$, WinClr, BmpTrue)
WinHndl = 0 RetVal = 0
WinHndl = FN.GetHandle(WinTag$)
CALLDLL #CLRCTRL, "FN_InitProperties", WinHndl AS ULONG, _ TxtKey$ AS PTR, BkgKey$ AS PTR, _ WinClr AS ULONG, BmpTrue AS LONG, RetVal AS LONG
FN.InitClrCtrl = RetVal END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SetSelect(CtlTag$, ChrStrt, ChrEnd)
EM.SETSEL = HEXDEC("&H00B1")
CtlHndl = 0 RetVal = 0
CtlHndl = FN.GetHandle(CtlTag$)
CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.SETSEL AS ULONG, _ ChrStrt AS LONG, ChrEnd AS LONG, RetVal AS VOID
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.ScrollCaret(CtlTag$) '################################################## ' scroll the caret into view if necessary '##################################################
EM.SCROLLCARET = HEXDEC("&H00B7")
CtlHndl = 0 RetVal = 0
CtlHndl = FN.GetHandle(CtlTag$) CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.SCROLLCARET AS ULONG, _ 0 AS LONG, 0 AS LONG, RetVal AS VOID
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.GetSel(CtlTag$)
EM.GETSEL = HEXDEC("&H00B0")
CtlHndl = 0 SelPos = 0
CtlHndl = FN.GetHandle(CtlTag$) CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.GETSEL AS ULONG, _ 0 AS LONG, 0 AS LONG, SelPos AS LONG
FN.GetSel = SelPos END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------ FUNCTION FN.GetLine(CtlTag$, StrtChr, EndChr)
EM.LINEFROMCHAR = HEXDEC("&H00C9")
CtlHndl = 0 LineNum = 0
CtlHndl = FN.GetHandle(CtlTag$)
CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, _ EM.LINEFROMCHAR AS ULONG, StrtChr AS LONG, _ EndChr AS LONG, LineNum AS LONG
FN.GetLine = LineNum END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.LineChrIndex(CtlTag$, LineNum)
EM.LINEINDEX = HEXDEC("&H00BB")
CtlHndl = 0 ChrIdx = 0
CtlHndl = FN.GetHandle(CtlTag$) CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.LINEINDEX AS ULONG, _ LineNum AS LONG, 0 AS LONG, ChrIdx AS LONG
FN.LineChrIndex = ChrIdx END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.GetLineLen(CtlTag$, LineNum)
EM.LINELENGTH = HEXDEC("&H00C1")
CtlHndl = 0 LineLen = 0
CtlHndl = FN.GetHandle(CtlTag$) CALLDLL #USER, "SendMessageA", CtlHndl AS ULONG, EM.LINELENGTH AS ULONG, _ LineNum AS LONG, 0 AS LONG, LineLen AS LONG
FN.GetLineLen = LineLen END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.WinFromPnt(PntX, PntY, Ubnd, BYREF AryPos)
Ux = 0 Uy = 0 Bx = 0 By = 0
Found = 0 RetVal = 0 CtlHndl = 0
FOR I = 0 TO Ubnd CtlHndl = VAL(Handles$(I, 1)) RetVal = FN.WindowSize(CtlHndl, Ux, Uy, Bx, By) Found = -1 IF (PntX >= Ux) AND (PntX <= Bx) THEN IF (PntY >= Uy) AND (PntY <= By) THEN Found = I EXIT FOR END IF END IF NEXT I
IF Found > -1 THEN FN.WinFromPnt = CtlHndl AryPos = Found EXIT FUNCTION END IF
FN.WinFromPnt = Found END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SetThumb(CtlHndl, ArayPos, Ubnd)
SB.LINEUP = 0 '<--- which way to scroll SB.LINEDOWN = 1
EM.SCROLL = HEXDEC("&H00B5") 'EM.GETTHUMB = HEXDEC("&H00BE") this does not work in LB
CompVar = 0 ThumbPos = 0 CtlThumb = 0 Ctrl = 0 Diff = 0 Stp = 1
ThumbPos = FN.ScrollPos(CtlHndl) '<--- where the scroll bar thumb is
'<--------- PARSE THE EDIT CONTROLS ---------> FOR J = 0 TO Ubnd IF J = ArayPos THEN GOTO [NXT.J] '<--- J = current control
Ctrl = VAL(Handles$(J, 1)) '<--- control handle CtlThumb = FN.ScrollPos(Ctrl) '<--- where the other control thumb is
Diff = ThumbPos - CtlThumb '<--- # of lines to scroll IF Diff < 0 THEN Stp = -1 '<--- scroll down or up based on "Diff"
FOR I = 1 TO Diff STEP Stp IF Stp > 0 THEN '<--- scroll direction CALLDLL #USER, "SendMessageA", Ctrl AS ULONG, EM.SCROLL AS ULONG, _ SB.LINEDOWN AS LONG, 0 AS LONG, RetVal AS LONG ELSE CALLDLL #USER, "SendMessageA", Ctrl AS ULONG, EM.SCROLL AS ULONG, _ SB.LINEUP AS LONG, 0 AS LONG, RetVal AS LONG END IF NEXT I
[NXT.J] NEXT J
FN.SetThumb = ThumbPos END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
'
|
|
|
Post by Walt Decker on Jan 17, 2022 13:50:08 GMT -5
SCREEN CAPTURE Contrary to what the instructions say, this can be used to capture anything on the screen. Unfortunately, Liberty Basic can not handle a mouse hook callback procedure so be careful to not click on one of the desktop icons.
EDIT:
I found a couple of small errors in the code. The below is revised to correct those errors. ' VK.LBUTTON = 01 '<--- left mouse button VK.RBUTTON = 02 '<--- right mouse button
OPEN "User32.DLL" FOR DLL AS #USER OPEN "Gdi32.DLL" FOR DLL AS #GDI
RetVal = 0 '<--- dummy varb DktHndl = FN.DeskTop() '<--- desktop(monitor) handle DktDc = FN.GetDc(DktHndl) '<--- desktop device context DktCmDc = 0 '<--- private device context MemBmp = 0 '<--- DIB memory bitmap handle OldBmp = 0 '<--- Original memory bitmap handle
WinTag$ = "" CRLF$ = CHR$(13) + CHR$(10)
Msg$ = "1. Minimize WINMAIN" + CRLF$ Msg$ = Msg$ + "2. Minimize the LB IDE" + CRLF$ Msg$ = Msg$ + "3. Right mouse click anywhere on the screen" + CRLF$ Msg$ = Msg$ + "4. Left click and drag the rectangle to the end of the CAPTURE" Msg$ = Msg$ + "capture rectangle" + CRLF$ Msg$ = Msg$ + "5. Release the left mouse button" + CRLF$ + CRLF$ Msg$ = Msg$ + "NOTE: Be careful not to click on one of the desktop icons"
RetVal = FN.MsgBox("INSTRUCTIONS", Msg$)
[BEGIN.WAIT] TIMER 100, [GET.VK.CODE]
[END.WAIT] WAIT
END
'----------------------------------------------------- '-----------------------------------------------------
[GET.VK.CODE]
BmpWide = 0 '<--- width and height of capture area BmpHigh = 0 Key = 0 '<--- return value from FN.KeyState
Key = FN.KeyState(VK.RBUTTON) '<--- get left mouse button state
IF Key THEN TIMER 0
RetVal = FN.RubberRect(DktDc, Ulx, Uly, Brx, Bry) '<--- draw a rectangle 'on the monitor RetVal = FN.SwapIf(Ulx, Brx) '<--- swap rect coord if necessary RetVal = FN.SwapIf(Uly, Bry) BmpWide = Brx - Ulx + 1 '<--- size of memory bitmap BmpHigh = Bry - Uly + 1
MemBmp = FN.CreateDIB(BmpWide, BmpHigh) '<--- create memory DIB bitmap DktCmDc = FN.CompatDc(DktDc) '<--- get a private device context OldBmp = FN.AttachObj(DktCmDc, MemBmp) '<--- make DIB active
RetVal = FN.Blt(DktCmDc, 0, 0, BmpWide, BmpHigh, DktDc, Ulx, Uly) '<--- fill it
OldBmp = FN.AttachObj(DktCmDc, OldBmp) '<--- deactivate the DIB DktDc = FN.DetachDc(DktHndl, DktDc) '<--- release the desktop context DktCmDc = FN.KillDc(DktCmDc) '<--- destroy the private context
BmpWide = BmpWide - 1 '<--- size of graphic control BmpHigh = BmpHigh - 1 GfxTag$ = FN.MakeWindow$(BmpWide, BmpHigh, WinTag$) '<--- make display surface
TIMER 100, [SHOW] WAIT
[SHOW] TIMER 0 LOADBMP "DIB", MemBmp '<--- pass the DIB bitmap to LB PRINT #GfxTag$, "drawbmp DIB 0 0" PRINT #GfxTag$, "flush" PRINT #GfxTag$, "discard" UNLOADBMP "DIB"
GOTO [END.WAIT] END IF
GOTO [BEGIN.WAIT] [END.VK.CODE]
'----------------------------------------------------- '-----------------------------------------------------
SUB CLOSE.WIN WinHndl$
CLOSE #USER CLOSE #GDI CLOSE #WinHndl$
END
END SUB
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.MakeWindow$(BmWide, BmHigh, BYREF Tag$)
WS.EX.TOPMOST = HEXDEC("&H00000008")
Tag$ = "#CAP"
GfxHndl = 0
GRAPHICBOX #CAP.GFX, 5, 5, BmWide, BmHigh STYLEBITS #CAP, 0, 0, WS.EX.TOPMOST, 0
UpperLeftX = 50 UpperLeftY = 50 WindowWidth = BmWide + 26 WindowHeight = BmHigh + 48
OPEN "CAPTURE" FOR WINDOW AS #CAP PRINT #CAP, "TRAPCLOSE CLOSE.WIN" PRINT #CAP.GFX, "LOCATE 5 5 ";BmWide;" ";BmHigh PRINT #CAP, "REFRESH"
FN.MakeWindow$ = "#CAP.GFX" END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.SetMemBmp(Tag$, MemHndl)
LOADBMP Tag$, MemHndl
BmpHndl = HBMP(Tag$)
END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.RenderMemBmp(GfxTag$, MemTag$, StrtX, StrtY)
PRINT #GfxTag$, "drawbmp ";MemTag$;" ";StrtX;" ";StrtY PRINT #GfxTag$, "flush"
END FUNCTION
'----------------------------------------------------- '-----------------------------------------------------
FUNCTION FN.DeskTop() '###################################################################### ' Get a handle to the monitor '######################################################################
DtHndl = 0 CALLDLL #USER, "GetDesktopWindow", DtHndl AS ULONG
FN.DeskTop = DtHndl END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.GetDc(WinHndl) '###################################################################### ' Get a context from MSWIN for the device (form window, control, ' printer, audio, external device). '######################################################################
WinDc = 0 CALLDLL #USER, "GetDC", WinHndl AS ULONG, WinDc AS ULONG
FN.GetDc = WinDc END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.CompatDc(WinDc) '###################################################################### ' Create a context compatible with a device. ' ' ARGUMENTS: ' WinDc: Device context. ' Do NOT use user32.dll ReleaseDC(), use gdi32.DLL ' DeleteDC() instead. '######################################################################
ComPatDc = 0 CALLDLL #GDI, "CreateCompatibleDC", WinDc AS ULONG, ComPatDc AS ULONG
FN.CompatDc = ComPatDc END FUNCTION
'------------------------------------------------------------------- '-------------------------------------------------------------------
'------------------------------------------------------------------- '-------------------------------------------------------------------
FUNCTION FN.CompatBmp(CmPatDc, BmWide, BmHigh)
BmHndl = 0
CALLDLL #GDI, "CreateCompatibleBitmap", CmPatDc AS ULONG, BmWide AS LONG, _ BmHigh AS LONG, BmHndl AS ULONG
FN.CompatBmp = BmHndl END FUNCTION
'------------------------------------------------------------------- '-------------------------------------------------------------------
FUNCTION FN.CreateDIB(BmWide, BmHigh) '############################################################## ' Create a device independant bit map. The bitmap data will ' be in the form of blue, green, red instead of red, green ' blue. ' ' ARGUMENTS: ' BmpWide: Size of the bitmap ' BmpHigh: '##############################################################
BI.RGB = 0 '<--- type codes DIB.RGB.COLORS = 0
STRUCT tBmInfo, _ '<--- bitmap information structure StrSize AS ULONG, _ '<--- size of structure Width AS LONG, _ '<--- width of bitmap Height AS LONG, _ '<--- height of bitmap Planes AS SHORT, _ '<--- number of color planes BitCount AS SHORT, _ '<--- number of bits to define colors Compression AS ULONG, _ '<--- type of compression SizeImage AS ULONG, _ '<--- size of image XPelsPerMeter AS LONG, _ '<--- number of pixels per meter YPelsPerMeter AS LONG, _ ClrUsed AS ULONG, _ '<--- number of colors in the bitmap ClrImportant AS ULONG, _ '<--- important colors Colors AS ULONG '<--- array of color in BRG format
RetVal = 0 BmpHndl = 0
DispHndl = FN.DeskTop() '<--- get a handle to the desktop window DispDc = FN.GetDc(DispHndl) '<--- get a device context for desktop Tmpdc = FN.CompatDc(DispDc) '<--- create a compatible context RetVal = FN.DetachDc(DispHndl, DispDc) '<--- release the desktop context
tBmInfo.StrSize.struct = LEN(tBmInfo.struct) tBmInfo.Width.struct = BmWide tBmInfo.Height.struct = -1 * BmHigh '<--- top-down instead of bottom up tBmInfo.Planes.struct = 1 tBmInfo.BitCount.struct = 32 tBmInfo.Compression.struct = BI.RGB
CALLDLL #GDI, "CreateDIBSection", Tmpdc AS ULONG, tBmInfo AS STRUCT, _ DIB.RGB.COLORS AS LONG, 0 AS LONG, 0 AS LONG, 0 AS LONG, _ BmpHndl AS ULONG
RetVal = FN.KillDc(Tmpdc)
FN.CreateDIB = BmpHndl END FUNCTION
'-------------------------------------------------------------- '--------------------------------------------------------------
FUNCTION FN.KillDc(WinDc) '############################################################ ' Destroy a device context and release WIN resources ' ' ARGUMENTS: ' WinDc: Device context to destroy. ' Do NOT use this function to destroy a device ' context obtained with the GetDC() function. '############################################################
RetVal = 0 CALLDLL #GDI, "DeleteDC", WinDc AS ULONG, RetVal AS VOID
END FUNCTION
'----------------------------------------------------------------- '-----------------------------------------------------------------
FUNCTION FN.DetachDc(WinHndl, WinDc) '###################################################################### ' Release a device context and its resources ' ' ARGUMENTS: ' WinHndl: The handle of a form window or control. ' WinDc: Device context obtained from GetDc(). '######################################################################
RetVal = 0 CALLDLL #USER, "ReleaseDC", WinHndl AS ULONG, WinDc AS ULONG, RetVal AS VOID END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.AttachObj(WinDc, ThisObject) '###################################################################### ' Make an object (pen, brush, font, bitmap) active. ' ' ARGUMENTS: ' WinDc: Device context handle ' ThisObject: Object to make active. '######################################################################
OrgObj = 0 CALLDLL #GDI, "SelectObject", WinDc AS ULONG, ThisObject AS ULONG, _ OrgObj AS ULONG
FN.AttachObj = OrgObj END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.KillObj(ThisObj) '###################################################################### ' Destroy an object (brush, pen, font) and release its resources '######################################################################
DeadObj = 0 CALLDLL #GDI, "DeleteObject", ThisObj AS ULONG, DeadObj AS VOID
END FUNCTION
'--------------------------------------------------------------- '---------------------------------------------------------------
FUNCTION FN.GetHandle(WinTag$) '########################################################### ' Return the numeric handle of a Liberty Basic form window ' or control. ' ARGUMENTS: ' WinTag$: Form window tag or control tag. ' EXAMPLE: #1, #1.TXB, #1.GFX '###########################################################
Hndl = 0 '<--- numeric handle returned from LB's HWND() function
'<------------------ check for proper syntax ---------------> 'IF LEFT$(WinTag$, 1) <> "#" THEN WinTag$ = "#" + WinTag$
WinTag$ = FN.CheckTag$(WinTag$)
Hndl = HWND(#WinTag$) '<--- get numeric handle
FN.GetHandle = Hndl '<--- return handle END FUNCTION
'--------------------------------------------------------------------- '---------------------------------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$ END FUNCTION
'--------------------------------------------------------------------- '---------------------------------------------------------------------
FUNCTION FN.Rop2(WinDc, OpCode) '################################################## ' Sets drawing mode for pens and filled objects ' ARGUMENTES: ' WinDc: Object device context ' OpCode: Raster index number '##################################################
OrgCode = 0 CALLDLL #GDI, "SetROP2", WinDc AS ULONG, OpCode AS LONG, OrgCode AS LONG
FN.Rop2 = OrgCode END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.StockObj(ThisObj) '############################################################## ' Obtain an object from MS Windows' standard objects
' ARGUMENTS: ' ThisObj: Index to the object '############################################################## ObjHndl = 0 CALLDLL #GDI, "GetStockObject", ThisObj AS LONG, ObjHndl AS ULONG
FN.StockObj = ObjHndl 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.RubberRect(WinDc, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
HOLLOW.BRUSH = 5 '<--- index for system objects WHITE.PEN = 6
R2.COPYPEN = 13 R2.XORPEN = 7
VK.LBUTTON = 01
RetVal = 0
OldMode = 0 OldBrsh = 0 OldPen = 0 Brsh = 0 Pen = 0
Key = 0 Cpx = -5000 Cpy = -5000
Brsh = FN.StockObj(HOLLOW.BRUSH) Pen = FN.StockObj(WHITE.PEN)
OldBrsh = FN.AttachObj(WinDc, Brsh) OldPen = FN.AttachObj(WinDc, Pen)
[GET.KEY] Key = FN.KeyState(VK.LBUTTON) IF Key = 0 THEN GOTO [GET.KEY]
RetVal = FN.CursorPos(Cpx, Cpy) Ux = Cpx Uy = Cpy OldMode = FN.Rop2(WinDc, R2.XORPEN) OPEN "Kernel32.dll" FOR DLL AS #KERN
[NXT.POINT] Key = FN.KeyState(VK.LBUTTON)
IF Key = 0 THEN GOTO [FINAL.POINT]
RetVal = FN.CursorPos(Cpx, Cpy) CALLDLL #GDI, "Rectangle", WinDc AS ULONG, Ux AS LONG, Uy AS LONG, _ Cpx AS LONG, Cpy AS LONG, RetVal AS VOID
CALLDLL #KERN, "Sleep", 10 AS LONG, RetVal AS VOID
CALLDLL #GDI, "Rectangle", WinDc AS ULONG, Ux AS LONG, Uy AS LONG, _ Cpx AS LONG, Cpy AS LONG, RetVal AS VOID GOTO [NXT.POINT]
[FINAL.POINT] CLOSE #KERN OldMode = FN.Rop2(WinDc, R2.COPYPEN)
OldBrsh = FN.AttachObj(WinDc, OldBrsh) OldPen = FN.AttachObj(WinDc, OldPen)
Bx = Cpx By = Cpy
RetVal = FN.SwapIf(Ux, Bx) RetVal = FN.SwapIf(Uy, By)
END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.SwapIf(BYREF Pnt0, BYREF Pnt1)
TmpVal = 0
IF Pnt0 > Pnt1 THEN TmpVal = Pnt0 Pnt0 = Pnt1 Pnt1 = TmpVal END IF
FN.SwapIf = TmpVal END FUNCTION
'------------------------------------------------------------------ '------------------------------------------------------------------
FUNCTION FN.Blt(DestDc, Dx, Dy, Wide, High, SrcDc, Sx, Sy) '################################################################### ' Display a memory bitmap on a form window or control OR ' place a memory bitmap on another memory bitmap. ' ' ARGUMENTS: ' DestDc: Device context that receives the memory bitmap ' Dx, Dy: Where the memory bitmap will be placed ' Wide: How much of the receiving DC will be covered ' High: ' SrcDc: Device context that supplies the image ' Sx, Sy: Coordinate from which to draw the image. ' Drawing will start here and continue until ' the destination size is filled or the size ' of the source is reached. '####################################################################
SRCCOPY = HEXDEC("&H00CC0020") '<--- raster operation code
RetVal = 0 CALLDLL #GDI, "BitBlt", DestDc AS ULONG, Dx AS LONG, Dy AS LONG, _ Wide AS LONG, High AS LONG, SrcDc AS ULONG, _ Sx AS LONG, Sy AS LONG, SRCCOPY AS ULONG, RetVal AS LONG FN.Blt = RetVal END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.MsgBox(Title$, Msg$)
MB.OK = HEXDEC("&h00000000") MB.ICONINFORMATION = HEXDEC("&h00000040") MB.DEFBUTTON1 = HEXDEC("&h00000000") MB.SYSTEMMODAL = HEXDEC("&h00001000") MB.TASKMODAL = HEXDEC("&h00002000") MB.SETFOREGROUND = HEXDEC("&h00010000") MB.TOPMOST = HEXDEC("&h00040000")
Style = MB.OK OR MB.DEFBUTTON1 OR MB.TASKMODAL OR MB.SETFOREGROUND OR _ MB.TOPMOST OR MB.ICONINFORMATION CALLDLL #USER, "MessageBoxA", 0 AS ULONG, Msg$ AS PTR, Title$ AS PTR, _ Style AS ULONG, RetVal AS VOID
END FUNCTION
'
|
|
|
Post by Walt Decker on Feb 10, 2022 13:48:23 GMT -5
Although LB's WORD$() function can be used for some of the following, I find these a little more descriptive and quite easy to use:
STRING PARSING FUNCTIONS:
' A$ = "EVERY|\ GOOD|\ BOY|\ DOES|\|\ FINE{}MARY^ HAD^ A^ LITTLE^ LAMB" PRINT A$ PRINT FN.Remain$(A$, "{}")
N = FN.ParseCount(A$, "|\") PRINT N A$ = FN.Extract$(A$, "{}") P = FN.FindDlmPos(A$, "|\", 5) PRINT P PRINT A$ B$ = FN.Parse$(A$, "|\", 5) PRINT B$ N = FN.ExParse(A$, "|\") PRINT N FOR I = 0 TO N - 1 PRINT ParseAry$(I) NEXT I B$ = FN.Join$(N, "@") PRINT B$ END
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.Parse$(StrIn$, Delim$, FieldPos)
NumFields = 0 DlmLen = 0 DlmPos = 0
Dlm$ = ","
OutStr$ = ""
IF Delim$ <> "" THEN Dlm$ = Delim$
NumFields = FN.ParseCount(StrIn$, Dlm$) IF FieldPos > NumFields THEN FN.Parse$ = StrIn$ EXIT FUNCTION END IF
IF FieldPos < 1 THEN FN.Parse$ = StrIn$ EXIT FUNCTION END IF
DlmLen = LEN(Dlm$)
IF FieldPos = 1 THEN OutStr$ = FN.Extract$(StrIn$, Dlm$) FN.Parse$ = OutStr$ EXIT FUNCTION END IF
IF FieldPos = NumFields THEN DlmPos = FN.InRevStr(StrIn$, Dlm$) OutStr$ = MID$(StrIn$, DlmPos + DlmLen) FN.Parse$ = OutStr$ EXIT FUNCTION END IF
IF FieldPos MOD 2 THEN DlmPos = FN.FindDlmPos(StrIn$, Dlm$, FieldPos + 1) StrIn$ = LEFT$(StrIn$, DlmPos - 1) DlmPos = FN.InRevStr(StrIn$, Dlm$) OutStr$ = MID$(StrIn$, DlmPos + DlmLen) ELSE DlmPos = FN.FindDlmPos(StrIn$, Dlm$, FieldPos) StrIn$ = MID$(StrIn$, DlmPos + 1) OutStr$ = FN.Extract$(StrIn$, Dlm$) END IF
FN.Parse$ = OutStr$ END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.ExParse(StrIn$, Delim$)
NumFlds = 0
I = 0
ParseStr$ = ""
Dlm$ = ","
IF Delim$ <> "" THEN Dlm$ = Delim$
NumFlds = FN.ParseCount(StrIn$, Dlm$)
DIM ParseAry$(NumFlds - 1)
FOR I = 0 TO NumFlds - 1 ParseStr$ = FN.Extract$(StrIn$, Dlm$) StrIn$ = FN.Remain$(StrIn$, Dlm$) ParseAry$(I) = ParseStr$ NEXT I FN.ExParse = NumFlds END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.Extract$(StrIn$, Delim$)
I = 0 Dlm$ = ","
IF Delim$ <> "" THEN Dlm$ = Delim$
I = INSTR(StrIn$, Dlm$)
IF I = 0 THEN FN.Extract$ = StrIn$ EXIT FUNCTION END IF
FN.Extract$ = LEFT$(StrIn$, I - 1) END FUNCTION
'-------------------------------------------------------- '--------------------------------------------------------
FUNCTION FN.Remain$(StrIn$, Delim$)
LenDlm = 0
I = 0
Dlm$ = ","
IF Delim$ <> "" THEN Dlm$ = Delim$
LenDlm = LEN(Dlm$)
I = INSTR(StrIn$, Dlm$)
IF I = 0 THEN FN.Extract$ = StrIn$ EXIT FUNCTION END IF
FN.Remain$ = MID$(StrIn$, I + LenDlm) END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.InRevStr(StrIn$, Match$)
MatchLen = LEN(Match$) MatchPos = LEN(StrIn$) - MatchLen + 1 StrtMatch = MatchPos
[NXT.MATCH] MatchPos = INSTR(StrIn$, Match$, StrtMatch)
IF MatchPos <> 0 THEN GOTO [MATCH.END]
IF (MatchPos = 0) AND (StrtMatch = 1) THEN GOTO [MATCH.END]
StrtMatch = StrtMatch - MatchLen IF StrtMatch < 1 THEN StrtMatch = 1 GOTO [NXT.MATCH]
[MATCH.END] FN.InRevStr = MatchPos END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.FindDlmPos(StrIn$, Delim$, FieldNo)
DlmLen = 0 StrtPos = 1 DlmCnt = 0
Dlm$ = ","
IF Delim$ <> "" THEN Dlm$ = Delim$ END IF
IF StrIn$ = "" THEN FN.FindDlmPos = 0 EXIT FUNCTION END IF
DlmLen = LEN(Dlm$)
FieldNo = FieldNo - 1 IF FieldNo < 0 THEN FN.FindDlmPos = 0 EXIT FUNCTION END IF
IF FieldNo = 0 THEN StrtPos = INSTR(StrIn$, Dlm$) IF StrtPos = 0 THEN FN.FindDlmPos = LEN(StrIn$) EXIT FUNCTION END IF
FN.FindDlmPos = StrtPos EXIT FUNCTION END IF
[PARSE.DELIM] StrtPos = INSTR(StrIn$, Dlm$, StrtPos)
IF StrtPos THEN DlmCnt = DlmCnt + 1
IF DlmCnt >= FieldNo THEN GOTO [END.PARSE.DELIM]
StrtPos = StrtPos + DlmLen
GOTO [PARSE.DELIM]
[END.PARSE.DELIM] FN.FindDlmPos = StrtPos END FUNCTION
'------------------------------------------------------------- '-------------------------------------------------------------
FUNCTION FN.ParseCount(StrIn$, Delim$)
Found = 0 DlmPos = 1
DelLen = LEN(Delim$)
IF StrIn$ = "" THEN FN.ParseCount = Found EXIT FUNCTION END IF
[NEXT.POS] DlmPos = INSTR(StrIn$, Delim$, DlmPos)
IF DlmPos = 0 THEN GOTO [END.POS]
DlmPos = DlmPos + DelLen Found = Found + 1
GOTO [NEXT.POS]
[END.POS] FN.ParseCount = Found + 1 END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.Join$(UbndAry, Delim$)
OutStr$ = ""
Dlm$ = ","
I = 0
IF Delim$ <> "" THEN Dlm$ = Delim$
FOR I = 0 TO UbndAry - 2 OutStr$ = OutStr$ + ParseAry$(I) + Dlm$ NEXT I OutStr$ = OutStr$ + ParseAry$(I)
FN.Join$ = OutStr$ END FUNCTION
'
|
|
|
Post by Walt Decker on Feb 16, 2022 8:49:41 GMT -5
LB's MOD function is limited to integral class variables. The below function does not care:
' FOR XI = 0 TO 359 STEP 2.5 IF FN.Modulo(XI, 22.5) = 0 THEN PRINT XI IF FN.Modulo(XI, 45) = 0 THEN PRINT XI NEXT I WAIT
'---------------------------------------------------- '----------------------------------------------------
FUNCTION FN.Modulo(ValIn, Modulo)
Remainder = 0 Remainder = ValIn - INT(ValIn / Modulo) * Modulo
FN.Modulo = Remainder END FUNCTION '
|
|
|
Post by tsh73 on Feb 16, 2022 10:20:48 GMT -5
Likely not, see
pi = acs(-1) print pi x = 3.5*2*pi print x print x mod (2*pi)
|
|
|
Post by Walt Decker on Feb 16, 2022 11:30:50 GMT -5
Then the doc is misleading:
|
|
bplus
Full Member
Posts: 127
|
Post by bplus on Feb 17, 2022 12:00:54 GMT -5
How about a snippet for drawing an arc?
Here with demo:
global H$, XMAX, YMAX, PI, DEG, RAD H$ = "gr" XMAX = 500 '<======================================== actual drawing space needed YMAX = 500 '<======================================== actual drawing space needed PI = acs(-1) DEG = 180 / PI RAD = PI / 180
nomainwin
WindowWidth = XMAX + 8 WindowHeight = YMAX + 32 UpperLeftX = (1200 - XMAX) / 2 'or delete if XMAX is 1200 or above UpperLeftY = (700 - YMAX) / 2 'or delete if YMAX is 700 or above
open "Spinner" for graphics_nsb_nf as #gr '<======================= title #gr "setfocus" #gr "trapclose quit" #gr "down" #gr "fill black" #gr "size 15" While 1 For r = 20 To 200 Step 20 scan a = b * r / 40 #gr "color blue" call arc 250, 250, r - 10, a, 165 #gr "color red" call arc 250, 250, r - 10, a+ 180, 165 Next b = b + 2 call pause 20 Wend wait
sub arc xCenter, yCenter, arcRadius, dAStart, dAMeasure 'notes: 'you may want to adjust size and color for line drawing 'using angle measures in degrees to match Just Basic ways with pie and piefilled 'this sub assumes drawing in a CW direction if dAMeasure positive
'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
'dAStart is degrees to start Angle, due East is 0 degrees
'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
rAngleStart = RAD * dAStart rAngleEnd = RAD * dAMeasure + rAngleStart Stepper = RAD* 180/ arcRadius 'fixed lastX = xCenter + arcRadius * cos(rAngleStart) lastY = yCenter + arcRadius * sin(rAngleStart) #gr "set ";int(lastX);" ";int(lastY) for rAngle = rAngleStart+Stepper to rAngleEnd step Stepper nextX = xCenter + arcRadius * cos(rAngle) nextY = yCenter + arcRadius * sin(rAngle) #gr "goto ";int(nextX);" ";int(nextY) 'int speeds things up next end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
sub quit H$ close #H$ '<=== this needs Global H$ = "gr" end 'Thanks Facundo, close graphic wo error end sub
|
|