' ********************************************************************************
' Program: GEMS.PF3  Graphical Elements Made for SmartWare  v1.1.0.0 - 30 Apr 2004 DEV
'
' Produced By:  I O Systech Limited        Author: Neil Parrish
' Website:      www.iosystech.co.uk        Email:  enquiries@iosystech.co.uk
' Phone:        +44 (0)7041 420182         Fax:    +44 (0)8707 064666
'               +44 (0)1784 432058
'
' This functions in this library provide Windows GUI style graphical elements for
' use with SmartWare. The library interfaces to the GEMS DLL provided with this
' project via the DLL commands of SmartWare version 2.65b and above.
'
' See the documentation provided with GEMS for function usage instructions.
'
' The professional version of GEMS includes this source code, the DELPHI source
' for the GEMS DLL and additional documentation.
'
' Source code may not be distributed or used as part of a competitive product. Any
' variations of the product produced from the source code require licences for
' distribution to external clients.
' ********************************************************************************

GLOBAL _FindSWWinHandle()   'finds SmartWare windows handle - uses EnumWindows calls
PUBLIC _GEMS_EnumWinProc(1) 'callback function used by _FindSWWinHandle()
PUBLIC _GEMS_Load()
PUBLIC _GEMS_Unload()
PUBLIC _GEMS_ResetStdParam()
PUBLIC _GEMS_ResetCtrlParam()
PUBLIC _GEMS_StdParam()
PUBLIC _GEMS_CtrlParam()
PUBLIC _GEMS_Text()
PUBLIC _GEMS_TextOn()
PUBLIC _GEMS_TextOff()
PUBLIC _GEMS_ProgressOn()
PUBLIC _GEMS_ProgressMove()
PUBLIC _GEMS_ProgressTextMove()
PUBLIC _GEMS_ProgressOff()
PUBLIC _GEMS_MessageOn()
PUBLIC _GEMS_MessageOff()
PUBLIC _GEMS_Input()
PUBLIC _GEMS_AnimateOn()
PUBLIC _GEMS_AnimateOff()
PUBLIC _GEMS_ScrollBar()
PUBLIC _GEMS_ScrollBarEx()
PUBLIC _GEMS_TrackBar()
PUBLIC _GEMS_TrackBarEx()
PUBLIC _GEMS_Colour()
PUBLIC _GEMS_Color()
PUBLIC _GEMS_Date()
PUBLIC _GEMS_Time()
PUBLIC _GEMS_ListBox()
PUBLIC _GEMS_CheckList()
PUBLIC _GEMS_Display_Message()
PUBLIC _GEMS_Get_Choice()
GLOBAL _ArrayToString(2)
GLOBAL _intAX()
GLOBAL _DatePrep(1)
GLOBAL _TimePrep(1)
GLOBAL _IsTime(1)
GLOBAL _IsArray(1)
GLOBAL _Status(1)
PUBLIC _GEMS_Windialog(3)   'windows dialog box function - returns button pressed
PUBLIC _GEMS_Web(1)
PUBLIC _GEMS_EmailTo(1)
PUBLIC _GEMS_Email(5)
PUBLIC _GEMS_ShellEx(4)
PUBLIC _GEMS_Group(3)
PUBLIC _GEMS_About(2)
PUBLIC _GEMS_SWCmndLine()
PUBLIC _GEMS_GetDir(1)
PUBLIC _GEMS_SetSWTitle(1)
PUBLIC _GEMS_SetSWIcon(1)
GLOBAL _ClearKM()

PUBLIC #GEMS_SWWinH #GEMS_fg #GEMS_bg #GEMS_bounds #GEMS_fontsize #GEMS_fwidth #GEMS_fheight
PUBLIC #GEMS_fpercentage #GEMS_ctrl_fg #GEMS_ctrl_bg #GEMS_ctrl_fontsize #GEMS_Error #GEMS_Cancel
PUBLIC #GEMS_sel_fg #GEMS_sel_bg #GEMS_SWError35 #GEMS_GCSepChar
PUBLIC $GEMS_Version $GEMS_DLLPath $GEMS_fposition $GEMS_SelectedOptions $GEMS_SortedOptions
PUBLIC $GEMS_RADFuncTitle

GLOBAL #procID #enumWinCB #handle #dllkernel32 #dllshell32 #dlluser32 #GEMShnd #stdparam #ctrlparam #AXreg
GLOBAL #dateadj #timeadj #ptrstatus #dllstatus

MAIN
	$GEMS_Version = "GEMS v1.1.0.0 - 30 April 2004 DEV"
	#GEMS_Error = 0
	#GEMS_Cancel = 0
	#GEMS_SWError35 = 1
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	#GEMShnd = 0
	$GEMS_DLLPath = ""
	#GEMS_SWWinH = _FindSWWinHandle()
	#dateadj = 53690
	#timeadj = 1000000000
	$GEMS_SelectedOptions = ""
	$GEMS_SortedOptions = ""
	$GEMS_RADFuncTitle = " "
	#GEMS_GCSepChar = ASC(" ")

'Set Defaults for standard and control parameters
	_GEMS_ResetStdParam()
	_GEMS_ResetCtrlParam()
	
	BUFFER #stdparam SIZEOF "PBBCCWWW"
	BUFFER #ctrlparam SIZEOF "BBC"
END MAIN

FUNCTION _FindSWWinHandle()
' This function is needed as SmartWare does not declare it's handle anywhere.
' The use of EnumWindows and callbacks ensures the correct handle is found
' unlike the standard GetActiveWindow & FindWindow calls which both have drawbacks
	DLL LOAD "kernel32.dll" #dllkernel32
		DLL CALL #dllkernel32 FUNCTION "GetCurrentProcessId" STACK ""
		#procID = GETREG(AX)
	DLL UNLOAD #dllkernel32
	DLL LOAD "user32.dll" #dlluser32
		#enumWinCB = CALLBACK_CREATE("_GEMS_EnumWinProc",2,2)
		DLL CALL #dlluser32 FUNCTION "EnumWindows" STACK "LL" #enumWinCB 0
		CALLBACK_DELETE(#enumWinCB)
	DLL UNLOAD #dlluser32
	RETURN #handle
END FUNCTION

FUNCTION _GEMS_EnumWinProc(#hnd)
 LOCAL #param #testPID #PIDmem $str
	UNPACK #hnd "LL" #handle #param
	MEMALLOC #PIDmem SIZEOF "P"
	MEMPACK #PIDmem "P" 0
	DLL CALL #dlluser32 FUNCTION "GetWindowThreadProcessId" STACK "LP" #handle #PIDmem
	MEMUNPACK #PIDmem "P" #testPID
	MEMFREE #PIDmem
	IF #testPID = #procID
		$str = REPEAT(" ",21)
		DLL CALL #dlluser32 FUNCTION "GetClassNameA" STACK"LPL" #handle DOSPTR($str) 20
		IF LEFT($str,GETREG(AX)) = "ANGOSS Frame" OR LEFT($str,GETREG(AX)) = "SmartWare Frame"
			SETREG(AX,0)
		ELSE
			SETREG(AX,1)
		END IF
	ELSE
		SETREG(AX,1)
	END IF
END FUNCTION

FUNCTION _GEMS_Load()
	IF #GEMShnd = 0 and $GEMS_DLLPath <> ""
		DLL LOAD $GEMS_DLLPath|"GEMS.DLL" #GEMShnd
	END IF
	IF #GEMShnd = 0
		DLL LOAD PATH(DATAPATH)|"GEMS.DLL" #GEMShnd
	END IF
	IF #GEMShnd = 0
		DLL LOAD "GEMS.DLL" #GEMShnd
	END IF
	IF #GEMShnd = 0
		RETURN _Status(100)
	ELSE
		RETURN 1
	END IF
END FUNCTION

FUNCTION _GEMS_Unload()
	IF #GEMShnd <> 0
		DLL UNLOAD #GEMShnd
		#GEMShnd = 0
	END IF
END FUNCTION

FUNCTION _GEMS_ResetStdParam()
	$GEMS_fposition = "MM"
	#GEMS_fg = -1
	#GEMS_bg = -1
	#GEMS_bounds = 1
	#GEMS_fontsize = 0
	#GEMS_fwidth = 0
	#GEMS_fheight = 0
	#GEMS_fpercentage = 0
END FUNCTION

FUNCTION _GEMS_ResetCtrlParam()
	#GEMS_ctrl_fg = -1
	#GEMS_ctrl_bg = -1
	#GEMS_ctrl_fontsize = 0
END FUNCTION

FUNCTION _GEMS_StdParam()
	IF NOT(ISSTRING($GEMS_fposition))
		RETURN _Status(200)
	END IF
	IF NOT(ISNUMBER(#GEMS_fg)) OR INT(#GEMS_fg) <> #GEMS_fg OR \
			#GEMS_fg < -128 OR #GEMS_fg > 127    'Delphi ShortInt
		RETURN _Status(201)
	END IF
	IF NOT(ISNUMBER(#GEMS_bg)) OR INT(#GEMS_bg) <> #GEMS_bg OR \
			#GEMS_bg < -128 OR #GEMS_bg > 127    'Delphi ShortInt
		RETURN _Status(202)
	END IF
	IF NOT(ISNUMBER(#GEMS_bounds)) OR INT(#GEMS_bounds) <> #GEMS_bounds OR \
			#GEMS_bounds < 0 OR #GEMS_bounds > 255    'Delphi Byte
		RETURN _Status(203)
	END IF
	IF NOT(ISNUMBER(#GEMS_fontsize)) OR INT(#GEMS_fontsize) <> #GEMS_fontsize OR \
			#GEMS_fontsize < 0 OR #GEMS_fontsize > 255    'Delphi Byte
		RETURN _Status(204)
	END IF
	IF NOT(ISNUMBER(#GEMS_fwidth)) OR INT(#GEMS_fwidth) <> #GEMS_fwidth OR \
			#GEMS_fwidth < 0 OR #GEMS_fwidth > 65535    'Delphi Word
		RETURN _Status(205)
	END IF
	IF NOT(ISNUMBER(#GEMS_fheight)) OR INT(#GEMS_fheight) <> #GEMS_fheight OR \
			#GEMS_fheight < 0 OR #GEMS_fheight > 65535    'Delphi Word
		RETURN _Status(206)
	END IF
	IF NOT(ISNUMBER(#GEMS_fpercentage)) OR INT(#GEMS_fpercentage) <> #GEMS_fpercentage OR \
			#GEMS_fpercentage < 0 OR #GEMS_fpercentage > 65535    'Delphi Word
		RETURN _Status(207)
	END IF
	PACK #stdparam "PBBCCWWW" DOSPTR($GEMS_fposition) #GEMS_fg #GEMS_bg #GEMS_bounds \
		#GEMS_fontsize #GEMS_fwidth #GEMS_fheight #GEMS_fpercentage
	RETURN 1
END FUNCTION

FUNCTION _GEMS_CtrlParam()
	IF NOT(ISNUMBER(#GEMS_ctrl_fg)) OR INT(#GEMS_ctrl_fg) <> #GEMS_ctrl_fg OR \
			#GEMS_ctrl_fg < -128 OR #GEMS_ctrl_fg > 127    'Delphi ShortInt
		RETURN _Status(250)
	END IF
	IF NOT(ISNUMBER(#GEMS_ctrl_bg)) OR INT(#GEMS_ctrl_bg) <> #GEMS_ctrl_bg OR \
			#GEMS_ctrl_bg < -128 OR #GEMS_ctrl_bg > 127    'Delphi ShortInt
		RETURN _Status(251)
	END IF
	IF NOT(ISNUMBER(#GEMS_ctrl_fontsize)) OR INT(#GEMS_ctrl_fontsize) <> #GEMS_ctrl_fontsize OR \
			#GEMS_ctrl_fontsize < 0 OR #GEMS_ctrl_fontsize > 255    'Delphi Byte
		RETURN _Status(252)
	END IF
	PACK #ctrlparam "BBC" #GEMS_ctrl_fg #GEMS_ctrl_bg #GEMS_ctrl_fontsize
	RETURN 1
END FUNCTION

FUNCTION _GEMS_Text($title,$filename,#iconmode)
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		RETURN _Status(2800)
	END IF
	IF NOT(ISSTRING($filename))
		RETURN _Status(2801)
	END IF
	IF NOT(ISNUMBER(#iconmode))
		RETURN _Status(2803)
	END IF
	IF INT(#iconmode) <> #iconmode OR #iconmode < 0 OR #iconmode > 255  'Delphi Byte
		RETURN _Status(2804)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "ShowTextView" STACK "LPPLP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($filename) #iconmode DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_TextOn($title,$filename,#iconmode)
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		RETURN _Status(2800)
	END IF
	IF NOT(ISSTRING($filename))
		RETURN _Status(2801)
	END IF
	IF NOT(ISNUMBER(#iconmode))
		RETURN _Status(2803)
	END IF
	IF INT(#iconmode) <> #iconmode OR #iconmode < 0 OR #iconmode > 255  'Delphi Byte
		RETURN _Status(2804)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "CreateTextView" STACK "LPPLP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($filename) #iconmode DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_TextOff()
	#GEMS_Error = 0
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "DestroyTextView" STACK ""
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_ProgressOn($text)
	#GEMS_Error = 0
	IF NOT(ISSTRING($text))
		RETURN _Status(2400)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "CreateProgress" STACK "LPP" \
		#GEMS_SWWinH DOSPTR($text) DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_ProgressMove(#position)
	#GEMS_Error = 0
	IF NOT(ISNUMBER(#position))
		RETURN _Status(2401)
	END IF
	#position = INT(#position)
	IF #position < 0 or #position > 255  'Delphi Byte
		RETURN _Status(2402)
	END IF
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "MoveProgress" STACK "L" #position
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_ProgressTextMove($text,#position)
	#GEMS_Error = 0
	IF NOT(ISSTRING($text))
		RETURN _Status(2400)
	END IF
	IF NOT(ISNUMBER(#position))
		RETURN _Status(2401)
	END IF
	#position = INT(#position)
	IF #position < 0 or #position > 255  'Delphi Byte
		RETURN _Status(2402)
	END IF
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "TextMoveProgress" STACK "PL" DOSPTR($text) #position
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_ProgressOff()
	#GEMS_Error = 0
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "DestroyProgress" STACK ""
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_MessageOn($mess1,$mess2,$mess3,$mess4)
	#GEMS_Error = 0
	IF ISSTRING($mess1) + ISSTRING($mess2) + ISSTRING($mess3) + ISSTRING($mess4) <> 4
		RETURN _Status(2200)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "CreateMessageText" STACK "LPPPPP" \
		#GEMS_SWWinH DOSPTR($mess1) DOSPTR($mess2) DOSPTR($mess3) DOSPTR($mess4) DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_MessageOff()
	#GEMS_Error = 0
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "DestroyMessageText"
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_Input($title,$text,$initval,#textlen,$boxtype,$range)
 LOCAL $return #retlength
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(1800)
		RETURN STR($initval)
	END IF
	IF NOT(ISSTRING($text))
		_Status(1801)
		RETURN STR($initval)
	END IF
	IF NOT(ISSTRING($initval))
		_Status(1802)
		RETURN STR($initval)
	END IF
	IF NOT(ISNUMBER(#textlen))
		RETURN _Status(1804)
	END IF
	IF INT(#textlen) <> #textlen OR #textlen < 0 OR #textlen > 65535  'Delphi Word
		RETURN _Status(1805)
	END IF
	$boxtype = STR($boxtype)
	IF NOT(ISSTRING($range))
		_Status(1807)
		RETURN STR($initval)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN STR($initval)
		END IF
	END IF
	IF #textlen = 0
		$return = REPEAT(" ",1000)
	ELSE
		$return = REPEAT(" ",#textlen+1)
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN STR($initval)
	END IF
	IF _GEMS_CtrlParam() <> 1
		RETURN STR($initval)
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowInputBox" STACK "LPPPPLPPPPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) DOSPTR($initval) DOSPTR($return) #textlen \
		DOSPTR($boxtype) DOSPTR($range) DOSPTR(#ctrlparam) DOSPTR(#stdparam) #ptrstatus
	#retlength = _intAX()
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN STR($initval)
	ELSE
		RETURN left($return,#retlength)
	END IF
END FUNCTION

FUNCTION _GEMS_AnimateOn(#mode,$text)
	#GEMS_Error = 0
	IF NOT(ISNUMBER(#mode))
		RETURN _Status(1000)
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		RETURN _Status(1001)
	END IF
	IF NOT(ISSTRING($text))
		RETURN _Status(1002)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "CreateAnimation" STACK "LLPP" \
		#GEMS_SWWinH #mode DOSPTR($text) DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_AnimateOff()
	#GEMS_Error = 0
	IF #GEMShnd = 0
		RETURN _Status(102)
	END IF
	DLL CALL #GEMShnd FUNCTION "DestroyAnimation"
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_ScrollBar($title,$text,#min,#max,#start)
	RETURN _GEMS_ScrollBarEx($title,$text,#min,#max,#start,0,0)
END FUNCTION

FUNCTION _GEMS_ScrollBarEx($title,$text,#min,#max,#start,#smallstep,#largestep)
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(2600)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISSTRING($text))
		_Status(2601)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#min))
		_Status(2602)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#max))
		_Status(2603)
		RETURN VALUE(#start)
	END IF
	IF INT(#min) <> #min OR #min < -2147483648 OR #min > 2147483647 OR \
			INT(#max) <> #max OR #max < -2147483648 OR #max > 2147483647 'Delphi Integers
		_Status(2604)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#start))
		_Status(2605)
		RETURN VALUE(#start)
	END IF
	IF INT(#start) <> #start OR #start < -2147483648 OR #start > 2147483647  'Delphi Integer
		_Status(2606)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#smallstep))
		_Status(2607)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#largestep))
		_Status(2608)
		RETURN VALUE(#start)
	END IF
	IF INT(#smallstep) <> #smallstep OR #smallstep < -2147483648 OR #smallstep > 2147483647 OR \
			INT(#largestep) <> #largestep OR #largestep < -2147483648 OR #largestep > 2147483647 'Delphi Integers
		_Status(2609)
		RETURN VALUE(#start)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN VALUE(#start)
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN VALUE(#start)
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowScrollBar" STACK "LPPLLLLLPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) #min #max #start #smallstep #largestep \
		DOSPTR(#stdparam) #ptrstatus
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN VALUE(#start)
	ELSE
		RETURN _intAX()
	END IF
END FUNCTION

FUNCTION _GEMS_TrackBar($title,$text,#min,#max,#start)
	RETURN _GEMS_TrackBarEx($title,$text,#min,#max,#start,0,0)
END FUNCTION

FUNCTION _GEMS_TrackBarEx($title,$text,#min,#max,#start,#smallstep,#largestep)
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(3200)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISSTRING($text))
		_Status(3201)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#min))
		_Status(3202)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#max))
		_Status(3203)
		RETURN VALUE(#start)
	END IF
	IF INT(#min) <> #min OR #min < -2147483648 OR #min > 2147483647 OR \
			INT(#max) <> #max OR #max < -2147483648 OR #max > 2147483647 'Delphi Integers
		_Status(3204)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#start))
		_Status(3205)
		RETURN VALUE(#start)
	END IF
	IF INT(#start) <> #start OR #start < -2147483648 OR #start > 2147483647  'Delphi Integer
		_Status(3206)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#smallstep))
		_Status(3207)
		RETURN VALUE(#start)
	END IF
	IF NOT(ISNUMBER(#largestep))
		_Status(3208)
		RETURN VALUE(#start)
	END IF
	IF INT(#smallstep) <> #smallstep OR #smallstep < -2147483648 OR #smallstep > 2147483647 OR \
			INT(#largestep) <> #largestep OR #largestep < -2147483648 OR #largestep > 2147483647 'Delphi Integers
		_Status(3209)
		RETURN VALUE(#start)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN VALUE(#start)
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN VALUE(#start)
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowTrackBar" STACK "LPPLLLLLPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) #min #max #start #smallstep #largestep\
		DOSPTR(#stdparam) #ptrstatus
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN VALUE(#start)
	ELSE
		RETURN _intAX()
	END IF
END FUNCTION

FUNCTION _GEMS_Colour($title,$text,#mode,#cfg,#cbg)
	#GEMS_sel_bg = #cbg
	#GEMS_sel_fg = #cfg
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(1400)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF NOT(ISSTRING($text))
		_Status(1401)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF NOT(ISNUMBER(#mode))
		_Status(1402)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		_Status(1403)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF NOT(ISNUMBER(#cfg))
		_Status(1404)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF INT(#cfg) <> #cfg OR #cfg < 0 OR #cfg > 255  'Delphi Byte
		_Status(1405)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF NOT(ISNUMBER(#cbg))
		_Status(1406)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	IF INT(#cbg) <> #cbg OR #cbg < 0 OR #cbg > 255  'Delphi Byte
		_Status(1407)
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	#cbg = MAX(MIN(INT(#cbg),255),0)  'Delphi byte
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowColorPicker" STACK "LPPLLLPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) #mode #cfg #cbg \
		DOSPTR(#stdparam) #ptrstatus
	#AXreg = GETREG(AX)
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN VALUE(#cfg) + (VALUE(#cbg) * 16)
	ELSE
		IF #AXreg >=0 and #AXreg <= 255
			#GEMS_sel_fg = BITAND(#AXreg,15)
			#GEMS_sel_bg = INT(#AXreg/16)
		END IF
		RETURN #AXreg
	END IF
END FUNCTION

FUNCTION _GEMS_Color($title,$text,#mode,#cfg,#cbg)
	RETURN _GEMS_Colour($title,$text,#mode,#cfg,#cbg)
END FUNCTION

FUNCTION _GEMS_Date($title,$text,#mindate,#maxdate,#startdate,#mode)
 LOCAL $retdefault
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISDATE(#startdate))  'empty string is OK
		_Status(1605)
		RETURN ""
	END IF
	IF #startdate = 0 OR #startdate = ""
		$retdefault = ""
	ELSE
		$retdefault = DATE2(#startdate)
	END IF
	IF NOT(ISSTRING($title))
		_Status(1600)
		RETURN $retdefault
	END IF
	IF NOT(ISSTRING($text))
		_Status(1601)
		RETURN $retdefault
	END IF
	IF NOT(ISDATE(#mindate))  'empty string is OK
		_Status(1602)
		RETURN $retdefault
	END IF
	IF NOT(ISDATE(#maxdate))  'empty string is OK
		_Status(1603)
		RETURN $retdefault
	END IF
	IF NOT(ISNUMBER(#mode))
		_Status(1607)
		RETURN $retdefault
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		_Status(1608)
		RETURN $retdefault
	END IF
	IF #mindate = #maxdate
		#mindate = 0
		#maxdate = 0
	ELSE
		#mindate = _DatePrep(#mindate)
		#maxdate = _DatePrep(#maxdate)
	END IF
	#startdate = _DatePrep(#startdate)
	IF INT(#mindate) <> #mindate OR #mindate < -2147483648 OR #mindate > 2147483647  'Delphi Integer
		_Status(1604)
		RETURN $retdefault
	END IF
	IF INT(#maxdate) <> #maxdate OR #maxdate < -2147483648 OR #maxdate > 2147483647  'Delphi Integer
		_Status(1604)
		RETURN $retdefault
	END IF
	IF INT(#startdate) <> #startdate OR #startdate < -2147483648 OR #startdate > 2147483647  'Delphi Integer
		_Status(1606)
		RETURN $retdefault
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN $retdefault
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN $retdefault
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowDatePicker" STACK "LPPLLLLPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) #mindate #maxdate #startdate #mode \
		DOSPTR(#stdparam) #ptrstatus
	#AXreg = GETREG(AX)
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN $retdefault
	ELSE
		RETURN DATE2(#AXreg - #dateadj)
	END IF
END FUNCTION

FUNCTION _GEMS_Time($title,$text,#mintime,#maxtime,#starttime,#mode)
 LOCAL $retdefault
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(_IsTime(#starttime))  'empty string is OK
		_Status(3005)
		RETURN ""
	END IF
	IF #starttime = 1 or #starttime = ""
		$retdefault = ""
	ELSE
		IF ISNUMBER(#starttime)
			$retdefault = FORMAT(#starttime,"T2")
		ELSE
			$retdefault = FORMAT(TIMEVALUE(#starttime),"T2")
		END IF
	END IF
	IF NOT(ISSTRING($title))
		_Status(3000)
		RETURN $retdefault
	END IF
	IF NOT(ISSTRING($text))
		_Status(13001)
		RETURN $retdefault
	END IF
	IF NOT(_IsTime(#mintime))  'empty string is OK
		_Status(3002)
		RETURN $retdefault
	END IF
	IF NOT(_IsTime(#maxtime))  'empty string is OK
		_Status(3003)
		RETURN $retdefault
	END IF
	IF NOT(ISNUMBER(#mode))
		_Status(3007)
		RETURN $retdefault
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		_Status(3008)
		RETURN $retdefault
	END IF
	IF #mintime = #maxtime
		#mintime = #timeadj
		#maxtime = #timeadj
	ELSE
		#mintime = _TimePrep(#mintime)
		#maxtime = _TimePrep(#maxtime)
	END IF
	#starttime = _TimePrep(#starttime)
	IF INT(#mintime) <> #mintime OR #mintime < 0 OR #mintime > 4294967295  'Delphi DWord
		_Status(3004)
		RETURN $retdefault
	END IF
	IF INT(#maxtime) <> #maxtime OR #maxtime < 0 OR #maxtime > 4294967295  'Delphi DWord
		_Status(3004)
		RETURN $retdefault
	END IF
	IF INT(#starttime) <> #starttime OR #starttime < 0 OR #starttime > 4294967295  'Delphi DWord
		_Status(3006)
		RETURN $retdefault
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN $retdefault
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN $retdefault
	END IF
	IF _GEMS_CtrlParam() <> 1
		RETURN $retdefault
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowTimePicker" STACK "LPPLLLLPPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) #mintime #maxtime #starttime #mode \
		DOSPTR(#ctrlparam) DOSPTR(#stdparam) #ptrstatus
	#AXreg = GETREG(AX)
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF #dllstatus <> 1   'error or canceled
		RETURN $retdefault
	ELSE
		RETURN FORMAT(#AXreg/#timeadj,"T2")
	END IF
END FUNCTION

FUNCTION _GEMS_ListBox($title,$text,$options,#mode,#sepchar)
 LOCAL $return $selected #optlen #ptrsl #sellen #isarray
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(2000)
		RETURN ""
	END IF
	IF NOT(ISSTRING($text))
		_Status(2001)
		RETURN ""
	END IF
	IF NOT(ISSTRING($options))
		IF NOT(_IsArray($options))
			_Status(2002)
			RETURN ""
		END IF
		#isarray = 1
	ELSE
		#isarray = 0
	END IF
	IF NOT(ISNUMBER(#mode))
		_Status(2004)
		RETURN ""
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		_Status(2005)
		RETURN ""
	END IF
	IF NOT(ISNUMBER(#sepchar))
		IF LEN(#sepchar) = 1
			#sepchar = ASC(#sepchar)
		ELSE
			#sepchar = 256 'invalid value
		END IF
	END IF
	IF INT(#sepchar) <> #sepchar OR #sepchar < 0 OR #sepchar > 255  'Delphi Byte
		_Status(2006)
		RETURN ""
	END IF
	#optlen = LEN($options)
	IF #isarray
		$options = _ArrayToString($options,#sepchar)
	END IF
	$GEMS_SelectedOptions = ""
	$GEMS_SortedOptions = ""
	$return = REPEAT(" ",1000)
	IF #isarray
		$selected = ""
		#ptrsl = 0
	ELSE
		$selected = REPEAT(" ",#optlen+1)
		MEMALLOC #ptrsl SIZEOF "W"
		MEMPACK #ptrsl "W" 0
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN ""
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN ""
	END IF
	IF _GEMS_CtrlParam() <> 1
		RETURN ""
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowListBox" STACK "LPPPLLPPPPPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) DOSPTR($options) #mode #sepchar DOSPTR($return) \
		DOSPTR($selected) #ptrsl DOSPTR(#ctrlparam) DOSPTR(#stdparam) #ptrstatus
	#AXreg = _intAX()
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF NOT(#isarray)
		MEMUNPACK #ptrsl "W" #sellen
		MEMFREE #ptrsl
	END IF
'if the user double clicks a selection a stray mouse up may be buffered.
	_ClearKM()
	IF #dllstatus <> 1   'error or canceled
		RETURN ""
	ELSE
		IF NOT(#isarray)
			IF BITAND(#mode,32)
				$GEMS_SortedOptions = LEFT($options,#optlen)
			END IF
			$GEMS_SelectedOptions = LEFT($selected,#sellen)
		END IF
		RETURN LEFT($return,#AXreg)
	END IF
END FUNCTION

FUNCTION _GEMS_CheckList($title,$text,$options,#mode,#sepchar)
 LOCAL $return $selected #optlen #ptrsl #sellen #isarray
	#GEMS_Cancel = 0
	#GEMS_Error = 0
	IF NOT(ISSTRING($title))
		_Status(1200)
		RETURN ""
	END IF
	IF NOT(ISSTRING($text))
		_Status(1201)
		RETURN ""
	END IF
	IF NOT(ISSTRING($options))
		IF NOT(_IsArray($options))
			_Status(1202)
			RETURN ""
		END IF
		#isarray = 1
	ELSE
		#isarray = 0
	END IF
	IF NOT(ISNUMBER(#mode))
		_Status(1204)
		RETURN ""
	END IF
	IF INT(#mode) <> #mode OR #mode < 0 OR #mode > 255  'Delphi Byte
		_Status(1205)
		RETURN ""
	END IF
	IF NOT(ISNUMBER(#sepchar))
		IF LEN(#sepchar) = 1
			#sepchar = ASC(#sepchar)
		ELSE
			#sepchar = 256 'invalid value
		END IF
	END IF
	IF INT(#sepchar) <> #sepchar OR #sepchar < 0 OR #sepchar > 255  'Delphi Byte
		_Status(1206)
		RETURN ""
	END IF
	#optlen = LEN($options)
	IF #isarray
		$options = _ArrayToString($options,#sepchar)
	END IF
	$GEMS_SelectedOptions = ""
	$GEMS_SortedOptions = ""
	$return = REPEAT(" ",1000)
	IF #isarray
		$selected = ""
		#ptrsl = 0
	ELSE
		$selected = REPEAT(" ",#optlen+1)
		MEMALLOC #ptrsl SIZEOF "W"
		MEMPACK #ptrsl "W" 0
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN ""
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN ""
	END IF
	IF _GEMS_CtrlParam() <> 1
		RETURN ""
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowCheckList" STACK "LPPPLLPPPPPP" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) DOSPTR($options) #mode #sepchar DOSPTR($return) \
		DOSPTR($selected) #ptrsl DOSPTR(#ctrlparam) DOSPTR(#stdparam) #ptrstatus
	#AXreg = _intAX()
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	IF NOT(#isarray)
		MEMUNPACK #ptrsl "W" #sellen
		MEMFREE #ptrsl
	END IF
	IF #dllstatus <> 1   'error or canceled
		RETURN ""
	ELSE
		IF NOT(#isarray)
			IF BITAND(#mode,32)
				$GEMS_SortedOptions = LEFT($options,#optlen)
			END IF
			$GEMS_SelectedOptions = LEFT($selected,#sellen)
		END IF
		RETURN LEFT($return,#AXreg)
	END IF
END FUNCTION

FUNCTION _GEMS_Display_Message($text1,$text2,#unused)
	#GEMS_Error = 0
	IF ISSTRING($text1) + ISSTRING($text2) <> 2
		RETURN _Status(1650)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	DLL CALL #GEMShnd FUNCTION "ShowDisplayMessage" STACK "LPPPP" \
		#GEMS_SWWinH DOSPTR($GEMS_RADFuncTitle) DOSPTR($text1) DOSPTR($text2) DOSPTR(#stdparam)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _GEMS_Get_Choice($text1,$text2,$text3,$text4,$buttons,#unused)
 LOCAL #sepchar
	#GEMS_Error = 0
	#GEMS_Cancel = 0
	IF ISSTRING($text1) + ISSTRING($text2) + ISSTRING($text3) +ISSTRING($text4) <> 4
		RETURN _Status(1750)
	END IF
	IF NOT(ISNUMBER(#GEMS_GCSepChar))
		IF LEN(#GEMS_GCSepChar) = 1
			#sepchar = ASC(#GEMS_GCSepChar)
		ELSE
			#sepchar = 256 'invalid value
		END IF
	ELSE
		#sepchar = #GEMS_GCSepChar
	END IF
	IF INT(#sepchar) <> #sepchar OR #sepchar < 0 OR #sepchar > 255  'Delphi Byte
		_Status(1751)
		RETURN ""
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	IF _GEMS_StdParam() <> 1
		RETURN -1
	END IF
	#dllstatus = 0
	MEMALLOC #ptrstatus SIZEOF "W"
	MEMPACK #ptrstatus "W" #dllstatus
	DLL CALL #GEMShnd FUNCTION "ShowGetChoice" STACK "LPPPPPPLPP" \
		#GEMS_SWWinH DOSPTR($GEMS_RADFuncTitle) DOSPTR($text1) DOSPTR($text2) DOSPTR($text3) \
		DOSPTR($text4) DOSPTR($buttons) #sepchar DOSPTR(#stdparam) #ptrstatus
	#AXreg = GETREG(AX)
	MEMUNPACK #ptrstatus "W" #dllstatus
	MEMFREE #ptrstatus
	_Status(#dllstatus)
	RETURN #AXreg
END FUNCTION

FUNCTION _ArrayToString(#aptr,#sep)
 LOCAL #i #j #options $temp #pos #optlen
	#optlen = 0
	FOR #i = 1 TO ARRAYSIZE(#aptr,1)
		#optlen = #optlen + LEN(READPTR(#aptr,#i))+1
	END FOR
	BUFFER #options SIZE #optlen+1
	#pos =0
	FOR #i = 1 TO ARRAYSIZE(#aptr,1)
		$temp = READPTR(#aptr,#i)
		FOR #j = 1 TO LEN($temp)
			POKE 0 DOSPTR(#options)+#pos "C" ASC(MID($temp,#j,1))
			#pos = #pos + 1
		END FOR
		POKE 0 DOSPTR(#options)+#pos "C" #sep
		#pos = #pos + 1
	END FOR
	POKE 0 DOSPTR(#options)+#pos "C" 0
	RETURN #options
END FUNCTION

FUNCTION _intAX()
	#AXreg = GETREG(AX)
	IF BITAND(#AXreg,0x80000000)    'negative value
		#AXreg = (#AXreg - 0x80000000) - 0x80000000
	END IF
	RETURN #AXreg
END FUNCTION

FUNCTION _DatePrep(#date)
	IF #date = ""
		RETURN 0
	ELSE
		RETURN datevalue(#date) + #dateadj
	END IF
END FUNCTION

FUNCTION _TimePrep(#time)
	IF #time = ""
		RETURN #timeadj
	ELSE
		IF NOT(ISNUMBER(#time))
			#time = TIMEVALUE(#time)
		END IF
		RETURN min(max(INT(#time*#timeadj),0),#timeadj)
	END IF
END FUNCTION

FUNCTION _IsTime(#time)
 LOCAL $hours $mins $secs $ampm #temp
	IF ISNUMBER(#time)
		IF #time >=1 OR #time < 0
			RETURN 0
		END IF
	ELSE
		IF #time <> ""
			$hours = ""
			$mins = ""
			$secs = ""
			$ampm = ""
			#time = TRIM(#time)
			#temp = MATCH(#time,":")
			IF #temp <> 0
				$hours = TRIM(LEFT(#time,#temp-1))
				#time = MID(#time,#temp+1)
				WHILE LEN(#time) > 0 AND RIGHT(#time,1) <> STR(VAL(RIGHT(#time,1)))
					$ampm = RIGHT(#time,1)|$ampm
					#time = TRIM(LEFT(#time,LEN(#time)-1))
				END WHILE
				#temp = MATCH(#time,":")
				IF #temp <> 0
					$mins = TRIM(LEFT(#time,#temp-1))
					$secs = TRIM(MID(#time,#temp+1))
				ELSE
					$mins = #time
				END IF
			END IF
			IF VAL($hours) > 23 OR VAL($hours) < 0 OR INT(VAL($hours)) <> VAL($hours) OR \
					LEN($hours) < 1 OR LEN($hours) > 2 OR RIGHT("0"|$hours,2) <> RIGHT("0"|STR(VAL($hours)),2)
				RETURN 0
			END IF
			IF VAL($mins) > 59 OR VAL($mins) < 0 OR INT(VAL($mins)) <> VAL($mins) OR \
					LEN($mins) < 1 OR LEN($mins) > 2 OR RIGHT("0"|$mins,2) <> RIGHT("0"|STR(VAL($mins)),2)
				RETURN 0
			END IF
			IF $secs <> ""
				IF VAL($secs) > 59 OR VAL($secs) < 0 OR INT(VAL($secs)) <> VAL($secs) OR \
						LEN($secs) < 1 OR LEN($secs) > 2 OR RIGHT("0"|$secs,2) <> RIGHT("0"|STR(VAL($secs)),2)
					RETURN 0
				END IF
			END IF
			IF $ampm <> ""
				IF (CASE UPPER($ampm) ("A",1)("AM",1)("P",1)("PM",1) ELSE 0) = 0
					RETURN 0
				END IF
				IF VAL($hours) > 12 OR VAL($hours) < 1
					RETURN 0
				END IF
			END IF
		END IF
	END IF
	RETURN 1
END FUNCTION

FUNCTION _IsArray(#aptr)
 LOCAL #erroron #isarray #temp
	IF SYSVAR($_error)
		#erroron = 1
		ERROR OFF
	ELSE
		#erroron = 0
	END IF
	CLEARERROR
	#temp = ARRAYSIZE(#aptr,1)
	IF LERROR = 0  'exepected error is 445 (not a pointer to an array)
		#isarray = 1
	ELSE
		#isarray = 0
	END IF
	IF #erroron
		ERROR ON
	END IF
	RETURN #isarray
END FUNCTION

FUNCTION _Status(#status)
	IF #status = 1
		RETURN 1
	ELSEIF #status = 2
		#GEMS_Cancel = 1
		RETURN 1
	ELSE
		IF #status = 0
			#GEMS_Error = 101     'Unknown DLL error
		ELSE
			#GEMS_Error = #status
		END IF
		IF #GEMS_SWError35
			ERROR
		END IF
		RETURN -1
	END IF
END FUNCTION

FUNCTION _GEMS_Windialog($text,$title,#type)
' For multi line text put a carriage return in your text
'   e.g. $ text = "Line 1"|chr(13)|"Line 2"|chr(13)|"Line 3"
' Select the required buttons with #type
'   0 = OK
'   1 = OK Cancel
'   2 = Abort Retry Ignore
'   3 = Yes No Cancel
'   4 = Yes No
'   5 = Retry Cancel
' Default is no icon - add one of the following to #type to get one
'   Add 16 for the Error X
'   Add 32 for the confirmation question mark
'   Add 48 for the warning exclamation mark
'   Add 64 for the information i
' First button is the default unless another number is added to #type
'   Add 256 - second button is the default
'   Add 512 - third button is the default
' The priority of the box can also be changed
'   Add 4096 - to make the box system modal
'   Add 262144 - to make the box appear in the foreground
' Return value is the button pressed - Esc = Cancel if there is a Cancel buttton
 LOCAL #dlluser32wd #result
	DLL LOAD "user32.dll" #dlluser32wd
	DLL CALL #dlluser32wd FUNCTION "MessageBoxA" STACK "LPPL" #GEMS_SWWinH DOSPTR($text) DOSPTR($title) #type
	#result = GETREG(AX)
	DLL UNLOAD #dlluser32wd
	RETURN GROUP("OK Cancel Abort Retry Ignore Yes No",#result)
END FUNCTION

FUNCTION _GEMS_Web($url)
	IF LEFT($url,1) = "[" AND RIGHT($url,1) = "]"
		$url = DBGET($url)
	END IF
	IF TRIM($url) <> ""
		IF UPPER(LEFT($url,4)) <> "HTTP"
			$url = "http://"|$url
		END IF
		_GEMS_ShellEx("open",$url,"",1)
	END IF
END FUNCTION

FUNCTION _GEMS_EmailTo($mailadd)
	IF LEFT($mailadd,1) = "[" AND RIGHT($mailadd,1) = "]"
		$mailadd = DBGET($mailadd)
	END if
	IF TRIM($mailadd) <> ""
		_GEMS_Email($mailadd,"","","","")
	END IF
END FUNCTION

FUNCTION _GEMS_Email($to,$cc,$subject,$text,$file)
' Separate multiple addresses with ; and put %0A in text for a new line
' File attachments only work with certain mail clients (e.g. Outlook)
 LOCAL $mailto
	$mailto = "mailto:"|$to|"?cc="|$cc|"&subject="|$subject|"&body="|$text
	IF $file <> ""
		$mailto = $mailto|"&file="|chr(34)|$file|chr(34)
	END IF
	_GEMS_ShellEx("open",$mailto,"",1)
END FUNCTION

FUNCTION _GEMS_ShellEx($op,$command,$param,#mode)
 LOCAL #shell32dll
	DLL LOAD "shell32.dll" #shell32dll
	DLL CALL #shell32dll FUNCTION "ShellExecuteA" STACK "LPPPPL" \
		#GEMS_SWWinH DOSPTR($op) DOSPTR($command) DOSPTR($param) 0 #mode
	DLL UNLOAD #shell32dll
	RETURN GETREG(AX)
END FUNCTION

FUNCTION _GEMS_Group($data,#item,#sepchar)
 LOCAL #posA #posB #i #pos
	#posA = 0
	#posB = 0
	#pos = 0
	FOR #i = 1 TO #item
		#pos = MATCH($data,CHR(#sepchar),#pos+1)
		IF #pos = 0
			EXIT FOR
		END IF
		IF #i = #item - 1
			#posA = #pos
		ELSEIF #i = #item
			#posB = #pos
		END IF
	END FOR
	IF #posA = 0
		IF #posB = 0
			RETURN ""
		ELSE
			RETURN LEFT($data,#posB-1)
		END IF
	ELSE
		IF #posB = 0
			RETURN MID($data,#posA+1)
		ELSE
			RETURN MID($data,#posA+1,(#posB-#posA-1))
		END IF
	END IF
END FUNCTION

FUNCTION _GEMS_About($title,$text)
'include # in $title and to separate title and text to appear at the ned of the first line
	DLL LOAD "shell32.dll" #dllshell32
	DLL CALL #dllshell32 FUNCTION "ShellAboutA" STACK "LPPL" \
		#GEMS_SWWinH DOSPTR($title) DOSPTR($text) 0
	DLL UNLOAD #dllshell32
END FUNCTION

FUNCTION _GEMS_SWCmndLine()
 LOCAL #ptr $cmndline
	DLL LOAD "kernel32.dll" #dllkernel32
	DLL CALL #dllkernel32 FUNCTION "GetCommandLineA"
	#ptr = GETREG(AX)
	DLL UNLOAD #dllkernel32
	PEEK 0 #ptr "S" $cmndline
	RETURN $cmndline
END FUNCTION

FUNCTION _GEMS_GetDir(#type)
' Returns an o/s defined directories - #type  1=System  2=Windows  3=Temp
 LOCAL #retlength $retstring
	#retlength = 256
	$retstring = REPEAT(" ",#retlength+1)
	DLL LOAD "kernel32.dll" #dllkernel32
	IF #type = 1
		DLL CALL #dllkernel32 FUNCTION "GetSystemDirectoryA" STACK "PL" DOSPTR($retstring) #retlength
	ELSEIF #type = 2
		DLL CALL #dllkernel32 FUNCTION "GetWindowsDirectoryA" STACK "PL" DOSPTR($retstring) #retlength
	ELSEIF #type = 3
		DLL CALL #dllkernel32 FUNCTION "GetTempPathA" STACK "LP" #retlength DOSPTR($retstring)
	ELSE
		DLL UNLOAD #dllkernel32
		RETURN ""
	END IF
	#retlength = GETREG(AX)
	$retstring = LEFT($retstring,#retlength)
	DLL UNLOAD #dllkernel32
	IF RIGHT($retstring,1) <> "\"
		$retstring = $retstring|"\"
	END IF
	RETURN $retstring
END FUNCTION

FUNCTION _GEMS_SetSWTitle($title)
 LOCAL #result
	IF NOT(ISSTRING($title))
		RETURN -1
	END IF
	DLL LOAD "user32.dll" #dlluser32
	DLL CALL #dlluser32 FUNCTION "SetWindowTextA" STACK "LP" #GEMS_SWWinH DOSPTR($title)
	#result = case GETREG(AX) (0,0) else 1
	DLL UNLOAD #dlluser32
END FUNCTION

FUNCTION _GEMS_SetSWIcon($icon)
	#GEMS_Error = 0
	#GEMS_Cancel = 0
	IF NOT(ISSTRING($icon))
		RETURN _Status(2700)
	END IF
	IF #GEMShnd = 0
		IF _GEMS_Load() <> 1
			RETURN -1
		END IF
	END IF
	DLL CALL #GEMShnd FUNCTION "SetIcon" STACK "LP" #GEMS_SWWinH DOSPTR($icon)
	RETURN _Status(GETREG(AX))
END FUNCTION

FUNCTION _ClearKM()
'Clears stray mouse up events from the keyboard buffer.
	WHILE MOUSEINFO(m_buttons) <> 42
		MILLI-WAIT 5
	END WHILE
	WHILE NEXTKEY
		INEVENT
	END WHILE
END FUNCTION