Share your snippets (functions) - II

[Walt Decker]

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
'

[dan1101]

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.

[Walt Decker]

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.

[Walt Decker]

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

[Walt Decker]

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


[Walt Decker]

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.

[Walt Decker]

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


[Walt Decker]

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
'

[Walt Decker]

'
'###############################################################
'                     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

'------------------------------------------------------------------
'------------------------------------------------------------------

'

[Walt Decker]

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

'

[Walt Decker]

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

'

[Walt Decker]

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
'

[tsh73]

LB's MOD function is limited to integral class variables.

Likely not, see
pi = acs(-1)
print pi
x = 3.5*2*pi
print x
print x mod (2*pi)



[Walt Decker]

Then the doc is misleading:

MOD - return the remainder of integer division

The MOD command returns the remainder when num1 is divided by num2.

Usage:

'divide 15 by 4 and return the remainder
print 15 MOD 4
print 27 MOD 16

Produces:

3
11

When 15 is divided by 4, the quotient is 3, with a remainder of 3. MOD returns that remainder. When 27 is divided by 16, the quotient is 1, with a remainder of 11. MOD returns that remainder.

[bplus]

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