$IFNDEF __RQINC
$DEFINE __RQINC
CONST False = 0
CONST True = 1
CONST alNone = 0
CONST alTop = 1
CONST alBottom = 2
CONST alLeft = 3
CONST alRight = 4
CONST alClient = 5
CONST taLeftJustify = 0
CONST taRightJustify = 1
CONST taCenter = 2
$IFNDEF __WIN32API
CONST SND_SYNC = 0
CONST SND_ASYNC = 1
CONST SND_LOOP = 8
CONST SND_NODEFAULT = &H2
CONST SND_NOSTOP = &H10
CONST SND_MEMORY = &H4
$ENDIF
CONST clBlack = 0
CONST clWhite = &HFFFFFF
CONST clBlue = &HFF0000
CONST clGreen = &H00FF00
CONST clRed = &H0000FF
CONST clPurple = &HFF00FF
CONST clYellow=&H00FFFF
CONST clScrollBar = -2147483648
CONST clBackGround = -2147483647
CONST clActiveCaption = -2147483646
CONST clInActiveCaption = -2147483645
CONST clMenu = -2147483644
CONST clWindow = -2147483643
CONST clWindowFrame = -2147483642
CONST clMenuText = -2147483641
CONST clWindowText = -2147483640
CONST clCaptionText = -2147483639
CONST clActiveBorder = -2147483638
CONST clInActiveBorder = -2147483637
CONST clAppWorkSpace = -2147483636
CONST clHilight = -2147483635
CONST clHilightText = -2147483634
CONST clBtnFace = -2147483633
CONST clBtnShadow = -2147483632
CONST clGrayText = -2147483631
CONST clBtnText = -2147483630
CONST clInActiveCaptionText = -2147483629
CONST clBtnHighlight = -2147483628
CONST cl3DDkShadow = -2147483627
CONST cl3DLight = -2147483626
CONST clInfoText = -2147483625
CONST clInfoBk3DDkShadow = -2147483624
CONST clNone = 536870911
CONST clDefault = 536870912
CONST MouseRtButton = 1
CONST MouseLtButton = 0
CONST ssShift = 256
CONST ssCtrl = 16
CONST ssAlt = 1
CONST mtWarning = 0
CONST mtError = 1
CONST mtInformation = 2
CONST mtConfirmation = 3
CONST mtCustom = 4
CONST mbYes = 1
CONST mbNo = 2
CONST mbOK = 4
CONST mbCancel = 8
CONST mbHelp = 16
CONST mbAbort = 32
CONST mbRetry = 64
CONST mbIgnore = 128
CONST mbAll = 256
CONST fsBold = 0
CONST fsItalic = 1
CONST fsUnderline = 2
CONST fsStrikeOut = 3
CONST fpDefault = 0
CONST fpVariable = 1
CONST fpFixed = 2
$IFNDEF __WIN32API
CONST ANSI_CHARSET = 0
CONST DEFAULT_CHARSET = 1
CONST SYMBOL_CHARSET = 2
CONST MAC_CHARSET = 77
CONST SHIFTJIS_CHARSET = 128
CONST HANGEUL_CHARSET = 129
CONST JOHAB_CHARSET = 130
CONST GB2312_CHARSET = 134
CONST CHINESEBIG5_CHARSET = 136
CONST GREEK_CHARSET = 161
CONST TURKISH_CHARSET = 162
CONST VIETNAMESE_CHARSET = 163
CONST HEBREW_CHARSET = 177
CONST ARABIC_CHARSET = 178
CONST BALTIC_CHARSET = 186
CONST RUSSIAN_CHARSET = 204
CONST THAI_CHARSET = 222
CONST EASTEUROPE_CHARSET = 238
CONST OEM_CHARSET = 255
$ENDIF
CONST wsNormal = 0
CONST wsMinimized = 1
CONST wsMaximized = 2
CONST fsNormal = 0
CONST fsMDIChild = 1
CONST fsMDIForm = 2
CONST fsStayOnTop = 3
CONST bsNone = 0
CONST bsSingle = 1
CONST bsSizeable = 2
CONST bsDialog = 3
CONST bsToolWindow = 4
CONST bsSizeToolWin = 5
CONST CtrlDown = 1
CONST AltDown = 16
CONST ShiftDown = 256
CONST biSystemMenu = 0
CONST biMinimize = 1
CONST biMaximize = 2
CONST biHelp = 3
CONST caNone = 0
CONST caHide = 1
CONST caFree = 2
CONST caClose = caFree
CONST caMinimize = 3
CONST tlTop = 0
CONST tlCenter = 1
CONST tlBottom = 2
CONST lsNone = 0
CONST lsRaised = 1
CONST lsRecessed = 2
CONST bvNone = 0
CONST bvLowered = 1
CONST bvRaised = 2
CONST bpNone = 0
CONST bpSingle = 1
CONST ecNormal = 0
CONST ecUpperCase = 1
CONST ecLowerCase = 2
CONST csDropDown = 0
CONST csSimple = 1
CONST csDropDownList = 2
CONST csOwnerDrawFixed = 3
CONST csOwnerDrawVariable = 4
CONST fmCreate = 65535
CONST fmOpenRead = 0
CONST fmOpenWrite = 1
CONST fmOpenReadWrite = 2
CONST soFromBeginning = 0
CONST soFromCurrent = 1
CONST soFromEnd = 2
CONST Num_BYTE = 1
CONST Num_SHORT = 2
CONST Num_WORD = 3
CONST Num_LONG = 4
CONST Num_DWORD = 5
CONST Num_SINGLE = 6
CONST Num_DOUBLE = 8
CONST ssNone = 0
CONST ssHorizontal = 1
CONST ssVertical = 2
CONST ssBoth = 3
CONST mrNone = 0
CONST mrOK = 1
CONST mrCancel = 2
CONST mrAbort = 3
CONST mrRetry = 4
CONST mrIgnore = 5
CONST mrYes = 6
CONST mrNo = 7
CONST mrAll = 8
CONST mrNoToAll = 9
CONST mrYesToAll = 10
CONST blBMPLeft = 0
CONST blBMPRight = 1
CONST blBMPTop = 2
CONST blBMPBottom = 3
CONST bkCustom = 0
CONST bkOK = 1
CONST bkCancel = 2
CONST bkHelp = 3
CONST bkYes = 4
CONST bkNo = 5
CONST bkClose = 6
CONST bkAbort = 7
CONST bkRetry = 8
CONST bkIgnore = 9
CONST bkAll = 10
CONST crDefault = 0
CONST crNone = -1
CONST crArrow = -2
CONST crCross = -3
CONST crIBeam = -4
CONST crSize = -5
CONST crSizeNESW = -6
CONST crSizeNS = -7
CONST crSizeNWSE = -8
CONST crSizeWE = -9
CONST crUpArrow = -10
CONST crHourGlass = -11
CONST crDrag = -12
CONST crNoDrop = -13
CONST crHSplit = -14
CONST crVSplit = -15
CONST crMultiDrag = -16
CONST crSQLWait = -17
CONST crNo = -18
CONST crAppStart = -19
CONST crHelp = -20
CONST crHandPoint = -21
CONST ftReadOnly = 0
CONST ftHidden = 1
CONST ftSystem = 2
CONST ftVolumeID = 3
CONST ftDirectory = 4
CONST ftArchive = 5
CONST ftNormal = 6
CONST sbHorizontal = 0
CONST sbVertical = 1
CONST scLineUp = 0
CONST scLineDown = 1
CONST scPageUp = 2
CONST scPageDown = 3
CONST scPosition = 4
CONST scTrack = 5
CONST scTop = 6
CONST scBottom = 7
CONST scEndScroll = 8
CONST dsFocused = 0
CONST dsSelected = 1
CONST dsNormal = 2
CONST dsTransparent = 3
CONST itImage = 0
CONST itMask = 1
CONST stNone = 0
CONST stText = 2
CONST vsIcon = 0
CONST vsSmallIcon = 1
CONST vsList = 2
CONST vsReport = 3
CONST tbHorizontal = 0
CONST tbVertical = 1
CONST tmBottomRight = 0
CONST tmTopLeft = 1
CONST tmBoth = 2
CONST tsNone = 0
CONST tsAuto = 1
CONST tsManual = 2
CONST goFixedVertLine = 0
CONST goFixedHorzLine = 1
CONST goVertLine = 2
CONST goHorzLine = 3
CONST goRangeSelect = 4
CONST goDrawFocusSelected = 5
CONST goRowSizing = 6
CONST goColSizing = 7
CONST goRowMoving = 8
CONST goColMoving = 9
CONST goEditing = 10
CONST goTabs = 11
CONST goRowSelect = 12
CONST goAlwaysShowEditor = 13
CONST goThumbTracking = 14
CONST gcsList = 0
CONST gcsEllipsis = 1
CONST gcsNone = 2
CONST osText = 0
CONST osPlusMinusText = 1
CONST osPictureText = 2
CONST osPlusMinusPictureText = 3
CONST osTreeText = 4
CONST osTreePictureText = 5
CONST ooDrawTreeRoot = 0
CONST ooDrawFocusRect = 1
CONST ooDrawStretchBitmaps = 2
CONST gkText = 0
CONST gkHorizontalBar = 1
CONST gkVerticalBar = 2
CONST gkPie = 3
CONST gkNeedle = 4
CONST cmBlackness = &H42
CONST cmDstInvert = &H550009
CONST cmMergeCopy = &HC000CA
CONST cmMergePaint = &HBB0226
CONST cmNotSrcCopy = &H330008
CONST cmNotSrcErase = &H1100A6
CONST cmPatCopy = &HF00021
CONST cmPatInvert = &H5A0049
CONST cmPatPaint = &HFB0A09
CONST cmSrcAnd = &H8800C6
CONST cmSrcCopy = &HCC0020
CONST cmSrcErase = &H440328
CONST cmSrcInvert = &H660046
CONST cmSrcPaint = &HEE0086
CONST cmWhiteness = &HFF0062
CONST pfDevice = 0
CONST pf1bit = 1
CONST pf4bit = 2
CONST pf8bit = 3
CONST pf15bit = 4
CONST pf16bit = 5
CONST pf24bit = 6
CONST pf32bit = 7
CONST tmAuto = 0
CONST tmFixed = 1
CONST lbStandard = 0
CONST lbOwnerDrawFixed = 1
CONST lbOwnerDrawVariable = 2
CONST br110 = 0
CONST br300 = 1
CONST br600 = 2
CONST br1200 = 3
CONST br2400 = 4
CONST br4800 = 5
CONST br9600 = 6
CONST br14400 = 7
CONST br19200 = 8
CONST br38400 = 9
CONST br56000 = 10
CONST br57600 = 11
CONST br115200 = 12
CONST sbOneStopBit = 0
CONST sbOneStopBits = 1
CONST sbTwoStopBits = 2
CONST prNone = 0
CONST prOdd = 1
CONST prEven = 2
CONST prMark = 3
CONST prSpace = 4
CONST fdAnsiOnly = 0
CONST fdTrueTypeOnly = 1
CONST fdEffects = 2
CONST fdFixedPitchOnly = 3
CONST fdForceFontExist = 4
CONST fdNoFaceSel = 5
CONST fdNoOEMFonts = 6
CONST fdNoSimulations = 7
CONST fdNoSizeSel = 8
CONST fdNoStyleSel = 9
CONST fdNoVectorFonts = 10
CONST fdShowHelp = 11
CONST fdWysiwyg = 12
CONST fdLimitSize = 13
CONST fdScalableOnly = 14
CONST fdApplyButton = 15
CONST dtReadOnly = 0
CONST dtHidden = 1
CONST dtSystem = 2
CONST dtNormal = 3
CONST dtAll = 4
CONST drtUnknown = 0
CONST drtRemovable = 1
CONST drtFixed = 2
CONST drtRemote = 3
CONST drtCDRom = 4
CONST drtRamDisk = 5
CONST IPPROTO_IP = 0
CONST IPPROTO_ICMP = 1
CONST IPPROTO_IGMP = 2
CONST IPPROTO_TCP = 6
CONST IPPROTO_PUP = 12
CONST IPPROTO_UDP = 17
CONST IPPROTO_IDP = 22
CONST IPPROTO_RAW = 255
CONST SOCK_STREAM = 1
CONST SOCK_DGRAM = 2
CONST SOCK_RAW = 3
CONST SOCK_RDM = 4
CONST SOCK_SEQPACKET = 5
CONST AF_UNSPEC = 0
CONST AF_UNIX = 1
CONST AF_INET = 2
CONST AF_IMPLINK = 3
CONST AF_PUP = 4
CONST AF_CHAOS = 5
CONST AF_IPX = 6
CONST AF_NS = 6
CONST AF_ISO = 7
CONST AF_OSI = AF_ISO
CONST AF_ECMA = 8
CONST AF_DATAKIT = 9
CONST AF_CCITT = 10
CONST AF_SNA = 11
CONST AF_DECnet = 12
CONST AF_DLI = 13
CONST AF_LAT = 14
CONST AF_HYLINK = 15
CONST AF_APPLETALK = 16
CONST AF_NETBIOS = 17
CONST AF_VOICEVIEW = 18
CONST AF_FIREFOX = 19
CONST AF_UNKNOWN1 = 20
CONST AF_BAN = 21
CONST hsText = 0
CONST hsOwnerDraw = 1
CONST dupIgnore = 0
CONST dupAccept = 1
CONST dupError = 2
CONST smClip = 0
CONST smCenter = 1
CONST smScale = 2
CONST smStretch = 3
CONST smAutoSize = 4
CONST osEmpty = 0
CONST osLoaded = 1
CONST osRunning = 2
CONST osOpen = 3
CONST osInPlaceActive = 4
CONST osUIActive = 5
CONST ffGeneral = 0
CONST ffExponent = 1
CONST ffFixed = 2
CONST ffNumber = 3
CONST faReadOnly = 1
CONST faHidden = 2
CONST faSysFile = 4
CONST faVolumeID = 8
CONST faDirectory = 16
CONST faArchive = 32
CONST faAnyFile = 63
CONST poPortrait = 0
CONST poLandscape = 1
$IFNDEF __QBCOLOR
$DEFINE __QBCOLOR
DIM QBColor(0 TO 15) AS INTEGER
QBColor(0) = 0
QBColor(1) = &H800000
QBColor(2) = &H8000
QBColor(3) = &H808000
QBColor(4) = &H80
QBColor(5) = &H800080
QBColor(6) = &H8080
QBColor(7) = &HC0C0C0
QBColor(8) = &H808080
QBColor(9) = &HFF0000
QBColor(10) = &HFF00
QBColor(11) = &HFFFF00
QBColor(12) = &HFF
QBColor(13) = &HFF00FF
QBColor(14) = &HFFFF
QBColor(15) = &HFFFFFF
$ENDIF
$ENDIF
$IFDEF __EXTENSIONS_OFF
$DEFINE __RQ2WIN32API
$DEFINE __RQINC2
$ENDIF
$IFDEF __WIN32API
$DEFINE __RQ2WIN32API
$ENDIF
$IFNDEF __RQ2WIN32API
$DEFINE __RQ2WIN32API
CONST GWL_HWNDPARENT = (-8)
CONST GWL_WNDPROC = -4
CONST GWL_STYLE = -16
CONST HWND_DESKTOP = 0
CONST HWND_TOPMOST = -1
CONST HWND_NOTOPMOST = -2
$DEFINE HWND_TOP 0
$DEFINE HWND_BOTTOM 1
$DEFINE SWP_NOSIZE &H1
$DEFINE SWP_NOMOVE &H2
$DEFINE SWP_NOZORDER &H4
$DEFINE SWP_NOACTIVATE &H10
$DEFINE SWP_SHOWWINDOW &H40
$DEFINE SWP_NOSENDCHANGING &H400
$DEFINE NIM_ADD 0
$DEFINE NIM_MODIFY 1
$DEFINE NIM_DELETE 2
$DEFINE NIF_MESSAGE 1
$DEFINE NIF_ICON 2
$DEFINE NIF_TIP 4
$DEFINE WM_ACTIVATE &H0006
$DEFINE WA_INACTIVE 0
$DEFINE WA_ACTIVE 1
$DEFINE WA_CLICKACTIVE 2
$DEFINE WM_SETFOCUS &H0007
$DEFINE WM_KILLFOCUS &H0008
$DEFINE WM_KEYFIRST &H100
$DEFINE WM_KEYDOWN &H100
$DEFINE WM_KEYUP &H101
$DEFINE WM_CHAR &H102
$DEFINE WM_DEADCHAR &H103
$DEFINE WM_SYSKEYDOWN &H104
$DEFINE WM_SYSKEYUP &H105
$DEFINE WM_SYSCHAR &H106
$DEFINE WM_SYSDEADCHAR &H107
$DEFINE WM_KEYLAST &H108
$DEFINE WM_INITDIALOG &H110
$DEFINE WM_COMMAND &H111
$DEFINE WM_SYSCOMMAND &H112
$DEFINE WM_TIMER &H113
$DEFINE WM_HSCROLL &H114
$DEFINE WM_VSCROLL &H115
$DEFINE WM_DRAWITEM &H2B
$DEFINE WM_MEASUREITEM &H2C
$DEFINE WM_INITMENU &H116
$DEFINE WM_INITMENUPOPUP &H117
$DEFINE WM_MENUSELECT &H11Fg
$DEFINE WM_MENUCHAR &H120
$DEFINE WM_ENTERIDLE &H121
$DEFINE WM_CTLCOLORMSGBOX &H132
$DEFINE WM_CTLCOLOREDIT &H133
$DEFINE WM_CTLCOLORLISTBOX &H134
$DEFINE WM_CTLCOLORBTN &H135
$DEFINE WM_CTLCOLORDLG &H136
$DEFINE WM_CTLCOLORSCROLLBAR &H137
$DEFINE WM_CTLCOLORSTATIC &H138
$DEFINE WM_MOUSEFIRST &H200
$DEFINE WM_MOUSEMOVE &H200
$DEFINE WM_LBUTTONDOWN &H201
$DEFINE WM_LBUTTONUP &H202
$DEFINE WM_LBUTTONDBLCLK &H203
$DEFINE WM_RBUTTONDOWN &H204
$DEFINE WM_RBUTTONUP &H205
$DEFINE WM_RBUTTONDBLCLK &H206
$DEFINE WM_MBUTTONDOWN &H207
$DEFINE WM_MBUTTONUP &H208
$DEFINE WM_MBUTTONDBLCLK &H209
$DEFINE WM_MOUSEWHEEL &H20A
$DEFINE WM_MOUSELAST &H20A
$DEFINE WM_DROPFILES &H233
$DEFINE WM_TRAYICON &H590
$DEFINE SC_MINIMIZE 61472
$DEFINE WM_USER &H400
TYPE LARGE_INTEGER
LowPart AS DWORD
HighPart AS DWORD
END TYPE
TYPE POINTAPI
X AS LONG
Y AS LONG
END TYPE
TYPE RECT
Left AS LONG
Top AS LONG
Right AS LONG
Bottom AS LONG
END TYPE
$DEFINE OBJ_PEN 1
$DEFINE OBJ_BRUSH 2
$DEFINE OBJ_DC 3
$DEFINE OBJ_METADC 4
$DEFINE OBJ_PAL 5
$DEFINE OBJ_FONT 6
$DEFINE OBJ_BITMAP 7
$DEFINE OBJ_REGION 8
$DEFINE OBJ_METAFILE 9
$DEFINE OBJ_MEMDC 10
$DEFINE OBJ_EXTPEN 11
$DEFINE OBJ_ENHMETADC 12
$DEFINE OBJ_ENHMETAFILE 13
$DEFINE CF_TEXT 1
$DEFINE CF_BITMAP 2
$DEFINE CF_METAFILEPICT 3
$DEFINE CF_SYLK 4
$DEFINE CF_DIF 5
$DEFINE CF_TIFF 6
$DEFINE CF_OEMTEXT 7
$DEFINE CF_DIB 8
$DEFINE CF_PALETTE 9
$DEFINE CF_PENDATA 10
$DEFINE CF_RIFF 11
$DEFINE CF_WAVE 12
$DEFINE CF_UNICODETEXT 13
$DEFINE CF_ENHMETAFILE 14
TYPE WNDCLASSEX
cbSize AS LONG
style AS LONG
lpfnWndProc AS LONG
cbClsExtra AS LONG
cbWndExtra AS LONG
hInstance AS LONG
hIcon AS LONG
hCursor AS LONG
hbrBackground AS LONG
lpszMenuName AS LONG
lpszClassName AS LONG
hIconSm AS LONG
END TYPE
CONST WS_OVERLAPPED = &H0&
CONST WS_POPUP = &H80000000
CONST WS_CHILD = &H40000000
CONST WS_MINIMIZE = &H20000000
CONST WS_VISIBLE = &H10000000
CONST WS_DISABLED = &H8000000
CONST WS_CLIPSIBLINGS = &H4000000
CONST WS_CLIPCHILDREN = &H2000000
CONST WS_MAXIMIZE = &H1000000
CONST WS_CAPTION = &HC00000
CONST WS_BORDER = &H800000
CONST WS_DLGFRAME = &H400000
CONST WS_VSCROLL = &H200000
CONST WS_HSCROLL = &H100000
CONST WS_SYSMENU = &H80000
CONST WS_THICKFRAME = &H40000
CONST WS_GROUP = &H20000
CONST WS_TABSTOP = &H10000
CONST WS_EX_MDICHILD=&H40
CONST WS_MINIMIZEBOX = &H20000
CONST WS_MAXIMIZEBOX = &H10000
CONST WS_OVERLAPPEDWINDOW=(WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR WS_THICKFRAME OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX)
DECLARE FUNCTION SendMessageAPI LIB "user32" ALIAS "SendMessageA" (hwnd AS LONG, wMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DECLARE FUNCTION AnyPopup LIB "user32" ALIAS "AnyPopup" () AS LONG
DECLARE FUNCTION BringWindowToTop LIB "user32" ALIAS "BringWindowToTop" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION RegisterClassEx LIB "User32" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEX) AS LONG
DECLARE FUNCTION EnumChildWindows LIB "User32" ALIAS "EnumChildWindows" (hWndParent AS LONG,lpEnumFunc AS LONG,lParam AS LONG) AS LONG
DECLARE FUNCTION CreateWindowEx LIB "User32" ALIAS "CreateWindowExA" (dwExStyle AS LONG,lpClassName AS STRING,lpWindowName AS STRING,dwStyle AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,hWndParent AS LONG,hMenu AS LONG,hInstance AS LONG,lpParam AS LONG) AS LONG
DECLARE FUNCTION DefMDIChildProc LIB "User32" ALIAS "DefMDIChildProcA" (hWnd AS LONG,uMsg AS LONG,wParam AS LONG,lParam AS LONG) AS LONG
DECLARE FUNCTION GetClassName LIB "User32" ALIAS "GetClassNameA" (hwnd AS LONG, lpClassName AS LONG, nMaxCount AS LONG) AS LONG
DECLARE FUNCTION SetProp LIB "User32" ALIAS "SetPropA" (hwnd AS LONG,lpString AS STRING,hData AS LONG) AS LONG
DECLARE FUNCTION GetProp LIB "User32" ALIAS "GetPropA" (hwnd AS LONG,lpString AS STRING) AS LONG
DECLARE FUNCTION GetClientRect LIB "User32" ALIAS "GetClientRect" (hwnd AS LONG,lpRect AS QRECT) AS LONG
DECLARE FUNCTION MoveWindow LIB "User32" ALIAS "MoveWindow" (hwnd AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,bRepaint AS LONG) AS LONG
DECLARE FUNCTION GetFocus LIB "user32" ALIAS "GetFocus"() AS LONG
DECLARE FUNCTION GetParent LIB "user32" ALIAS "GetParent" (hwnd AS LONG) AS LONG
DECLARE FUNCTION GetWindowRect LIB "user32" ALIAS "GetWindowRect" (BYVAL hwnd AS LONG, lpRect AS QRECT) AS LONG
DECLARE FUNCTION GetWindowText LIB "user32" ALIAS "GetWindowTextA" (BYVAL hwnd AS LONG, BYVAL lpString AS LONG, BYVAL cch AS LONG) AS LONG
DECLARE FUNCTION GetWindowTextLength LIB "user32" ALIAS "GetWindowTextLengthA" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION GetCapture LIB "USER32" ALIAS "GetCapture" () AS LONG
DECLARE FUNCTION DrawEdge LIB "USER32" ALIAS "DrawEdge" (hdc AS LONG, qrc AS QRECT, edge AS LONG, grfFlags AS LONG) AS LONG
DECLARE FUNCTION DrawFrameControl LIB "USER32" ALIAS "DrawFrameControl" (hdc AS LONG, qrc AS QRECT, utype AS LONG, ustate AS LONG) AS LONG
DECLARE FUNCTION DrawCaption LIB "USER32" ALIAS "DrawCaption" (hwnd AS LONG, hdc AS LONG, qrc AS QRECT, uFlags AS LONG) AS LONG
DECLARE FUNCTION IsIconic LIB "user32" ALIAS "IsIconic" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION IsWindowVisible LIB "user32" ALIAS "IsWindowVisible" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION IsZoomed LIB "user32" ALIAS "IsZoomed" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION RemoveProp LIB "user32" ALIAS "RemovePropA" (BYVAL hwnd AS LONG, BYVAL lpString AS STRING) AS LONG
DECLARE FUNCTION ReleaseCapture LIB "user32" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION SetCapture LIB "USER32" ALIAS "SetCapture" (hwnd AS LONG) AS LONG
DECLARE FUNCTION SetClassLong LIB "user32" ALIAS "SetClassLongA" (hwnd AS LONG,nIndex AS LONG,dwNewLong AS LONG) AS LONG
DECLARE FUNCTION SetFocus LIB "User32" ALIAS "SetFocus" (hwnd AS LONG) AS LONG
DECLARE FUNCTION SetParent LIB "user32" ALIAS "SetParent" (hWndChild AS LONG,hWndNewParent AS LONG) AS LONG
DECLARE FUNCTION SetForegroundWindow LIB "user32" ALIAS "SetForegroundWindow" (BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION SetWindowText LIB "user32" ALIAS "SetWindowTextA" (BYVAL hwnd AS LONG, BYVAL lpString AS STRING) AS LONG
DECLARE FUNCTION ShowWindow LIB "user32" ALIAS "ShowWindow" (hwnd AS LONG,nCmdShow AS LONG) AS LONG
DECLARE FUNCTION CallWindowProc LIB "user32.dll" ALIAS "CallWindowProcA" (lpPrevWndFunc AS LONG, hwnd AS LONG, Msg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DECLARE FUNCTION EnableWindow LIB "user32" ALIAS "EnableWindow" (BYVAL hwnd AS LONG, BYVAL fEnable AS LONG) AS LONG
DECLARE SUB SetWindowPos LIB "User32" ALIAS "SetWindowPos"_
(BYVAL hWnd AS LONG,_
BYVAL hWndInsertAfter AS LONG,_
BYVAL X AS LONG,_
BYVAL Y AS LONG,_
BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG)
DECLARE FUNCTION GetWindowLong LIB "USER32" ALIAS "GetWindowLongA" (hwnd AS LONG, TYPE AS LONG) AS LONG
DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" (hWnd AS LONG,nIndex AS LONG, dwNewLong AS LONG) AS LONG
DECLARE SUB ClientToScreen LIB "USER32" ALIAS "ClientToScreen" (hwnd AS LONG, lpPoint AS LONG)
DECLARE FUNCTION DefWindowProc LIB "USER32" ALIAS "DefWindowProcA" (hwnd AS LONG, msg AS LONG, wparam AS LONG, lparam AS LONG) AS LONG
DECLARE SUB DragAcceptFiles LIB "SHELL32" ALIAS "DragAcceptFiles" (hWnd AS LONG, Accept AS LONG)
DECLARE SUB DragFinish LIB "SHELL32" ALIAS "DragFinish" (hDrop AS LONG)
DECLARE FUNCTION DragQueryFile LIB "SHELL32" ALIAS "DragQueryFileA" (hDrop AS LONG, iFile AS LONG, lpszFile AS LONG, cch AS LONG) AS LONG
DECLARE FUNCTION DragQueryPoint LIB "SHELL32" ALIAS "DragQueryPoint" (hDrop AS LONG, lppt AS POINTAPI) AS LONG
DECLARE FUNCTION Shell_NotifyIcon LIB "SHELL32" ALIAS "Shell_NotifyIconA" (BYVAL dwMessage AS LONG, lpData AS QNOTIFYICONDATA) AS LONG
DECLARE FUNCTION ShellExecute LIB "shell32.dll" ALIAS "ShellExecuteA" (BYVAL hwnd AS LONG, BYVAL lpOperation AS STRING, BYVAL lpFile AS STRING, BYVAL lpParameters AS STRING, BYVAL lpDirectory AS STRING, BYVAL nShowCmd AS LONG) AS LONG
CONST MOUSEEVENTF_MOVE = &H1
CONST MOUSEEVENTF_ABSOLUTE = &H8000
DECLARE SUB mouse_event LIB "user32" ALIAS "mouse_event"(BYVAL dwFlags AS LONG, BYVAL dx AS LONG, BYVAL dy AS LONG, BYVAL cButtons AS LONG, BYVAL dwExtraInfo AS LONG)
DECLARE FUNCTION SetCursorPos LIB "user32" ALIAS "SetCursorPos" (BYVAL x AS LONG, BYVAL y AS LONG) AS LONG
$DEFINE VK_LBUTTON &H1
$DEFINE VK_RBUTTON &H2
$DEFINE VK_CANCEL &H3
$DEFINE VK_MBUTTON &H4
$DEFINE VK_BACK &H8
$DEFINE VK_TAB &H9
$DEFINE VK_CLEAR &HC
$DEFINE VK_RETURN &HD
$DEFINE VK_SHIFT &H10
$DEFINE VK_CONTROL &H11
$DEFINE VK_MENU &H12
$DEFINE VK_PAUSE &H13
$DEFINE VK_CAPITAL &H14
$DEFINE VK_ESCAPE &H1B
$DEFINE VK_SPACE &H20
$DEFINE VK_PRIOR &H21
$DEFINE VK_NEXT &H22
$DEFINE VK_END &H23
$DEFINE VK_HOME &H24
$DEFINE VK_LEFT &H25
$DEFINE VK_UP &H26
$DEFINE VK_RIGHT &H27
$DEFINE VK_DOWN &H28
$DEFINE VK_SELECT &H29
$DEFINE VK_PRINT &H2A
$DEFINE VK_EXECUTE &H2B
$DEFINE VK_SNAPSHOT &H2C
$DEFINE VK_INSERT &H2D
$DEFINE VK_DELETE &H2E
$DEFINE VK_HELP &H2F
$DEFINE VK_0 &H30
$DEFINE VK_1 &H31
$DEFINE VK_2 &H32
$DEFINE VK_3 &H33
$DEFINE VK_4 &H34
$DEFINE VK_5 &H35
$DEFINE VK_6 &H36
$DEFINE VK_7 &H37
$DEFINE VK_8 &H38
$DEFINE VK_9 &H39
$DEFINE VK_A &H41
$DEFINE VK_B &H42
$DEFINE VK_C &H43
$DEFINE VK_D &H44
$DEFINE VK_E &H45
$DEFINE VK_F &H46
$DEFINE VK_G &H47
$DEFINE VK_H &H48
$DEFINE VK_I &H49
$DEFINE VK_J &H4A
$DEFINE VK_K &H4B
$DEFINE VK_L &H4C
$DEFINE VK_M &H4D
$DEFINE VK_N &H4E
$DEFINE VK_O &H4F
$DEFINE VK_P &H50
$DEFINE VK_Q &H51
$DEFINE VK_R &H52
$DEFINE VK_S &H53
$DEFINE VK_T &H54
$DEFINE VK_U &H55
$DEFINE VK_V &H56
$DEFINE VK_W &H57
$DEFINE VK_X &H58
$DEFINE VK_Y &H59
$DEFINE VK_Z &H5A
$DEFINE VK_NUMPAD0 &H60
$DEFINE VK_NUMPAD1 &H61
$DEFINE VK_NUMPAD2 &H62
$DEFINE VK_NUMPAD3 &H63
$DEFINE VK_NUMPAD4 &H64
$DEFINE VK_NUMPAD5 &H65
$DEFINE VK_NUMPAD6 &H66
$DEFINE VK_NUMPAD7 &H67
$DEFINE VK_NUMPAD8 &H68
$DEFINE VK_NUMPAD9 &H69
$DEFINE VK_MULTIPLY &H6A
$DEFINE VK_ADD &H6B
$DEFINE VK_SEPARATOR &H6C
$DEFINE VK_SUBTRACT &H6D
$DEFINE VK_DECIMAL &H6E
$DEFINE VK_DIVIDE &H6F
$DEFINE VK_F1 &H70
$DEFINE VK_F2 &H71
$DEFINE VK_F3 &H72
$DEFINE VK_F4 &H73
$DEFINE VK_F5 &H74
$DEFINE VK_F6 &H75
$DEFINE VK_F7 &H76
$DEFINE VK_F8 &H77
$DEFINE VK_F9 &H78
$DEFINE VK_F10 &H79
$DEFINE VK_F11 &H7A
$DEFINE VK_F12 &H7B
$DEFINE VK_F13 &H7C
$DEFINE VK_F14 &H7D
$DEFINE VK_F15 &H7E
$DEFINE VK_F16 &H7F
$DEFINE VK_F17 &H80
$DEFINE VK_F18 &H81
$DEFINE VK_F19 &H82
$DEFINE VK_F20 &H83
$DEFINE VK_F21 &H84
$DEFINE VK_F22 &H85
$DEFINE VK_F23 &H86
$DEFINE VK_F24 &H87
$DEFINE VK_NUMLOCK &H90
$DEFINE VK_SCROLL &H91
$DEFINE VK_LSHIFT &HA0
$DEFINE VK_RSHIFT &HA1
$DEFINE VK_LCONTROL &HA2
$DEFINE VK_RCONTROL &HA3
$DEFINE VK_LMENU &HA4
$DEFINE VK_RMENU &HA5
DECLARE FUNCTION GetKeyState LIB "user32" ALIAS "GetKeyState" (BYVAL nVirtKey AS LONG) AS INTEGER
$DEFINE OPAQUE 2
$DEFINE TRANSPARENT 1
TYPE TBITMAP
bmType AS LONG
bmWidth AS LONG
bmHeight AS LONG
bmWidthBytes AS LONG
bmPlanes AS WORD
bmBitsPixel AS WORD
bmBits AS LONG
END TYPE
$DEFINE PS_SOLID 0
$DEFINE PS_DASH 1
$DEFINE PS_DOT 2
$DEFINE PS_DASHDOT 3
$DEFINE PS_DASHDOTDOT 4
$DEFINE PS_NULL 5
$DEFINE PS_INSIDEFRAME 6
$DEFINE PS_USERSTYLE 7
$DEFINE PS_ALTERNATE 8
$DEFINE PS_STYLE_MASK &HF
$DEFINE R2_BLACK 1
$DEFINE R2_NOTMERGEPEN 2
$DEFINE R2_MASKNOTPEN 3
$DEFINE R2_NOTCOPYPEN 4
$DEFINE R2_MASKPENNOT 5
$DEFINE R2_NOT 6
$DEFINE R2_XORPEN 7
$DEFINE R2_NOTMASKPEN 8
$DEFINE R2_MASKPEN 9
$DEFINE R2_NOTXORPEN 10
$DEFINE R2_NOP 11
$DEFINE R2_MERGENOTPEN 12
$DEFINE R2_COPYPEN 13
$DEFINE R2_MERGEPENNOT 14
$DEFINE R2_MERGEPEN 15
$DEFINE R2_WHITE 16
$DEFINE WHITE_BRUSH 0
$DEFINE LTGRAY_BRUSH 1
$DEFINE GRAY_BRUSH 2
$DEFINE DKGRAY_BRUSH 3
$DEFINE BLACK_BRUSH 4
$DEFINE NULL_BRUSH 5
$DEFINE HOLLOW_BRUSH 5
$DEFINE WHITE_PEN 6
$DEFINE BLACK_PEN 7
$DEFINE NULL_PEN 8
$DEFINE OEM_FIXED_FONT 10
$DEFINE ANSI_FIXED_FONT 11
$DEFINE ANSI_VAR_FONT 12
$DEFINE SYSTEM_FONT 13
$DEFINE DEVICE_DEFAULT_FONT 14
$DEFINE DEFAULT_PALETTE 15
$DEFINE SYSTEM_FIXED_FONT 16
$DEFINE STOCK_LAST 16
$DEFINE DI_MASK &H1
$DEFINE DI_IMAGE &H2
CONST DI_NORMAL = DI_MASK OR DI_IMAGE
CONST SRCCOPY = &HCC0020
CONST SRCPAINT = &HEE0086
CONST SRCAND = &H8800C6
CONST SRCINVERT = &H660046
CONST SRCERASE = &H440328
CONST NOTSRCCOPY = &H330008
CONST NOTSRCERASE = &H1100A6
CONST MERGECOPY = &HC000CA
CONST MERGEPAINT = &HBB0226
CONST PATCOPY = &HF00021
CONST PATPAINT = &HFB0A09
CONST PATINVERT = &H5A0049
CONST DSTINVERT = &H550009
CONST BLACKNESS = &H42
CONST WHITENESS = &HFF0062
CONST CCHDEVICENAME = 32
CONST CCHFORMNAME = 32
TYPE DEVMODE
dmDeviceName AS STRING * CCHDEVICENAME
dmSpecVersion AS WORD
dmDriverVersion AS WORD
dmSize AS WORD
dmDriverExtra AS WORD
dmFields AS DWORD
dmOrientation AS SHORT
dmPaperSize AS SHORT
dmPaperLength AS SHORT
dmPaperWidth AS SHORT
dmScale AS SHORT
dmCopies AS SHORT
dmDefaultSource AS SHORT
dmPrintQuality AS SHORT
dmColor AS SHORT
dmDuplex AS SHORT
dmYResolution AS SHORT
dmTTOption AS SHORT
dmCollate AS SHORT
dmFormName AS STRING * CCHFORMNAME
dmLogPixels AS WORD
dmBitsPerPel AS DWORD
dmPelsWidth AS DWORD
dmPelsHeight AS DWORD
dmDisplayFlags AS DWORD
dmDisplayFrequency AS DWORD
END TYPE
$DEFINE EWX_LOGOFF 0
$DEFINE EWX_SHUTDOWN 1
$DEFINE EWX_REBOOT 2
$DEFINE EWX_FORCE 4
$DEFINE DM_BITSPERPEL &H40000
$DEFINE DM_PELSWIDTH &H80000
$DEFINE DM_PELSHEIGHT &H100000
$DEFINE DM_DISPLAYFREQUENCY &H400000
$DEFINE CDS_DYNAMIC &H0
$DEFINE CDS_UPDATEREGISTRY &H1
$DEFINE CDS_TEST &H4
$DEFINE CDS_FULLSCREEN &H4
$DEFINE CDS_GLOBAL &H8
$DEFINE CDS_SET_PRIMARY &H10
$DEFINE CDS_RESET &H40000000
$DEFINE CDS_SETRECT &H20000000
$DEFINE CDS_NORESET &H10000000
$DEFINE DISP_CHANGE_SUCCESSFUL 0
$DEFINE DISP_CHANGE_RESTART 1
$DEFINE DISP_CHANGE_FAILED -1
$DEFINE DISP_CHANGE_BADMODE -2
$DEFINE DISP_CHANGE_NOTUPDATED -3
$DEFINE DISP_CHANGE_BADFLAGS -4
$DEFINE DISP_CHANGE_BADPARAM -5
$DEFINE ENUM_CURRENT_SETTINGS -1
$DEFINE ENUM_REGISTRY_SETTINGS -2
$DEFINE DRIVERVERSION 0
$DEFINE TECHNOLOGY 2
$DEFINE HORZSIZE 4
$DEFINE VERTSIZE 6
$DEFINE HORZRES 8
$DEFINE VERTRES 10
$DEFINE BITSPIXEL 12
$DEFINE PLANES 14
$DEFINE NUMBRUSHES 16
$DEFINE NUMPENS 18
$DEFINE NUMMARKERS 20
$DEFINE NUMFONTS 22
$DEFINE NUMCOLORS 24
$DEFINE PDEVICESIZE 26
$DEFINE CURVECAPS 28
$DEFINE LINECAPS 30
$DEFINE POLYGONALCAPS 32
$DEFINE TEXTCAPS 34
$DEFINE CLIPCAPS 36
$DEFINE RASTERCAPS 38
$DEFINE ASPECTX 40
$DEFINE ASPECTY 42
$DEFINE ASPECTXY 44
$DEFINE LOGPIXELSX 88
$DEFINE LOGPIXELSY 90
$DEFINE SIZEPALETTE 104
$DEFINE NUMRESERVED 106
$DEFINE COLORRES 108
CONST AC_SRC_OVER = &H00
CONST AC_SRC_ALPHA = &H1
TYPE BLENDFUNCTION
BlendOp AS BYTE
BlendFlags AS BYTE
SourceConstantAlpha AS BYTE
AlphaFormat AS BYTE
END TYPE
DECLARE FUNCTION AlphaBlend LIB "msimg32.dll" ALIAS "AlphaBlend" _
(hdc1 AS LONG, X1 AS INTEGER, Y1 AS INTEGER, Width1 AS INTEGER, Height1 AS INTEGER,_
hdc2 AS LONG, X2 AS INTEGER, Y2 AS INTEGER, Width2 AS INTEGER, Height2 AS INTEGER, BLEND AS BLENDFUNCTION) AS LONG
DECLARE FUNCTION CreateDC LIB "gdi32" ALIAS "CreateDCA" (_
BYVAL lpDriverName AS STRING, _
BYVAL lpDeviceName AS STRING, _
BYVAL lpOutput AS STRING,_
lpInitData AS DEVMODE) AS LONG
DECLARE FUNCTION BitBlt LIB "gdi32.dll" ALIAS "BitBlt" (_
BYVAL hdcDest AS LONG,_
BYVAL nXDest AS LONG,_
BYVAL nYDest AS LONG,_
BYVAL nWidth AS LONG,_
BYVAL nHeight AS LONG,_
BYVAL hdcSrc AS LONG,_
BYVAL nXSrc AS LONG,_
BYVAL nYSrc AS LONG,_
BYVAL dwRop AS LONG) AS LONG
DECLARE FUNCTION CreateCompatibleBitmap LIB "gdi32" ALIAS "CreateCompatibleBitmap" (hdc AS LONG,nWidth AS LONG,nHeight AS LONG) AS LONG
DECLARE FUNCTION CreateCompatibleDC LIB "gdi32" ALIAS "CreateCompatibleDC" (hdc AS LONG) AS LONG
DECLARE FUNCTION CreatePen LIB "gdi32" ALIAS "CreatePen" (nPenStyle AS LONG, nWidth AS LONG, crColor AS LONG) AS LONG
DECLARE FUNCTION CreateSolidBrush LIB "gdi32" ALIAS "CreateSolidBrush" (crColor AS LONG) AS LONG
DECLARE FUNCTION DeleteDC LIB "gdi32" ALIAS "DeleteDC" (hdc AS LONG) AS LONG
DECLARE FUNCTION DeleteObject LIB "gdi32" ALIAS "DeleteObject" (hObject AS LONG) AS LONG
DECLARE FUNCTION Ellipse LIB "gdi32" ALIAS "Ellipse" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
DECLARE FUNCTION ExtFloodFill LIB "gdi32" ALIAS "ExtFloodFill" (hdc AS LONG,x AS LONG,y AS LONG,crColor AS LONG,wFillType AS LONG) AS LONG
DECLARE FUNCTION GetDeviceCaps LIB "gdi32.dll" ALIAS "GetDeviceCaps"(BYVAL hdc AS LONG, BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION GetObject LIB "gdi32" ALIAS "GetObjectA" (hObject AS LONG,nCount AS LONG, lpObject AS TBITMAP) AS LONG
DECLARE FUNCTION GetCurrentObject LIB "gdi32" ALIAS "GetCurrentObject" (hdc AS LONG,uObjectType AS LONG) AS LONG
DECLARE FUNCTION GetPixel LIB "gdi32" ALIAS "GetPixel" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
DECLARE FUNCTION GetStockObject LIB "gdi32" ALIAS "GetStockObject" (nIndex AS LONG) AS LONG
DECLARE FUNCTION LineTo LIB "gdi32" ALIAS "LineTo" (hdc AS LONG,x AS LONG,y AS LONG) AS LONG
DECLARE FUNCTION MoveToEx LIB "gdi32" ALIAS "MoveToEx" (hdc AS LONG,x AS LONG,y AS LONG, lpPoint AS LONG) AS LONG
DECLARE FUNCTION PatBlt LIB "gdi32" ALIAS "PatBlt" (hdc AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,dwRop AS LONG) AS LONG
DECLARE FUNCTION Rectangle LIB "gdi32" ALIAS "Rectangle" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG) AS LONG
DECLARE FUNCTION RoundRect LIB "gdi32" ALIAS "RoundRect" (hdc AS LONG,X1 AS LONG,Y1 AS LONG,X2 AS LONG,Y2 AS LONG,X3 AS LONG,Y3 AS LONG) AS LONG
DECLARE FUNCTION SelectObject LIB "gdi32" ALIAS "SelectObject" (hdc AS LONG,hObject AS LONG) AS LONG
DECLARE FUNCTION SetROP2 LIB "gdi32" ALIAS "SetROP2" (hdc AS LONG,nDrawMode AS LONG) AS LONG
DECLARE FUNCTION SetBkMode LIB "gdi32" ALIAS "SetBkMode" (hdc AS LONG,nBkMode AS LONG) AS LONG
DECLARE FUNCTION StretchBlt LIB "gdi32" ALIAS "StretchBlt" (hdc AS LONG,x AS LONG,y AS LONG,nWidth AS LONG,nHeight AS LONG,hSrcDC AS LONG,xSrc AS LONG,ySrc AS LONG,nSrcWidth AS LONG,nSrcHeight AS LONG,dwRop AS LONG) AS LONG
DECLARE FUNCTION GetDesktopWindow LIB "user32" ALIAS "GetDesktopWindow" () AS LONG
DECLARE FUNCTION DrawIconEx LIB "user32" ALIAS "DrawIconEx" (hdc AS LONG,xLeft AS LONG,yTop AS LONG,hIcon AS LONG,cxWidth AS LONG,cyWidth AS LONG,istepIfAniCur AS LONG,hbrFlickerFreeDraw AS LONG,diFlags AS LONG) AS LONG
DECLARE FUNCTION LoadImage LIB "user32" ALIAS "LoadImageA" (hInst AS LONG,lpsz AS STRING, dwImageType AS LONG,dwDesiredWidth AS LONG, dwDesiredHeight AS LONG,dwFlags AS LONG) AS LONG
DECLARE FUNCTION EnumDisplaySettings LIB "user32" ALIAS "EnumDisplaySettingsA" (byref DeviceName AS STRING, BYVAL iModeNum AS DWORD, byref DevMo AS DevMode) AS LONG
DECLARE FUNCTION ChangeDisplaySettings LIB "user32" ALIAS "ChangeDisplaySettingsA" (DevMo AS DevMode, BYVAL dwFlags AS LONG) AS LONG
DECLARE FUNCTION ExitWindowsEx LIB "user32" ALIAS "ExitWindowsEx" (BYVAL uFlags AS LONG, BYVAL dwReserved AS LONG) AS LONG
DECLARE FUNCTION GetDC LIB "user32.dll" ALIAS "GetDC"(BYVAL hwnd AS LONG) AS LONG
DECLARE FUNCTION ReleaseDC LIB "user32.dll" ALIAS "ReleaseDC"(BYVAL hwnd AS LONG, BYVAL hdc AS LONG) AS LONG
DECLARE FUNCTION SetActiveWindow LIB "USER32" ALIAS "SetActiveWindow" (hWnd AS INTEGER) AS INTEGER
DECLARE FUNCTION SystemParametersInfo LIB "user32" ALIAS "SystemParametersInfoA" (uAction AS LONG,uParam AS LONG,lpvParam AS LONG,fuWinIni AS LONG) AS LONG
DECLARE SUB RtlMoveMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory" (byref Destination AS LONG, byref Source AS LONG, Length AS LONG)
$DEFINE IDLE_PRIORITY_CLASS &H40
$DEFINE BELOW_NORMAL_PRIORITY_CLASS &H4000
$DEFINE NORMAL_PRIORITY_CLASS &H20
$DEFINE ABOVE_NORMAL_PRIORITY_CLASS &H8000
$DEFINE HIGH_PRIORITY_CLASS &H80
$DEFINE REALTIME_PRIORITY_CLASS &H100
DECLARE FUNCTION SetPriorityClass LIB "kernel32" ALIAS "SetPriorityClass" (BYVAL hProcess AS LONG, BYVAL dwPriorityClass AS LONG) AS LONG
DECLARE FUNCTION GetPriorityClass LIB "kernel32" ALIAS "GetPriorityClass" (BYVAL hProcess AS LONG) AS LONG
DECLARE FUNCTION GetCurrentProcess LIB "kernel32" ALIAS "GetCurrentProcess" () AS LONG
DECLARE FUNCTION GetDriveType LIB "kernel32" ALIAS "GetDriveTypeA" (nDrive AS STRING) AS LONG
DECLARE FUNCTION GetDiskFreeSpaceEx LIB "kernel32" ALIAS "GetDiskFreeSpaceExA"_
(lpRootPathName AS STRING, lpFreeBytesAvailableToCaller AS LONG,_
lpTotalNumberOfBytes AS LONG, lpTotalNumberOfFreeBytes AS LONG) AS LONG
$DEFINE ODT_MENU 1%
$DEFINE ODS_SELECTED 1%
$DEFINE ODS_GRAYED 2%
$DEFINE ODS_DISABLED 4%
$DEFINE ODS_CHECKED 8%
$DEFINE ODS_FOCUS &H10%
$DEFINE ODS_DEFAULT &H20%
$DEFINE ODS_COMBOBOXEDIT &H1000%
$DEFINE MF_BYCOMMAND 0
$DEFINE MF_BYPOSITION &H400
$DEFINE MF_OWNERDRAW &H100
$DEFINE MF_GRAYED &H1
$DEFINE MF_DISABLED &H2
$DEFINE MF_STRING 0
$DEFINE MF_BITMAP 4
$DEFINE MF_HILITE &H80
$DEFINE COLOR_MENU 4
$DEFINE COLOR_MENUTEXT 7
$DEFINE COLOR_HIGHLIGHT 13
$DEFINE COLOR_HIGHLIGHTTEXT 14
$DEFINE COLOR_GRAYTEXT 17
$DEFINE MIIM_STATE &H1
$DEFINE MIIM_ID &H2
$DEFINE MIIM_SUBMENU &H4
$DEFINE MIIM_CHECKMARKS &H8
$DEFINE MIIM_DATA &H20
$DEFINE MIIM_TYPE &H10
$DEFINE MFT_BITMAP &H4
$DEFINE MFT_MENUBARBREAK &H20
$DEFINE MFT_MENUBREAK &H40
$DEFINE MFT_OWNERDRAW &H100
$DEFINE MFT_RADIOCHECK &H200
$DEFINE MFT_RIGHTJUSTIFY &H4000
$DEFINE MFT_RIGHTORDER &H2000
$DEFINE MFT_SEPARATOR &H800
$DEFINE MFT_STRING &H0
$DEFINE MFS_CHECKED &H8
$DEFINE MFS_DEFAULT &H1000
$DEFINE MFS_DISABLED &H2
$DEFINE MFS_ENABLED &H0
$DEFINE MFS_GRAYED &H1
$DEFINE MFS_HILITE &H80
$DEFINE MFS_UNCHECKED &H0
$DEFINE MFS_UNHILITE &H0
TYPE MEASUREITEMSTRUCT
CtlType AS LONG
CtlID AS LONG
itemID AS LONG
itemWidth AS LONG
itemHeight AS LONG
itemData AS DWORD
END TYPE
TYPE DRAWITEMSTRUCT
CtlType AS LONG
CtlID AS LONG
itemID AS LONG
itemAction AS LONG
itemState AS LONG
hwndItem AS LONG
hDC AS LONG
left AS LONG
top AS LONG
right AS LONG
bottom AS LONG
itemData AS DWORD
END TYPE
TYPE MENUITEMINFO
cbSize AS LONG
fMask AS LONG
fType AS LONG
fState AS LONG
wID AS LONG
hSubMenu AS LONG
hbmpChecked AS LONG
hbmpUnchecked AS LONG
dwItemData AS LONG
dwTypeData AS LONG
cch AS LONG
END TYPE
DECLARE FUNCTION GetSysColor LIB "user32" ALIAS "GetSysColor" (nIndex AS LONG) AS LONG
DECLARE FUNCTION GetMenu LIB "user32" ALIAS "GetMenu" (hWnd AS LONG) AS LONG
DECLARE FUNCTION GetMenuItemInfo LIB "user32.dll" ALIAS "GetMenuItemInfoA" (BYVAL hMenu AS LONG, BYVAL uItem AS LONG, BYVAL fByPosition AS LONG, lpmii AS MENUITEMINFO) AS LONG
DECLARE FUNCTION SetMenuItemInfo LIB "user32.dll" ALIAS "SetMenuItemInfoA" (BYVAL hMenu AS LONG, BYVAL uItem AS LONG, BYVAL fByPosition AS LONG, lpmii AS MENUITEMINFO) AS LONG
DECLARE FUNCTION InsertMenuItem LIB "user32.dll" ALIAS "InsertMenuItemA" (BYVAL hMenu AS LONG, BYVAL uItem AS LONG, BYVAL fByPosition AS LONG, lpmii AS MENUITEMINFO) AS LONG
DECLARE FUNCTION ModifyMenu LIB "USER32" ALIAS "ModifyMenuA" (hMenu AS LONG,uPosition AS LONG,uFlags AS LONG,uIDNewItem AS LONG,lpNewItem AS LONG) AS LONG
TYPE CHOOSECOLOR
lStructSize AS LONG
hWndOwner AS LONG
hInstance AS LONG
rgbResult AS LONG
lpCustColors(1 TO 16) AS LONG
Flags AS DWORD
lCustData AS LONG
lpfnHook AS LONG
lpTemplateName AS LONG
END TYPE
$DEFINE CC_RGBINIT &H1
$DEFINE CC_FULLOPEN &H2
$DEFINE CC_PREVENTFULLOPEN &H4
$DEFINE CC_SHOWHELP &H8
$DEFINE CC_ENABLEHOOK &H10
$DEFINE CC_ENABLETEMPLATE &H20
$DEFINE CC_ENABLETEMPLATEHANDLE &H40
$DEFINE CC_SOLIDCOLOR &H80
$DEFINE CC_ANYCOLOR &H100
CONST OFN_READONLY = &H00000001
CONST OFN_OVERWRITEPROMPT = &H00000002
CONST OFN_HIDEREADONLY = &H00000004
CONST OFN_NOCHANGEDIR = &H00000008
CONST OFN_SHOWHELP = &H00000010
CONST OFN_ENABLEHOOK = &H00000020
CONST OFN_ENABLETEMPLATE = &H00000040
CONST OFN_ENABLETEMPLATEHANDLE = &H00000080
CONST OFN_NOVALIDATE = &H00000100
CONST OFN_ALLOWMULTISELECT = &H00000200
CONST OFN_EXTENSIONDIFFERENT = &H00000400
CONST OFN_PATHMUSTEXIST = &H00000800
CONST OFN_FILEMUSTEXIST = &H00001000
CONST OFN_CREATEPROMPT = &H00002000
CONST OFN_SHAREAWARE = &H00004000
CONST OFN_NOREADONLYRETURN = &H00008000
CONST OFN_NOTESTFILECREATE = &H00010000
CONST OFN_NOLONGNAMES = &H00040000
CONST OFN_EXPLORER = &H00080000
CONST OFN_NODEREFERENCELINKS = &H00100000
CONST OFN_LONGNAMES = &H00200000
TYPE OPENFILENAME
lStructSize AS DWORD
hwndOwner AS LONG
hInstance AS LONG
lpstrFilter AS LONG
lpstrCustomFilter AS LONG
nMaxCustFilter AS DWORD
nFilterIndex AS DWORD
lpstrFile AS LONG
nMaxFile AS DWORD
lpstrFileTitle AS LONG
nMaxFileTitle AS DWORD
lpstrInitialDir AS LONG
lpstrTitle AS LONG
flags AS DWORD
nFileOffset AS SHORT
nFileExtension AS SHORT
lpstrDefExt AS LONG
lCustData AS LONG
lpfnHook AS LONG
lpTemplateName AS LONG
END TYPE
DECLARE FUNCTION ChooseColorDlg LIB "COMDLG32" ALIAS "ChooseColorA" (CC AS CHOOSECOLOR) AS LONG
DECLARE FUNCTION GetSaveFileName LIB "COMDLG32" ALIAS "GetSaveFileNameA" (pOpenfilename AS OPENFILENAME) AS LONG
DECLARE FUNCTION GetOpenFileName LIB "COMDLG32" ALIAS "GetOpenFileNameA" (pOpenfilename AS OPENFILENAME) AS LONG
$DEFINE CDERR_DIALOGFAILURE &HFFFF%
$DEFINE CDERR_GENERALCODES &H0%
$DEFINE CDERR_STRUCTSIZE &H1%
$DEFINE CDERR_INITIALIZATION &H2%
$DEFINE CDERR_NOTEMPLATE &H3%
$DEFINE CDERR_NOHINSTANCE &H4%
$DEFINE CDERR_LOADSTRFAILURE &H5%
$DEFINE CDERR_FINDRESFAILURE &H6%
$DEFINE CDERR_LOADRESFAILURE &H7%
$DEFINE CDERR_LOCKRESFAILURE &H8%
$DEFINE CDERR_MEMALLOCFAILURE &H9%
$DEFINE CDERR_MEMLOCKFAILURE &HA%
$DEFINE CDERR_NOHOOK &HB%
$DEFINE CDERR_REGISTERMSGFAIL &HC%
DECLARE FUNCTION CommDlgExtendedError LIB "comdlg32.dll" ALIAS "CommDlgExtendedError" () AS LONG
TYPE COMMTIMEOUTS
ReadIntervalTimeout AS DWORD
ReadTotalTimeoutMultiplier AS DWORD
ReadTotalTimeoutConstant AS DWORD
WriteTotalTimeoutMultiplier AS DWORD
WriteTotalTimeoutConstant AS DWORD
END TYPE
TYPE DCB
DCBlength AS DWORD
BaudRate AS DWORD
DCBflags AS DWORD
wReserved AS WORD
XonLim AS WORD
XoffLim AS WORD
ByteSize AS BYTE
Parity AS BYTE
StopBits AS BYTE
XonChar AS BYTE
XoffChar AS BYTE
ErrorChar AS BYTE
EofChar AS BYTE
EvtChar AS BYTE
wReserved1 AS WORD
END TYPE
TYPE COMSTAT
COMSTATflags AS DWORD
cbInQue AS DWORD
cbOutQue AS DWORD
END TYPE
TYPE SECURITYATTRIBUTES
nLength AS DWORD
lpSecurityDescriptor AS LONG
bInheritHandle AS LONG
END TYPE
TYPE OVERLAPPED
Internal AS LONG
InternalHigh AS LONG
offset AS DWORD
OffsetHigh AS DWORD
hEvent AS LONG
END TYPE
CONST NOPARITY = 0
CONST ODDPARITY = 1
CONST EVENPARITY = 2
CONST MARKPARITY = 3
CONST SPACEPARITY = 4
CONST ONESTOPBIT = 0
CONST ONE5STOPBITS = 1
CONST TWOSTOPBITS = 2
CONST PURGE_RXABORT = &H2
CONST PURGE_RXCLEAR = &H8
CONST PURGE_TXABORT = &H1
CONST PURGE_TXCLEAR = &H4
CONST GENERIC_READ = &H80000000
CONST GENERIC_WRITE = &H40000000
CONST FILE_SHARE_READ = &H1
CONST FILE_SHARE_WRITE = &H2
CONST CREATE_NEW = 1
CONST CREATE_ALWAYS = 2
CONST OPEN_EXISTING = 3
CONST OPEN_ALWAYS = 4
CONST TRUNCATE_EXISTING = 5
CONST FILE_ATTRIBUTE_NORMAL = &H80
CONST FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
CONST FORMAT_MESSAGE_FROM_SYSTEM = &H1000
CONST LANG_NEUTRAL = &H0
CONST SUBLANG_DEFAULT = &H1
CONST ERROR_BAD_USERNAME = 2202&
CONST ERROR_OPEN_PORT = "There was an error opening the Comm Port. "
CONST ERROR_PORT_BUFFERS = "There was an error creating the Comm Port Buffers. "
CONST ERROR_PURGE_BUFFERS = "There was an error purging old data from the Comm Port Buffers. "
CONST ERROR_TIMEOUTS = "There was an error setting the Comm Port timeouts. "
CONST ERROR_RETRIEVE_PORTSETTINGS = "There was an error retrieving the existing Comm Port settings. "
CONST ERROR_CHANGING_PORTSETTINGS = "There was an error changing the Comm Port settings. "
CONST ERROR_CLOSING_PORT = "There was an error closing the Comm Port. "
CONST ERROR_WRITING_PORT = "There was an error writing data to the Comm Port. "
CONST ERROR_SENDING_DATA = "Could not send all the data in time specified. Try increasing your wait time."
CONST ERROR_GETTING_PORT_STATUS = "There was an error getting the Comm Ports current status. "
CONST ERROR_READING_PORT = "There was an error reading data from the Comm Port. "
DECLARE SUB SLEEP.ms LIB "kernel32" ALIAS "Sleep" (dwMilliseconds AS DWORD)
DECLARE SUB SetLastError LIB "kernel32" ALIAS "SetLastError" (BYVAL dwErrCode AS LONG)
DECLARE FUNCTION WSAGetLastError LIB "WSOCK32" ALIAS "WSAGetLastError" () AS LONG
DECLARE FUNCTION GetLastError LIB "kernel32" ALIAS "GetLastError" () AS DWORD
DECLARE FUNCTION FormatMessage LIB "kernel32" ALIAS "FormatMessageA" _
(dwFlags AS DWORD, _
lpSource AS LONG, _
dwMessageId AS DWORD, _
dwLanguageId AS DWORD, _
BYREF lpBuffer AS STRING, _
nSize AS DWORD, _
lpArguments AS LONG) _
AS LONG
DECLARE FUNCTION SetupComm LIB "kernel32" ALIAS "SetupComm"_
(hFile AS LONG,_
dwInQueue AS DWORD,_
dwOutQueue AS DWORD) _
AS LONG
DECLARE FUNCTION PurgeComm LIB "kernel32" ALIAS "PurgeComm"_
(hFile AS LONG, _
dwFlags AS DWORD) _
AS LONG
DECLARE FUNCTION SetCommTimeouts LIB "kernel32" ALIAS "SetCommTimeouts"_
(hFile AS LONG,_
lpCommTimeouts AS COMMTIMEOUTS) _
AS LONG
DECLARE FUNCTION GetCommState LIB "kernel32" ALIAS "GetCommState" _
(hFile AS LONG, _
lpDCB AS DCB) _
AS LONG
DECLARE FUNCTION SetCommState LIB "kernel32" ALIAS "SetCommState" _
(hFile AS LONG, _
lpDCB AS DCB) _
AS LONG
DECLARE FUNCTION ClearCommError LIB "kernel32" ALIAS "ClearCommError" _
(hFile AS LONG,_
BYREF lpErrors AS DWORD,_
lpStat AS COMSTAT) _
AS LONG
DECLARE FUNCTION CreateFile LIB "kernel32" ALIAS "CreateFileA"_
(lpFileName AS STRING, _
dwDesiredAccess AS DWORD, _
dwShareMode AS DWORD, _
lpSecurityAttributes AS SECURITYATTRIBUTES, _
dwCreationDisposition AS DWORD, _
dwFlagsAndAttributes AS DWORD,_
hTemplateFile AS LONG) _
AS LONG
DECLARE FUNCTION WriteFile LIB "kernel32" ALIAS "WriteFile"_
(hFile AS LONG, _
lpBuffer AS STRING, _
nNumberOfBytesToWrite AS DWORD, _
BYREF lpNumberOfBytesWritten AS DWORD, _
lpOverlapped AS OVERLAPPED) _
AS LONG
DECLARE FUNCTION ReadFile LIB "kernel32" ALIAS "ReadFile"_
(hFile AS LONG, _
BYREF lpBuffer AS STRING, _
nNumberOfBytesToRead AS DWORD, _
BYREF lpNumberOfBytesRead AS DWORD, _
lpOverlapped AS OVERLAPPED) _
AS LONG
DECLARE FUNCTION CloseHandle LIB "kernel32" ALIAS "CloseHandle" _
(hObject AS LONG) _
AS LONG
DECLARE FUNCTION ReadFileEx LIB "kernel32" ALIAS "ReadFileEx"_
(BYVAL hFile AS LONG, _
BYREF lpBuffer AS STRING, _
BYVAL nNumberOfBytesToRead AS DWORD, _
lpOverlapped AS OVERLAPPED,_
BYVAL lpCompletionRoutine AS LONG)_
AS LONG
TYPE OSVERSIONINFO
dwOSVersionInfoSize AS LONG
dwMajorVersion AS LONG
dwMinorVersion AS LONG
dwBuildNumber AS LONG
dwPlatformId AS LONG
szCSDVersion AS STRING * 128
END TYPE
$DEFINE VER_PLATFORM_WIN32s 0
$DEFINE VER_PLATFORM_WIN32_WINDOWS 1
$DEFINE VER_PLATFORM_WIN32_NT 2
DECLARE FUNCTION GetVersionEx LIB "kernel32.dll" ALIAS "GetVersionExA" (lpVersionInformation AS OSVERSIONINFO) AS LONG
$DEFINE AC_LINE_OFFLINE &H0
$DEFINE AC_LINE_ONLINE &H1
$DEFINE AC_LINE_BACKUP_POWER &H2
$DEFINE AC_LINE_UNKNOWN &HFF
$DEFINE BATTERY_FLAG_HIGH &H1
$DEFINE BATTERY_FLAG_LOW &H2
$DEFINE BATTERY_FLAG_CRITICAL &H4
$DEFINE BATTERY_FLAG_CHARGING &H8
$DEFINE BATTERY_FLAG_NO_BATTERY &H80
$DEFINE BATTERY_FLAG_UNKNOWN &HFF
$DEFINE BATTERY_PERCENTAGE_UNKNOWN &HFF
$DEFINE BATTERY_LIFE_UNKNOWN &HFFFF
TYPE SYSTEM_POWER_STATUS
ACLineStatus AS BYTE
BatteryFlag AS BYTE
BatteryLifePercent AS BYTE
Reserved1 AS BYTE
BatteryLifeTime AS LONG
BatteryFullLifeTime AS LONG
END TYPE
DECLARE FUNCTION GetSystemPowerStatus LIB "kernel32" ALIAS "GetSystemPowerStatus" (lpSystemPowerStatus AS SYSTEM_POWER_STATUS) AS LONG
DECLARE FUNCTION SetSystemPowerState LIB "kernel32" ALIAS "SetSystemPowerState" (BYVAL fSuspend AS LONG, BYVAL fForce AS LONG) AS LONG
DECLARE FUNCTION SetSuspendState LIB "Powrprof" ALIAS "SetSuspendState" (BYVAL Hibernate AS LONG, BYVAL ForceCritical AS LONG, BYVAL DisableWakeEvent AS LONG) AS LONG
TYPE MEMORYSTATUS
dwLength AS LONG
dwMemoryLoad AS LONG
dwTotalPhys AS LONG
dwAvailPhys AS LONG
dwTotalPageFile AS LONG
dwAvailPageFile AS LONG
dwTotalVirtual AS LONG
dwAvailVirtual AS LONG
END TYPE
DECLARE SUB GlobalMemoryStatus LIB "kernel32" ALIAS "GlobalMemoryStatus" (lpBuffer AS MEMORYSTATUS)
$DEFINE SM_CXSCREEN 0
$DEFINE SM_CYSCREEN 1
$DEFINE SM_CXVSCROLL 2
$DEFINE SM_CYHSCROLL 3
$DEFINE SM_CYCAPTION 4
$DEFINE SM_CXBORDER 5
$DEFINE SM_CYBORDER 6
$DEFINE SM_CXDLGFRAME 7
$DEFINE SM_CYDLGFRAME 8
$DEFINE SM_CYVTHUMB 9
$DEFINE SM_CXHTHUMB 10
$DEFINE SM_CXICON 11
$DEFINE SM_CYICON 12
$DEFINE SM_CXCURSOR 13
$DEFINE SM_CYCURSOR 14
$DEFINE SM_CYMENU 15
$DEFINE SM_CXFULLSCREEN 16
$DEFINE SM_CYFULLSCREEN 17
$DEFINE SM_CYKANJIWINDOW 18
$DEFINE SM_MOUSEPRESENT 19
$DEFINE SM_CYVSCROLL 20
$DEFINE SM_CXHSCROLL 21
$DEFINE SM_DEBUG 22
$DEFINE SM_SWAPBUTTON 23
$DEFINE SM_RESERVED1 24
$DEFINE SM_RESERVED2 25
$DEFINE SM_RESERVED3 26
$DEFINE SM_RESERVED4 27
$DEFINE SM_CXMIN 28
$DEFINE SM_CYMIN 29
$DEFINE SM_CXSIZE 30
$DEFINE SM_CYSIZE 31
$DEFINE SM_CXFRAME 32
$DEFINE SM_CYFRAME 33
$DEFINE SM_CXMINTRACK 34
$DEFINE SM_CYMINTRACK 35
$DEFINE SM_CXDOUBLECLK 36
$DEFINE SM_CYDOUBLECLK 37
$DEFINE SM_CXICONSPACING 38
$DEFINE SM_CYICONSPACING 39
$DEFINE SM_MENUDROPALIGNMENT 40
$DEFINE SM_PENWINDOWS 41
$DEFINE SM_DBCSENABLED 42
$DEFINE SM_CMOUSEBUTTONS 43
$DEFINE SM_CMETRICS 44
CONST SM_CXSIZEFRAME = SM_CXFRAME
CONST SM_CYSIZEFRAME = SM_CYFRAME
CONST SM_CXFIXEDFRAME = SM_CXDLGFRAME
CONST SM_CYFIXEDFRAME = SM_CYDLGFRAME
$DEFINE SM_NETWORK 63
$DEFINE SM_SLOWMACHINE 73
$DEFINE SM_MOUSEWHEELPRESENT 75
$DEFINE SM_CXVIRTUALSCREEN 78
$DEFINE SM_CYVIRTUALSCREEN 79
$DEFINE SM_CMONITORS 80
$DEFINE SM_SAMEDISPLAYFORMAT 81
DECLARE FUNCTION GetSystemMetrics LIB "user32" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION GetProcessHeap LIB "kernel32" ALIAS "GetProcessHeap" () AS LONG
DECLARE FUNCTION HeapAlloc LIB "kernel32" ALIAS "HeapAlloc" (BYVAL hHeap AS LONG, BYVAL dwFlags AS LONG, BYVAL dwBytes AS LONG) AS LONG
TYPE LUID
LowPart AS LONG
HighPart AS LONG
END TYPE
TYPE LUID_AND_ATTRIBUTES
LowPart AS LONG
HightPart AS LONG
Attributes AS LONG
END TYPE
TYPE TOKEN_PRIVILEGES
PrivilegeCount AS LONG
LowPart AS LONG
HighPart AS LONG
Attributes AS LONG
END TYPE
$DEFINE TOKEN_ADJUST_PRIVILEGES &H20
$DEFINE TOKEN_QUERY &H8
$DEFINE SE_PRIVILEGE_ENABLED &H2
DECLARE FUNCTION OpenProcessToken LIB "advapi32" ALIAS "OpenProcessToken" _
(ProcessHandle AS LONG, _
DesiredAccess AS LONG, _
TokenHandle AS LONG) AS LONG
DECLARE FUNCTION LookupPrivilegeValue LIB "advapi32" ALIAS "LookupPrivilegeValueA" _
(lpSystemName AS STRING, _
lpName AS STRING, _
lpLuid AS LUID) AS LONG
DECLARE FUNCTION AdjustTokenPrivileges LIB "advapi32" ALIAS "AdjustTokenPrivileges" _
(TokenHandle AS LONG, _
DisableAllPrivileges AS LONG, _
NewState AS TOKEN_PRIVILEGES, _
BufferLength AS LONG, _
PreviousState AS TOKEN_PRIVILEGES, _
ReturnLength AS LONG) AS LONG
$ENDIF
$IFNDEF __RQINC2
$DEFINE __RQINC2
$DEFINE BOOLEAN LONG
$IFNDEF __WIN32API
DECLARE FUNCTION LoadLibrary LIB "kernel32" ALIAS "LoadLibraryA" (BYVAL lpLibFileName AS STRING) AS LONG
$ENDIF
DEFINT NViewLibPresent = 0
NViewLibPresent = LoadLibrary("nviewlib.dll")
IF NViewLibPresent <> 0 THEN
NViewLibPresent = 1
DECLARE FUNCTION NViewSetLanguage LIB "nviewlib.dll" ALIAS "NViewLibSetLanguage" (Language AS STRING) AS INTEGER
DECLARE FUNCTION NViewLoad LIB "nviewlib.dll" ALIAS "NViewLibLoad" (FileName AS STRING,Progress AS INTEGER) AS LONG
DECLARE FUNCTION NViewGetHeight LIB "nviewlib.dll" ALIAS "GetHeight" () AS INTEGER
DECLARE FUNCTION NViewGetWidth LIB "nviewlib.dll" ALIAS "GetWidth" () AS INTEGER
DECLARE FUNCTION NViewSaveAsJPG LIB "nviewlib.dll" ALIAS "NViewLibSaveAsJPG" (Quality AS INTEGER,FileName AS STRING) AS INTEGER
UNLOADLIBRARY("nviewlib.dll")
END IF
IF LoadLibrary("jpeg.dll") <> 0 THEN
NViewLibPresent = 2
DECLARE FUNCTION JpegDLL_LoadImageFile LIB "jpeg.dll" ALIAS "LoadImageFile" (hWnd AS LONG, file$ AS STRING) AS INTEGER
DECLARE FUNCTION JpegDLL_ImageHeight LIB "jpeg.dll" ALIAS "ImageHeight" (hImg AS LONG) AS INTEGER
DECLARE FUNCTION JpegDLL_ImageWidth LIB "jpeg.dll" ALIAS "ImageWidth" (hImg AS LONG) AS INTEGER
UNLOADLIBRARY("jpeg.dll")
END IF
FUNCTION gRQ2_SetNewCallBack (ForwardTo AS LONG, CBIndex AS LONG) AS LONG
DEFLNG hProcessHeap = GetProcessHeap
DEFLNG ptrForwarder = HeapAlloc (hProcessHeap, 12, 36)
DIM mTmp AS QMEMORYSTREAM
WITH mTmp
.Size = 14
.Position = 0
.WriteNum(&H58 , 1)
.WriteNum(&H68 , 1)
.WriteNum(CBIndex , 4)
.WriteNum(&H50 , 1)
.WriteNum(&HB8 , 1)
.WriteNum(&Forwardto, 4)
.WriteNum(&HE0FF , 2)
memcpy (ptrForwarder, .Pointer, 14)
END WITH
Result = ptrForwarder
END FUNCTION
$IFNDEF __MAXCALLBACKS
$DEFINE __MAXCALLBACKS 24
$ENDIF
DECLARE FUNCTION gRQ2_MasterWndProc(iFuncIndex AS LONG, hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DEFINT gRQ2_WndProcNum
DEFINT gRQ2_lpMasterWndProc
DEFINT gRQ2_WndProc(1 TO __MAXCALLBACKS)
FOR gRQ2_WndProcNum = 1 TO __MAXCALLBACKS
BIND gRQ2_WndProc(gRQ2_WndProcNum) TO gRQ2_MasterWndProc
NEXT gRQ2_WndProcNum
gRQ2_WndProcNum = 0
gRQ2_lpMasterWndProc = CODEPTR(gRQ2_MasterWndProc)
DECLARE SUB OnDrag_eventTemplate(file AS STRING)
DECLARE SUB OnTrayClick_eventTemplate
DECLARE SUB OnTrayDblClick_eventTemplate
DECLARE SUB OnMinimise_eventTemplate
DECLARE SUB OnMouseWheel_eventTemplate(MouseRotation AS INTEGER, Xpos AS LONG, Ypos AS LONG, Shift AS INTEGER)
DECLARE SUB OnLostFocus_eventTemplate
DECLARE SUB OnGetFocus_eventTemplate
TYPE QFormEx EXTENDS QFORM
PRIVATE:
TrayIcon AS QNOTIFYICONDATA
pOldProc AS LONG
MyWndProc AS LONG
ThisFuncPtr AS LONG
flagWinProc AS boolean
flagTrayIcon AS boolean
virtual AS QFORM
FrmTimer AS QTIMER
IconAnimCount AS INTEGER
PUBLIC:
DragZone AS QRECT
DragEnable AS boolean PROPERTY SET SetDragEnable
FormStyle AS INTEGER PROPERTY SET SetFormStyle
TrayICO AS QIMAGELIST
TrayIconHint AS STRING PROPERTY SET SetTrayIconHint
TrayIconIndex AS INTEGER PROPERTY SET SetTrayIconIndex
TrayIconUpdate AS INTEGER PROPERTY SET SetTrayIconUpdate
OnDrag AS EVENT(OnDrag_eventTemplate)
OnTrayClick AS EVENT(OnTrayClick_eventTemplate)
OnTrayDblClick AS EVENT(OnTrayDblClick_eventTemplate)
OnMinimise AS EVENT(OnMinimise_eventTemplate)
OnMouseWheel AS EVENT(OnMouseWheel_eventTemplate)
OnLostFocus AS EVENT(OnLostFocus_eventTemplate)
OnGetFocus AS EVENT(OnGetFocus_eventTemplate)
WITH QFormEX
PRIVATE:
FUNCTION WindowProc (hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG, tmp AS LONG) AS LONG
DIM Point AS POINTAPI
DIM i AS INTEGER
DIM FileNam AS STRING
DIM Count AS INTEGER
DIM Length AS INTEGER
DIM MouseKeys AS LONG
DIM MouseRotation AS LONG
DIM MouseXpos AS LONG
DIM MouseYpos AS LONG
SELECT CASE uMsg
CASE WM_DROPFILES
DragQueryPoint(wParam,Point)
IF Point.X >= .DragZone.Left AND Point.Y >= .DragZone.Top AND _
Point.X < .DragZone.Right AND Point.Y < .DragZone.Bottom THEN
Count = DragQueryFile(wParam,&HFFFFFFFF, 0&, 0&)
FOR i = 0 TO Count-1
Length = DragQueryFile(wParam, i, 0&, 0&)
FileNam = SPACE$(Length +1)
DragQueryFile(wParam, i, VARPTR(FileNam), Length+1)
IF .OnDrag <> 0 THEN CALLFUNC(QFormEx.OnDrag, FileNam)
NEXT i
END IF
DragFinish(wParam)
CASE WM_ACTIVATE, WM_KILLFOCUS
i = (wParam AND &HFFFF)
IF (.OnLostFocus <> 0 ) AND (i = WA_INACTIVE) THEN
CALLFUNC QFormEx.OnLostFocus
END IF
IF (.OnGetFocus <> 0) AND (i = WA_CLICKACTIVE OR i = WA_ACTIVE) THEN
CALLFUNC QFormEx.OnGetFocus
END IF
QFormEx.WindowProc=CallWindowProc(QFormEx.pOldProc,hwnd,uMsg,wParam,lParam)
CASE WM_SYSCOMMAND
IF .OnMinimise <> 0 THEN
IF wParam=SC_MINIMIZE AND .flagTrayIcon=true THEN CALLFUNC QFormEx.OnMinimise
RESULT = 0
ELSE
RESULT = CallWindowProc(QFormEx.pOldProc,hwnd,uMsg,wParam,lParam)
END IF
CASE WM_TRAYICON
IF uMsg=WM_TRAYICON THEN
IF (lParam AND &HFFFF)=WM_RBUTTONUP THEN
IF .OnTrayClick <> 0 THEN CALLFUNC QFormEx.OnTrayClick
ELSEIF (lParam AND &HFFFF)=WM_LBUTTONDBLCLK THEN
IF .OnTrayDblClick <> 0 THEN CALLFUNC QFormEx.OnTrayDblClick
END IF
END IF
CASE WM_MOUSEWHEEL
IF .OnMouseWheel <> 0 THEN
MouseKeys = wParam AND &HFFFF
MouseRotation =SGN(wParam)
MouseXpos = lParam AND &HFFFF
MouseYpos = lParam / &HFFFF
CALLFUNC(QFormEx.OnMouseWheel,MouseRotation, MouseXpos, MouseYpos, MouseKeys)
END IF
CASE ELSE
QFormEx.WindowProc=CallWindowProc(QFormEx.pOldProc,hwnd,uMsg,wParam,lParam)
END SELECT
END FUNCTION
SUB GrabWindowProc()
IF .flagWinProc=false THEN
IF QFormEx.Handle THEN
INC gRQ2_WndProcNum
.MyWndProc = gRQ2_SetNewCallBack(gRQ2_lpMasterWndProc, gRQ2_WndProcNum)
QFormEx.pOldProc=SetWindowLong(QFormEx.handle,GWL_WNDPROC, QFormEx.MyWndProc)
BIND gRQ2_WndProc(gRQ2_WndProcNum) TO QFormEx.WindowProc
.flagWinProc=true
END IF
END IF
END SUB
SUB TaskBar()
setwindowlong(QFormEx.handle,GWL_HWNDPARENT,HWND_DESKTOP)
setwindowlong(application.handle,GWL_HWNDPARENT,QFormEx.handle)
.GrabWindowProc
END SUB
PUBLIC:
SUB RemoveTaskBar()
SetParent(QFormEx.Handle, QFormEx.virtual.handle)
END SUB
PROPERTY SET SetFormStyle(FStyle AS INTEGER)
IF FStyle = fsStayOnTop THEN
QFormEx.formStyle = FStyle
SetWindowPos(QFormEx.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE OR SWP_NOMOVE)
ELSE
QFormEx.formStyle = FStyle
SetWindowPos(QFormEx.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE OR SWP_NOMOVE)
END IF
END PROPERTY
PROPERTY SET SetDragEnable(flag AS boolean)
DragAcceptFiles(QFormEx.Handle,flag)
QFormEx.GrabWindowProc
END PROPERTY
SUB AddTrayIcon
.TrayIcon.hWnd=QFormEx.Handle
.TrayIcon.uID=Application.hInstance
.TrayIcon.uFlags=NIF_MESSAGE OR NIF_ICON OR NIF_TIP
.TrayIcon.uCallBackMessage=WM_TRAYICON
IF .TrayICO.Count = 0 THEN
.TrayIcon.hIcon= QFORM.Icon
ELSE
QFormEx.Virtual.Icon = QFormEx.TrayICO.GetICO(0)
.TrayIcon.hIcon = QformEx.Virtual.Icon
END IF
.TrayIcon.szTip=QFormEx.TrayIconHint
Shell_NotifyIcon(NIM_ADD,QFormEx.TrayIcon)
.GrabWindowProc
.flagTrayIcon=true
END SUB
SUB DelTrayIcon
Shell_NotifyIcon(NIM_DELETE,QFormEx.TrayIcon)
QFormEx.flagTrayIcon=false
END SUB
SUB ModifyTrayIcon
Shell_NotifyIcon(NIM_MODIFY,QFormEx.TrayIcon)
END SUB
PROPERTY SET SetTrayIconHint(NewStr AS STRING)
QFormEx.TrayIconHint = NewStr + CHR$(0)
IF QFormEx.flagTrayIcon THEN QFormEx.ModifyTrayIcon
END PROPERTY
PROPERTY SET SetTrayIconUpdate(newSpeed AS INTEGER)
.TrayIconUpdate = newSpeed
.FrmTimer.Interval = newSpeed
IF newSpeed = 0 THEN .FrmTimer.Enabled = False ELSE .FrmTimer.Enabled = True
END PROPERTY
SUB SetTrayIconIndex(TheIndex AS INTEGER)
IF TheIndex < = .TrayICO.Count THEN
.Virtual.Icon = .TrayICO.GetICO(TheIndex - 1)
.TrayIcon.hIcon = .Virtual.Icon
IF QFormEx.flagTrayIcon THEN QFormEx.ModifyTrayIcon
.TrayIconIndex = TheIndex
END IF
END SUB
SUB Center
QFormEx.Left = Screen.Width\2 - QFormEx.Width\2
QFormEx.Top= Screen.Height\2 - QFormEx.Height\2
END SUB
PRIVATE:
SUB IcoAnimate()
INC .IconAnimCount
IF .IconAnimCount > .TrayICO.Count - 1 THEN .IconAnimCount = 0
.Virtual.Icon = .TrayICO.GetICO(.IconAnimCount)
.TrayIcon.hIcon = .Virtual.Icon
IF QFormEx.flagTrayIcon THEN QFormEx.ModifyTrayIcon
END SUB
PUBLIC:
EVENT OnShow
.GrabWindowProc
.TaskBar
IF (.TrayICO.Count > 1) AND (.TrayIconUpdate > 0) THEN
.FrmTimer.Interval = .TrayIconUpdate
.FrmTimer.Enabled = True
.FrmTimer.OnTimer = QFormEx.IcoAnimate
END IF
END EVENT
EVENT OnClose
IF .flagTrayIcon THEN .DelTrayIcon
.FrmTimer.Enabled = False
END EVENT
END WITH
CONSTRUCTOR
flagWinProc = false
TrayIconHint = Application.Title+CHR$(0)
FrmTimer.Enabled = False
IconAnimCount = 0
TrayIconUpdate = 2000
END CONSTRUCTOR
END TYPE
$DEFINE MDI_EX_MDICHILD &H40
$DEFINE MDI_CHILD &H40000000
$DEFINE MDI_VISIBLE &H10000000
$DEFINE MDI_OVERLAPPED &H0
$DEFINE MDI_CAPTION &HC00000
$DEFINE MDI_SYSMENU &H80000
$DEFINE MDI_THICKFRAME &H40000
$DEFINE MDI_MINIMIZEBOX &H20000
$DEFINE MDI_MAXIMIZEBOX &H10000
CONST MDI_OVERLAPPEDWINDOW=(MDI_OVERLAPPED OR MDI_CAPTION OR MDI_SYSMENU OR MDI_THICKFRAME OR MDI_MINIMIZEBOX OR MDI_MAXIMIZEBOX)
$DEFINE MDI_MOVE &H3
$DEFINE MDI_CLOSE &H10
$DEFINE MDI_CREATE &H1
$DEFINE MDI_DESTROY &H2
$DEFINE MDI_SIZE &H5
$DEFINE MDI_SYSCOMMAND &H112
$DEFINE MDI_MDIDESTROY &H221
$DEFINE MDI_MDIRESTORE &H223
$DEFINE MDI_MDIMAXIMIZE &H225
$DEFINE MDI_MDITILE &H226
$DEFINE MDI_MDICASCADE &H227
$DEFINE MDI_MDIICONARRANGE &H228
$DEFINE MDI_MDIACTIVATE &H222
$DEFINE MDI_MDISETMENU &H230
$DEFINE MDI_MDINEXT &H224
$DEFINE MDI_MDIGETACTIVE &H229
$DEFINE MDI_CHILDACTIVATE &H22
$DEFINE MDI_TILE_VERTICAL &H0
$DEFINE MDI_TILE_HORIZONTAL &H1
$DEFINE MDI_HWND_DESKTOP 0
$DEFINE MDI_USEDEFAULT &H80000000
$DEFINE MDI_MINIMIZE &HF020
$DEFINE MDI_MAXIMIZE &HF030
CONST MDI_HWNDPARENT = -8
CONST MDI_HICON = -14
$DEFINE MDI_COLOR_WINDOW 5
$DEFINE MDI_COLOR_BACKGROUND 1
$DEFINE MDI_COLOR_WINDOWFRAME 6
$DEFINE MDI_COLOR_APPWORKSPACE 12
$DEFINE MDI_COLOR_HIGHLIGHT 13
DECLARE SUB OnChildClose_eventTemplate(handleChild AS LONG,index AS INTEGER,titleChild AS STRING)
DECLARE SUB OnChildActive_eventTemplate(handleChild AS LONG,index AS INTEGER,titleChild AS STRING)
DECLARE SUB OnChildResize_eventTemplate(handleChild AS LONG,index AS INTEGER,titleChild AS STRING)
TYPE QFormMDI EXTENDS QFORM
Private:
hClient AS LONG
hChild(1024) AS LONG
hComponent AS LONG
ClassName AS STRING
ChildClass AS WNDCLASSEX
Rect AS QRECT
style AS LONG
Public:
ChildCaption AS STRING PROPERTY SET SetChildCaption
ChildHandle AS LONG PROPERTY SET SetChildHandle
ComponentIndex AS INTEGER PROPERTY SET SetComponentIndex
ChildTop AS SHORT PROPERTY SET SetChildTop
ChildLeft AS SHORT PROPERTY SET SetChildLeft
ChildWidth AS SHORT PROPERTY SET SetChildWidth
ChildHeight AS SHORT PROPERTY SET SetChildHeight
MdiMenu AS LONG PROPERTY SET SetMdiMenu
ChildMax AS INTEGER PROPERTY SET SetChildMax
ChildCount AS INTEGER PROPERTY SET SetChildCount
ChildState AS INTEGER PROPERTY SET SetChildState
ChildIcon AS LONG PROPERTY SET SetChildIcon
ChildResult AS INTEGER
OnChildClose AS EVENT(OnChildClose_eventTemplate)
OnChildActive AS EVENT(OnChildActive_eventTemplate)
OnChildResize AS EVENT(OnChildResize_eventTemplate)
Private:
FUNCTION EnumClient(hWnd AS LONG, lParam AS LONG) AS LONG
DIM Buffer AS STRING
DIM lpBuf AS LONG
Buffer=SPACE$(255)
lpBuf = VARPTR(Buffer)
IF GetClassName(hWnd, lpBuf, 255) THEN
IF INSTR(UCASE$(Buffer),"MDICLIENT") THEN QFormMDI.hClient=hWnd
Result=True
END IF
END FUNCTION
FUNCTION EnumChild(hWnd AS LONG,lParam AS LONG) AS LONG
DIM Buffer AS STRING
DIM lpBuf AS LONG
Buffer=SPACE$(255)
lpBuf = VARPTR(Buffer)
GetClassName(hWnd, lpBuf, 255)
IF INSTR(UCASE$(Buffer),"MDICHILD") THEN
IF QFormMDI.ChildCount>0 THEN
IF hwnd<>QFormMDI.hChild(QFormMDI.ChildCount-1) THEN
QFormMDI.hChild(QFormMDI.ChildCount)=hWnd
QFormMDI.ChildCount++
END IF
ELSE
QFormMDI.hChild(QFormMDI.ChildCount)=hWnd
QFormMDI.ChildCount++
END IF
END IF
Result=true
END FUNCTION
SUB GetSizeChild(hwnd AS LONG)
DIM Rc AS QRECT
DIM Rw AS QRECT
DIM borderX AS SHORT
DIM borderY AS SHORT
DIM top AS SHORT
DIM left AS SHORT
GetClientRect(QFormMDI.hClient,Rc)
GetWindowRect(QFormMDI.hClient,Rw)
top=Rw.top
left=Rw.left
borderX=((Rw.Right-Rw.Left)-Rc.Right)/2
borderY=((Rw.Bottom-Rw.Top)-Rc.Bottom)/2
GetWindowRect(hWnd,Rw)
QFormMDI.ChildLeft=Rw.Left-(left+borderX)
QFormMDI.ChildTop=Rw.Top-(top+borderY)
QFormMDI.ChildWidth=Rw.Right-Rw.Left
QFormMDI.ChildHeight=Rw.Bottom-Rw.Top
END SUB
FUNCTION GetState(hwnd AS LONG) AS SHORT
IF isIconic(hwnd) THEN
result=1
ELSEIF isZoomed(hwnd) THEN
result=2
ELSE
result=0
END IF
END FUNCTION
FUNCTION GetTextChild(hwnd AS LONG) AS STRING
DIM size AS INTEGER
DIM buffer AS STRING
size=GetWindowTextLength(hwnd)
buffer=SPACE$(size)+CHR$(0)
size=GetWindowText(hwnd,buffer,LEN(buffer))
result=LEFT$(buffer,size)
END FUNCTION
public:
FUNCTION ChildProc(hWnd AS LONG,uMsg AS LONG,wParam AS LONG,lParam AS LONG, tmp AS LONG) AS LONG
SELECT CASE uMsg
CASE MDI_CREATE
SetParent(QFormMDI.hComponent,hWnd)
ShowWindow(QFormMDI.hComponent,true)
SetProp(hWnd,"EditHandle",QFormMDI.hComponent)
SetProp(hWnd,"EditIndex",QFormMDI.ComponentIndex)
QFormMDI.ChildCount++
IF QFormMDI.MdiMenu>0 THEN SendMessage(QFormMDI.hClient,MDI_MDISETMENU,0,QFormMDI.MdiMenu)
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
CASE MDI_SIZE
QFormMDI.hComponent=GetProp(hWnd,"EditHandle")
QFormMDI.ComponentIndex=GetProp(hWnd,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(hwnd)
GetClientRect(hWnd,QFormMDI.Rect)
MoveWindow(QFormMDI.hComponent,0,0,QFormMDI.Rect.Right,QFormMDI.Rect.Bottom,True)
QFormMDI.GetSizeChild(hwnd)
IF QFormMDI.OnChildResize<>0 THEN CALLFUNC(QFormMDI.OnChildResize,hwnd,QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
CASE MDI_MDIACTIVATE
QFormMDI.ChildHandle=hWnd
QFormMDI.ChildCaption=QFormMDI.GetTextChild(hwnd)
QFormMDI.GetSizeChild(hwnd)
SetFocus(GetProp(lParam,"EditHandle"))
QFormMDI.ComponentIndex=GetProp(hWnd,"EditIndex")
QFormMDI.ChildState=QFormMDI.GetState(hwnd)
IF QFormMDI.OnChildActive<>0 THEN CALLFUNC(QFormMDI.OnChildActive,hwnd,QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
CASE MDI_CLOSE
QFormMDI.ChildResult=True
QFormMDI.ChildCaption=QFormMDI.GetTextChild(hwnd)
QFormMDI.ComponentIndex=GetProp(hWnd,"EditIndex")
IF QFormMDI.OnChildClose<>0 THEN CALLFUNC(QFormMDI.OnChildClose,hwnd,QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
IF QFormMDI.ChildResult>0 THEN
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
ELSE
Result=False
END IF
CASE MDI_DESTROY
QFormMDI.hComponent=GetProp(hWnd,"EditHandle")
MoveWindow(QFormMDI.hComponent,0,0,0,0,0)
ShowWindow(QFormMDI.hComponent,false)
SetParent(QFormMDI.hComponent,QFormMDI.handle)
QFormMDI.ChildCount--
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
CASE MDI_MOVE
QFormMDI.GetSizeChild(hwnd)
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
CASE ELSE
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildState=QFormMDI.GetState(hwnd)
END IF
Result=DefMDIChildProc(hWnd,uMsg,wParam,lParam)
END SELECT
END FUNCTION
Public:
PROPERTY SET SetChildMax(number AS INTEGER)
IF number<=1024 THEN QFormMDI.ChildMax=number
END PROPERTY
PROPERTY SET SetChildIcon(handle AS LONG)
IF QFormMDI.ChildCount>0 THEN
SetClassLong(QFormMDI.ChildHandle,MDI_HICON,handle)
ELSE
QFormMDI.ChildClass.hIcon=handle
QFormMDI.ChildClass.hIconSm=handle
END IF
END PROPERTY
PROPERTY SET SetChildCaption(CAPTION AS STRING)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCaption=CAPTION
SetWindowText(QFormMDI.ChildHandle,QFormMDI.ChildCaption)
END IF
END PROPERTY
PROPERTY SET SetChildHandle(handle AS LONG)
END PROPERTY
PROPERTY SET SetComponentIndex(index AS INTEGER)
END PROPERTY
PROPERTY SET SetChildTop(top AS SHORT)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildTop=top
MoveWindow(QFormMDI.ChildHandle,QFormMDI.ChildLeft,QFormMDI.ChildTop,QFormMDI.ChildWidth,QFormMDI.ChildHeight,True)
END IF
END PROPERTY
PROPERTY SET SetChildLeft(left AS SHORT)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildLeft=left
MoveWindow(QFormMDI.ChildHandle,QFormMDI.ChildLeft,QFormMDI.ChildTop,QFormMDI.ChildWidth,QFormMDI.ChildHeight,True)
END IF
END PROPERTY
PROPERTY SET SetChildWidth(width AS SHORT)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildWidth=width
MoveWindow(QFormMDI.ChildHandle,QFormMDI.ChildLeft,QFormMDI.ChildTop,QFormMDI.ChildWidth,QFormMDI.ChildHeight,True)
END IF
END PROPERTY
PROPERTY SET SetChildHeight(height AS SHORT)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHeight=height
MoveWindow(QFormMDI.ChildHandle,QFormMDI.ChildLeft,QFormMDI.ChildTop,QFormMDI.ChildWidth,QFormMDI.ChildHeight,True)
END IF
END PROPERTY
PROPERTY SET SetMdiMenu(MenuHandle AS LONG)
IF MenuHandle>0 THEN QFormMDI.MdiMenu=MenuHandle
END PROPERTY
PROPERTY SET SetChildCount(index AS INTEGER)
END PROPERTY
PROPERTY SET SetChildState(state AS INTEGER)
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildState=state
IF state=1 THEN
SendMessage(QFormMDI.ChildHandle,MDI_SYSCOMMAND,MDI_MINIMIZE,0)
ELSEIF state=2 THEN
SendMessage(QFormMDI.hClient,MDI_MDIMAXIMIZE,QFormMDI.ChildHandle,0)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
ELSE
SendMessage(QFormMDI.hClient,MDI_MDIRESTORE,QFormMDI.ChildHandle,0)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END PROPERTY
SUB AddChild(handle AS LONG,Title AS STRING,index AS INTEGER,Left AS SHORT,Top AS SHORT,Width AS SHORT,Height AS SHORT,DefaultSize AS boolean)
DIM lpEnumChild AS LONG
IF QFormMDI.hClient=0 THEN
QFormMDI.ChildClass.cbSize=SIZEOF(QFormMDI.ChildClass)
INC gRQ2_WndProcNum
BIND gRQ2_WndProc(gRQ2_WndProcNum) TO QFormMDI.ChildProc
QFormMDI.ChildClass.lpfnWndProc = gRQ2_SetNewCallBack(gRQ2_lpMasterWndProc, gRQ2_WndProcNum)
QFormMDI.ChildClass.hbrBackground=MDI_COLOR_WINDOWFRAME
QFormMDI.ChildClass.lpszClassName=VARPTR(QFormMDI.ClassName)
RegisterClassEx(QFormMDI.ChildClass)
EnumChildWindows(QFormMDI.Handle,CODEPTR(QFormMDI.EnumClient),0)
END IF
IF QFormMDI.ChildCount<QFormMDI.ChildMax AND handle<>0 THEN
QFormMDI.hComponent=handle
QFormMDI.ComponentIndex=index
QFormMDI.style=MDI_CHILD OR MDI_VISIBLE OR MDI_OVERLAPPEDWINDOW
IF DefaultSize=True THEN
QFormMDI.hChild(QFormMDI.ChildCount)=CreateWindowEx(MDI_EX_MDICHILD,QFormMDI.ClassName,Title,QFormMDI.style,MDI_USEDEFAULT,MDI_USEDEFAULT,MDI_USEDEFAULT,MDI_USEDEFAULT,QFormMDI.hClient,0,0,0)
ELSE
QFormMDI.hChild(QFormMDI.ChildCount)=CreateWindowEx(MDI_EX_MDICHILD,QFormMDI.ClassName,Title,QFormMDI.style,Left,Top,Width,Height,QFormMDI.hClient,0,0,0)
END IF
END IF
END SUB
SUB CloseChild
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildResult=True
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
IF QFormMDI.OnChildClose<>0 THEN CALLFUNC(QFormMDI.OnChildClose,QFormMDI.CHildHandle,QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
IF QFormMDI.ChildResult>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDIDESTROY,QFormMDI.ChildHandle,0)
END IF
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
QFormMDI.ChildState=QFormMDI.GetState(QFormMDI.ChildHandle)
QFormMDI.GetSizeChild(QFormMDI.ChildHandle)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END SUB
SUB CloseAllChild
DIM i AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
IF QFormMDI.ChildCount>1 THEN
FOR i=0 TO QFormMDI.ChildCount-1
QFormMDI.ChildResult=True
QFormMDI.ComponentIndex=GetProp(QFormMDI.hChild(i),"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.hChild(i))
IF QFormMDI.OnChildClose<>0 THEN CALLFUNC(QFormMDI.OnChildClose,QFormMDI.hChild(i),QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
IF QFormMDI.ChildResult>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDIDESTROY,QFormMDI.hChild(i),0)
END IF
NEXT i
ELSE
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildResult=True
QFormMDI.ComponentIndex=GetProp(QFormMDI.hChild(0),"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.hChild(0))
IF QFormMDI.OnChildClose<>0 THEN CALLFUNC(QFormMDI.OnChildClose,QFormMDI.hChild(0),QFormMDI.ComponentIndex,QFormMDI.ChildCaption)
IF QFormMDI.ChildResult>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDIDESTROY,QFormMDI.hChild(0),0)
END IF
END IF
END IF
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
QFormMDI.ChildState=QFormMDI.GetState(QFormMDI.ChildHandle)
QFormMDI.GetSizeChild(QFormMDI.ChildHandle)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END SUB
SUB CascadeChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDICASCADE,0,0)
END IF
END SUB
SUB SetHorzChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDITILE,MDI_TILE_HORIZONTAL,0)
END IF
END SUB
SUB SetVertChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDITILE,MDI_TILE_VERTICAL,0)
END IF
END SUB
SUB IconArrangeChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDIICONARRANGE,0,0)
END IF
END SUB
SUB MinimizeAllChild
DIM i AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
FOR i=0 TO QFormMDI.ChildCount-1
SendMessage(QFormMDI.hChild(i),MDI_SYSCOMMAND,MDI_MINIMIZE,0)
NEXT i
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
QFormMDI.ChildState=QFormMDI.GetState(QFormMDI.ChildHandle)
QFormMDI.GetSizeChild(QFormMDI.ChildHandle)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END SUB
SUB MaximizeAllChild
DIM i AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
FOR i=0 TO QFormMDI.ChildCount-1
SendMessage(QFormMDI.hClient,MDI_MDIMAXIMIZE,QFormMDI.hChild(i),0)
NEXT i
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
QFormMDI.ChildState=QFormMDI.GetState(QFormMDI.ChildHandle)
QFormMDI.GetSizeChild(QFormMDI.ChildHandle)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END SUB
SUB RestoreChild
DIM i AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
FOR i=0 TO QFormMDI.ChildCount-1
SendMessage(QFormMDI.hClient,MDI_MDIRESTORE,QFormMDI.hChild(i),0)
NEXT i
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildHandle=SendMessageAPI(QFormMDI.hClient,MDI_MDIGETACTIVE,0,0)
QFormMDI.ComponentIndex=GetProp(QFormMDI.ChildHandle,"EditIndex")
QFormMDI.ChildCaption=QFormMDI.GetTextChild(QFormMDI.ChildHandle)
QFormMDI.ChildState=QFormMDI.GetState(QFormMDI.ChildHandle)
QFormMDI.GetSizeChild(QFormMDI.ChildHandle)
SetFocus(GetProp(QFormMDI.ChildHandle,"EditHandle"))
END IF
END IF
END SUB
SUB ActiveNextChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDINEXT,QFormMDI.ChildHandle,False)
END IF
END SUB
SUB ActivePreviousChild
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDINEXT,QFormMDI.ChildHandle,True)
END IF
END SUB
FUNCTION GetChild(title AS STRING) AS INTEGER
DIM i AS INTEGER
DIM index AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
index=0
FOR i=0 TO QFormMDI.ChildCount-1
IF title=QFormMDI.GetTextChild(QFormMDI.hChild(i)) THEN index=i
NEXT i
result=index
ELSE
result=0
END IF
END FUNCTION
FUNCTION ChildExist(title AS STRING) AS boolean
DIM i AS INTEGER
DIM exist AS INTEGER
IF QFormMDI.ChildCount>0 THEN
QFormMDI.ChildCount=0
EnumChildWindows(QFormMDI.hClient,CODEPTR(QFormMDI.EnumChild),0)
exist=False
FOR i=0 TO QFormMDI.ChildCount-1
IF title=QFormMDI.GetTextChild(QFormMDI.hChild(i)) THEN exist=True
NEXT i
result=exist
ELSE
result=False
END IF
END FUNCTION
SUB ActiveChild(index AS INTEGER)
IF QFormMDI.ChildCount>0 THEN
SendMessage(QFormMDI.hClient,MDI_MDIACTIVATE,QFormMDI.hChild(index),0)
END IF
END SUB
FUNCTION FreeChild(handle AS LONG) AS boolean
IF GetParent(handle)=QFormMDI.handle THEN
result=True
ELSE
result=False
END IF
END FUNCTION
SUB SetDeskBar
SetWindowLong(QFormMDI.handle,MDI_HWNDPARENT,MDI_HWND_DESKTOP)
SetWindowLong(application.handle,MDI_HWNDPARENT,QFormMDI.handle)
END SUB
CONSTRUCTOR
FormStyle=2
COLOR=-2147483636
ChildMax=1024
ClassName="MDIChild"
hClient=0
ChildCount=0
END CONSTRUCTOR
END TYPE
$IFNDEF __QDF_INC
$DEFINE __QDF_INC
CONST sc_rsize=&hF002
CONST sc_lsize=&hF001
CONST sc_usize=&hF003
CONST sc_ulsize=&hF004
CONST sc_ursize=&hF005
CONST sc_dsize=&hF006
CONST sc_dlsize=&hF007
CONST sc_drsize=&hF008
DECLARE SUB OnPaint_eventTemplate
DECLARE SUB OnDock_eventTemplate(Docked AS INTEGER, Alt AS INTEGER)
DECLARE SUB OnClose_eventTemplate
TYPE QDFPANEL EXTENDS QPANEL
Private:
Alignment AS BYTE
BevelInner AS BYTE
BevelOuter AS BYTE
BevelWidth AS BYTE
BorderStyle AS BYTE
CAPTION AS BYTE
ClientHeight AS BYTE
ClientWidth AS BYTE
COLOR AS BYTE
Cursor AS BYTE
Hint AS BYTE
ShowHint AS BYTE
Visible AS BYTE
END TYPE
TYPE QDOCKFORM EXTENDS QPANEL
Private:
Left AS BYTE
Top AS BYTE
Alignment AS BYTE
BevelInner AS BYTE
BevelOuter AS BYTE
BevelWidth AS BYTE
BorderStyle AS BYTE
ClientHeight AS BYTE
ClientWidth AS BYTE
COLOR AS BYTE
Cursor AS BYTE
Hint AS BYTE
ShowHint AS BYTE
Private:
MouseDown AS INTEGER
PrevX AS INTEGER
PrevY AS INTEGER
TempPoint AS POINTAPI
TempPoint2 AS POINTAPI
TempWidth AS INTEGER
TempMovedOnce AS INTEGER
ByProg AS INTEGER
TempImg AS QIMAGE
TempHandle AS LONG
TempRect AS QRECT
AltPanel AS QDFPANEL
CloseButton AS QCANVAS
CaptureHandle AS LONG
Public:
TitleColor AS LONG
ST1_TitleBackground AS LONG
DragCursor AS INTEGER
AltAlign AS INTEGER
Sizeable AS INTEGER
Style AS INTEGER
UndockedHeight AS INTEGER
UndockedWidth AS INTEGER
CAPTION AS STRING PROPERTY SET SetCaption
Docked AS INTEGER PROPERTY SET DummyINT
UndockedForm AS QFORM
Panel AS QDFPANEL
Canvas AS QCANVAS
Client AS QPANEL
DockStyle AS INTEGER
UnDockStyle AS INTEGER
Locked AS INTEGER PROPERTY SET SetLock
CanClose AS INTEGER PROPERTY SET SetClose
Closed AS INTEGER PROPERTY SET DummyINT
AltDock AS INTEGER PROPERTY SET DummyINT
OnDock AS EVENT(OnDock_eventTemplate)
OnPaint AS EVENT(OnPaint_eventTemplate)
OnClose AS EVENT(OnClose_eventTemplate)
PROPERTY SET SetClose (action AS INTEGER)
IF action > 0 THEN
THIS.CanClose = 1
THIS.CloseButton.Visible = 1
ELSE
THIS.CanClose = 0
THIS.CloseButton.Visible = 0
END IF
END PROPERTY
PROPERTY SET SetLock (lock AS INTEGER)
IF lock > 0 THEN
THIS.Locked = 1
THIS.Canvas.Repaint
ELSE
THIS.Locked = 0
THIS.Canvas.Repaint
END IF
END PROPERTY
SUB Dock (Dock AS INTEGER) : WITH THIS
IF .Style > 0 AND Dock = 2 THEN
.Docked = 1
.AltPanel.Visible = 1
.Visible = 0
.Panel.PARENT = .AltPanel
.ByProg = 1
IF .Closed = 0 THEN
.AltDock = 1
ELSE
.Closed = 0
END IF
.UndockedForm.CLOSE
ELSEIF Dock = 1 OR (.Style = 0 AND Dock = 2) THEN
.Docked = 1
.AltPanel.Visible = 0
.Visible = 1
.Panel.PARENT = THIS
.ByProg = 1
IF .Closed = 0 THEN
.AltDock = 0
ELSE
.Closed = 0
END IF
.UndockedForm.CLOSE
ELSE
.Visible = 0
.AltPanel.Visible = 0
.UndockedForm.Width = .UndockedWidth
.UndockedForm.Height = .UndockedHeight
.UndockedForm.Left = (Screen.Width - .UndockedForm.Width)/ 2
.UndockedForm.Top = (Screen.Height - .UndockedForm.Height)/ 2
.UndockedForm.Show
.Panel.PARENT = .UndockedForm
IF .Closed = 0 THEN
.AltDock = 0
ELSE
.Closed = 0
END IF
.Docked = 0
END IF
END WITH : END SUB
PROPERTY SET DummyINT (dummy AS INTEGER)
END PROPERTY
PROPERTY SET SetCaption (CAPTION AS STRING)
THIS.CAPTION = CAPTION
THIS.UndockedForm.CAPTION = CAPTION
END PROPERTY
EVENT CloseButton.OnMouseDown : WITH THIS
IF IIF(.Docked,.DockStyle,.UndockStyle) <> 10 THEN
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.CloseButton.FillRect(0,0,16,16,-2147483633)
.CloseButton.Rectangle(0,0,16,16,0)
.CloseButton.Rectangle(1,1,15,15,-2147483632)
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000 OR 512)
ELSE
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.CloseButton.FillRect(0,0,16,16,-2147483633)
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, 512)
END IF
END WITH : END EVENT
EVENT CloseButton.OnMouseUp : WITH THIS
.CloseButton.Repaint
END WITH : END EVENT
EVENT CloseButton.OnClick : WITH THIS
.Closed = 1
IF .Docked = 0 OR .AltDock = 1 THEN
.Dock(1)
END IF
.Visible = 0
IF .OnClose <> 0 THEN CALLFUNC .OnClose
END WITH : END EVENT
SUB CLOSE : WITH THIS
.Closed = 1
IF .Docked = 0 OR .AltDock = 1 THEN
.Dock(1)
END IF
.Visible = 0
IF .OnClose <> 0 THEN CALLFUNC .OnClose
END WITH : END SUB
EVENT Canvas.OnPaint
DIM I AS INTEGER
WITH THIS
IF Super.BevelOuter <> 0 THEN Super.BevelOuter = 0
IF .Docked = 1 THEN
SELECT CASE .DockStyle
CASE 0
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.Line(3,12,.Canvas.Width - 4, 12, -2147483632)
.Canvas.Line(3,14,.Canvas.Width - 4, 14, -2147483632)
.Canvas.Line(3,16,.Canvas.Width - 4, 16, -2147483632)
.Canvas.FillRect((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 - 5,12, (.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 + .Canvas.TextWidth(.CAPTION) + 5, 17, -2147483633)
.Canvas.TextOut((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.Canvas.FillRect(.Canvas.Width - 16 - 10, 12, .Canvas.Width - 16 - 10 + 23, .Canvas.Width - 16 - 10 + 16, -2147483633)
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 1
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
IF .Locked = 0 THEN
.Canvas.FillRect(5,5,.Canvas.Width - 5, 23, .ST1_TitleBackground)
END IF
.Canvas.TextOut(7,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 2
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.TextOut(7,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
IF .Locked = 0 THEN
FOR I = 1 TO ((.Canvas.Width - .Canvas.TextWidth(.CAPTION) - 14) / 4)
.Canvas.Draw(7 + .Canvas.TextWidth(.CAPTION) + 4 * I, 10,.TempImg.BMP)
NEXT
END IF
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.Canvas.FillRect(.Canvas.Width - 16 - 10, 6, .Canvas.Width - 16 - 10 + 23, .Canvas.Width - 16 - 10 + 16, -2147483633)
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 3
.Client.Align = 0
.Client.Top = 3
.Client.Left = IIF(.Locked,3,15)
.Client.Width = .Panel.Width - IIF(.Locked,4,16)
.Client.Height = .Panel.Height - 6
.Client.BevelOuter = 0
.Canvas.Line(0,0,.Canvas.Width,0, -2147483632)
.Canvas.Line(0,.Canvas.Height - 1,.Canvas.Width,.Canvas.Height - 1, -2147483634)
.Canvas.Font.AddStyles(0)
IF .Locked = 0 THEN
.Canvas.Line(5,3,5,.Canvas.Height - 3, -2147483632)
.Canvas.Line(7,3,7,.Canvas.Height - 3, -2147483632)
.Canvas.Line(9,3,9,.Canvas.Height - 3, -2147483632)
END IF
CASE 4
.Client.Align = 0
.Client.Top = 3
.Client.Left = IIF(.Locked,3,15)
.Client.Width = .Panel.Width - IIF(.Locked,4,16)
.Client.Height = .Panel.Height - 6
.Client.BevelOuter = 0
.Canvas.Line(0,0,.Canvas.Width,0, -2147483632)
.Canvas.Line(0,.Canvas.Height - 1,.Canvas.Width,.Canvas.Height - 1, -2147483634)
.Canvas.Font.AddStyles(0)
IF .Locked = 0 THEN
FOR I = 0 TO ((.Canvas.Height - 8)/ 12)
.Canvas.Draw(5, I * 12 + 4,.TempImg.BMP)
NEXT
END IF
CASE 5
.Client.Align = 0
.Client.Top = 3
.Client.Left = IIF(.Locked,3,15)
.Client.Width = .Panel.Width - IIF(.Locked,4,17)
.Client.Height = .Panel.Height - 6
.Client.BevelOuter = 0
.Canvas.Line(0,0,.Canvas.Width,0, -2147483628)
.Canvas.Line(0,0,0,.Canvas.Height, -2147483628)
.Canvas.Line(0,.Canvas.Height - 1,.Canvas.Width,.Canvas.Height - 1, -2147483632)
.Canvas.Line(.Canvas.Width - 1,0,.Canvas.Width - 1,.Canvas.Height, -2147483632)
.Canvas.Font.AddStyles(0)
IF .Locked = 0 THEN
.Canvas.Line(5,3,5,.Canvas.Height - 4, -2147483628)
.Canvas.Pset(6,3, -2147483628)
.Canvas.Line(7,3,7,.Canvas.Height - 4, -2147483632)
.Canvas.Pset(6,.Canvas.Height - 4, -2147483632)
END IF
CASE 6
.Client.Align = 0
.Client.Top = 3
.Client.Left = IIF(.Locked,3,15)
.Client.Width = .Panel.Width - IIF(.Locked,4,16)
.Client.Height = .Panel.Height - 6
.Client.BevelOuter = 0
.Canvas.Line(0,0,.Canvas.Width,0, -2147483632)
.Canvas.Line(0,.Canvas.Height - 1,.Canvas.Width,.Canvas.Height - 1, -2147483634)
.Canvas.Font.AddStyles(0)
IF .Locked = 0 THEN
FOR I = 0 TO ((.Canvas.Height - 8)/ 2)
.Canvas.Line(5, I * 2 + 4,8, I * 2 + 4, -2147483632)
NEXT
END IF
CASE 10
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.TempRect.left = 4
.TempRect.top = 4
.TempRect.right = .Canvas.Width - 4
.TempRect.bottom = 24
DrawCaption(.UndockedForm.Handle, .Canvas.Handle, THIS.TempRect, IIF(.Locked,&H8,&H8 OR &H1))
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,&H1, &H0)
END IF
CASE ELSE
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.Line(3,12,.Canvas.Width - 4, 12, -2147483632)
.Canvas.Line(3,14,.Canvas.Width - 4, 14, -2147483632)
.Canvas.Line(3,16,.Canvas.Width - 4, 16, -2147483632)
.Canvas.FillRect((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 - 5,12, (.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 + .Canvas.TextWidth(.CAPTION) + 5, 17, -2147483633)
.Canvas.TextOut((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
END SELECT
ELSE
SELECT CASE .UnDockStyle
CASE 0
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(0,0,.Canvas.Width, .Canvas.Height, -2147483632)
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.Line(3,12,.Canvas.Width - 4, 12, -2147483632)
.Canvas.Line(3,14,.Canvas.Width - 4, 14, -2147483632)
.Canvas.Line(3,16,.Canvas.Width - 4, 16, -2147483632)
.Canvas.FillRect((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 - 5,12, (.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2 + .Canvas.TextWidth(.CAPTION) + 5, 17, -2147483633)
.Canvas.TextOut((.Canvas.Width - .Canvas.TextWidth(.CAPTION)) / 2,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.Canvas.FillRect(.Canvas.Width - 16 - 10, 12, .Canvas.Width - 16 - 10 + 23, .Canvas.Width - 16 - 10 + 16, -2147483633)
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 1
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(0,0,.Canvas.Width, .Canvas.Height, -2147483632)
.Canvas.Rectangle(1,1,.Canvas.Width - 1, .Canvas.Height - 1, -2147483632)
.Canvas.Rectangle(2,2,.Canvas.Width - 2, .Canvas.Height - 2, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.FillRect(5,5,.Canvas.Width - 5, 23, .ST1_TitleBackground)
.Canvas.TextOut(7,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 2
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Rectangle(0,0,.Canvas.Width, .Canvas.Height, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.TextOut(7,5 + (18 - .Canvas.TextHeight(.CAPTION)) / 2,.CAPTION, .TitleColor, -1)
FOR I = 1 TO (.Canvas.Width - .Canvas.TextWidth(.CAPTION) - 14) / 4
.Canvas.Draw(7 + .Canvas.TextWidth(.CAPTION) + 4 * I, 10,.TempImg.BMP)
NEXT
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.Canvas.FillRect(.Canvas.Width - 16 - 10, 6, .Canvas.Width - 16 - 10 + 23, .Canvas.Width - 16 - 10 + 16, -2147483633)
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, &H4000)
END IF
CASE 3
.Client.Align = 0
.Client.Top = 3
.Client.Left = 15
.Client.Width = .Panel.Width - 20
.Client.Height = .Panel.Height - 6
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .Canvas.Width
.TempRect.bottom = .Canvas.Height
DrawEdge(.Canvas.Handle, THIS.TempRect, &H1 OR &H8, &H1 OR &H2 OR &H4 OR &H8 OR &H8000)
.Canvas.Font.AddStyles(0)
.Canvas.Line(5,3,5,.Canvas.Height - 3, -2147483632)
.Canvas.Line(7,3,7,.Canvas.Height - 3, -2147483632)
.Canvas.Line(9,3,9,.Canvas.Height - 3, -2147483632)
CASE 4
.Client.Align = 0
.Client.Top = 3
.Client.Left = 15
.Client.Width = .Panel.Width - 20
.Client.Height = .Panel.Height - 6
.Client.BevelOuter = 0
.Canvas.Rectangle(0,0,.Canvas.Width, .Canvas.Height, -2147483632)
.Canvas.Rectangle(1,1,.Canvas.Width - 1, .Canvas.Height - 1, -2147483632)
.Canvas.Font.AddStyles(0)
.Canvas.Draw(5, (.Canvas.Height - (.TempImg.Height * 2)) / 2,.TempImg.BMP)
.Canvas.Draw(5, (.Canvas.Height - (.TempImg.Height * 2 )) / 2 + 12,.TempImg.BMP)
FOR I = 0 TO ((.Canvas.Height - 8)/ 12)
.Canvas.Draw(5, I * 12 + 4,.TempImg.BMP)
NEXT
CASE 5
.Client.Align = 0
.Client.Top = 3
.Client.Left = 14
.Client.Width = .Panel.Width - 17
.Client.Height = .Panel.Height - 6
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .Canvas.Width
.TempRect.bottom = .Canvas.Height
DrawEdge(.Canvas.Handle, THIS.TempRect, &H1 OR &H5, &H1 OR &H2 OR &H4 OR &H8)
.Canvas.Font.AddStyles(0)
.Canvas.Line(5,4,5,.Canvas.Height - 5, -2147483628)
.Canvas.Pset(6,4, -2147483628)
.Canvas.Line(7,4,7,.Canvas.Height - 5, -2147483632)
.Canvas.Pset(6,.Canvas.Height - 5, -2147483632)
CASE 6
.UndockStyle = 1
.Canvas.Repaint
CASE 10
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .Canvas.Width
.TempRect.bottom = .Canvas.Height
DrawEdge(.Canvas.Handle, THIS.TempRect, &H1 OR &H5, &H1 OR &H2 OR &H4 OR &H8)
.Client.Align = 0
.Client.Top = 25
.Client.Left = 5
.Client.Width = .Panel.Width - 10
.Client.Height = .Panel.Height - 30
.Canvas.Font.AddStyles(0)
.TempRect.left = 4
.TempRect.top = 4
.TempRect.right = .Canvas.Width - 5
.TempRect.bottom = 24
DrawCaption(.UndockedForm.Handle, .Canvas.Handle, THIS.TempRect, &H1 OR &H8)
IF .CanClose = 0 THEN
.CloseButton.Width = 0
.CloseButton.Height = 0
ELSE
.CloseButton.Left = .Canvas.Width - 16 - 6
.CloseButton.Top = 7
.CloseButton.Width = 16
.CloseButton.Height = 14
.CloseButton.FillRect(0,0,16,16,-2147483633)
.TempRect.left = 0
.TempRect.top = 0
.TempRect.right = .CloseButton.Width
.TempRect.bottom = .CloseButton.Height
DrawFrameControl(.CloseButton.Handle, THIS.TempRect,1, 0)
END IF
END SELECT
END IF
IF .OnPaint <> 0 THEN CALLFUNC .OnPaint
END WITH : END EVENT
EVENT UndockedForm.OnShow : WITH THIS
END WITH : END EVENT
EVENT UndockedForm.OnClose (Action AS INTEGER) : WITH THIS
IF .ByProg = 0 AND .CanClose = 0 THEN
Action = 0
ELSE
IF .CanClose = 1 AND .ByProg = 0 THEN
IF .OnClose <> 0 AND .Closed = 0 THEN CALLFUNC .OnClose
.Closed = 1
END IF
.ByProg = 0
END IF
END WITH : END EVENT
EVENT Canvas.OnMouseDown (BTN AS INTEGER, X AS INTEGER, Y AS INTEGER): WITH THIS
IF BTN = 1 THEN EXIT EVENT
IF .Docked = 0 AND .Sizeable = 1 THEN
IF X > -1 AND X < 4 AND Y > - 1 AND Y < 4 THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_ulsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > -1 AND X < 4 AND Y > 3 AND Y < .Canvas.Height - 4 THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_lsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > -1 AND X < 4 AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_dlsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > 3 AND X < .Canvas.Width - 4 AND Y > - 1 AND Y < 4 THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_usize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > - 1 AND Y < 4 THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_ursize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > 3 AND Y < .Canvas.Height - 4 THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_rsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_drsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
ELSEIF X > 3 AND X < .Canvas.Width - 4 AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
ReleaseCapture
SendMessage(.UndockedForm.Handle, wm_syscommand, sc_dsize, 0)
.UndockedWidth = .UndockedForm.Width
.UndockedHeight = .UndockedForm.Height
END IF
END IF
IF IIF(.Docked > 0,.DockStyle,.UnDockStyle) < 3 OR IIF(.Docked > 0,.DockStyle,.UnDockStyle) > 9 THEN
IF X > 4 AND X < .Canvas.Width - 4 AND Y > 3 AND Y < 24 AND .Locked = 0 THEN
.MouseDown = 1
.PrevX = X
.PrevY = Y
.CaptureHandle = GetCapture
END IF
ELSE
IF X > 4 AND X < 15 AND Y > 3 AND Y < .Canvas.Height - 1 AND .Locked = 0 THEN
.MouseDown = 1
.PrevX = X
.PrevY = Y
.CaptureHandle = GetCapture
END IF
END IF
END WITH : END EVENT
EVENT Canvas.OnMouseUp (BTN AS INTEGER, X AS INTEGER, Y AS INTEGER): WITH THIS
IF btn = 0 THEN
.MouseDown = 0
.TempMovedOnce = 0
END IF
END WITH : END EVENT
EVENT Canvas.OnMouseMove (X AS INTEGER, Y AS INTEGER): WITH THIS
IF .MouseDown = 0 THEN
IF IIF(.Docked > 0,.DockStyle,.UnDockStyle) < 3 OR IIF(.Docked > 0,.DockStyle,.UnDockStyle) > 9 THEN
IF X > 4 AND X < .Canvas.Width - 4 AND Y > 3 AND Y < 24 AND .Locked = 0 THEN
.Canvas.Cursor = .DragCursor
ELSE
.Canvas.Cursor = 0
END IF
ELSE
IF X > 4 AND X < 15 AND Y > 3 AND Y < .Canvas.Height - 1 AND .Locked = 0 THEN
.Canvas.Cursor = .DragCursor
ELSE
.Canvas.Cursor = 0
END IF
END IF
IF .Docked = 0 AND .Sizeable = 1 THEN
IF X > -1 AND X < 4 AND Y > - 1 AND Y < 4 THEN
.Canvas.Cursor = -8
ELSEIF X > -1 AND X < 4 AND Y > 3 AND Y < .Canvas.Height - 4 THEN
.Canvas.Cursor = -9
ELSEIF X > -1 AND X < 4 AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
.Canvas.Cursor = -6
ELSEIF X > 3 AND X < .Canvas.Width - 4 AND Y > - 1 AND Y < 4 THEN
.Canvas.Cursor = -7
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > - 1 AND Y < 4 THEN
.Canvas.Cursor = -6
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > 3 AND Y < .Canvas.Height - 4 THEN
.Canvas.Cursor = -9
ELSEIF X > .Canvas.Width - 5 AND X < .Canvas.Width AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
.Canvas.Cursor = -8
ELSEIF X > 3 AND X < .Canvas.Width - 4 AND Y > .Canvas.Height - 5 AND Y < .Canvas.Height THEN
.Canvas.Cursor = -7
END IF
END IF
ELSE
.TempPoint.X = 0
.TempPoint.Y = 0
ClientToScreen(.Handle, .TempPoint)
.TempPoint2.X = 0
.TempPoint2.Y = 0
ClientToScreen(.AltPanel.Handle, .TempPoint2)
IF (Screen.MOUSEX - .PrevX > .TempPoint.X + 30 OR Screen.MOUSEY - .PrevY > .TempPoint.Y + 30 OR Screen.MOUSEX - .PrevX < .TempPoint.X - 30 OR Screen.MOUSEY - .PrevY < .TempPoint.Y - 30) _
AND (.Style <> 1 OR (.Style = 1 AND (Screen.MOUSEX - .PrevX > .TempPoint2.X + 30 OR Screen.MOUSEY - .PrevY > .TempPoint2.Y + 30 OR Screen.MOUSEX - .PrevX < .TempPoint2.X - 30 OR Screen.MOUSEY - .PrevY < .TempPoint2.Y - 30))) THEN
.UndockedForm.Left = Screen.MOUSEX - .PrevX
.UndockedForm.Top = Screen.MOUSEY - .PrevY
.UndockedForm.Width = .UndockedWidth
.UndockedForm.Height = .UndockedHeight
IF .TempMovedOnce = 0 AND .Align = 4 THEN
.TempWidth = .Width
.Width = 0
.Visible = 1
.Visible = 0
.Width = .TempWidth
Super.Left = Super.Left - .Width
.TempMovedOnce = 1
IF .AltAlign = 0 THEN
.AltPanel.Align = 3
.AltPanel.Width = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Width = .TempWidth
END IF
ELSEIF .TempMovedOnce = 0 AND .Align = 3 THEN
.TempWidth = .Width
.Width = 0
.Visible = 1
.Visible = 0
.Width = .TempWidth
.TempMovedOnce = 1
IF .AltAlign = 0 THEN
.AltPanel.Align = 4
.AltPanel.Width = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Width = .TempWidth
.AltPanel.Left = .AltPanel.Left - .Width
END IF
ELSEIF .TempMovedOnce = 0 AND .Align = 1 THEN
.TempWidth = .Height
.Height = 0
.Visible = 1
.Visible = 0
.Height = .TempWidth
.TempMovedOnce = 1
IF .AltAlign = 0 THEN
.AltPanel.Align = 2
.AltPanel.Height = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Height = .TempWidth
.AltPanel.Top = .AltPanel.Top - .Height
END IF
ELSEIF .TempMovedOnce = 0 AND .Align = 2 THEN
.TempWidth = .Height
.Height = 0
.Visible = 1
.Visible = 0
.Height = .TempWidth
Super.Top = Super.Top - .Height
.TempMovedOnce = 1
IF .AltAlign = 0 THEN
.AltPanel.Align = 1
.AltPanel.Height = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Height = .TempWidth
END IF
ELSEIF .TempMovedOnce = 0 AND .Align = 5 AND .AltAlign <> 0 THEN
.TempMovedOnce = 1
.AltPanel.Align = 1
.AltPanel.Height = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Height = .TempWidth
END IF
IF .AltAlign <> 0 THEN
.AltPanel.Align = .AltAlign
IF .TempMovedOnce = 1 AND .AltPanel.Align = 4 THEN
.TempWidth = .Width
.AltPanel.Width = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Width = .TempWidth
.AltPanel.Left = .AltPanel.Left - .Width
.TempMovedOnce = 2
END IF
IF .TempMovedOnce = 1 AND .AltPanel.Align = 3 THEN
.TempWidth = .Width
.AltPanel.Width = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Width = .TempWidth
.TempMovedOnce = 2
END IF
IF .TempMovedOnce = 1 AND .AltPanel.Align = 1 THEN
.TempWidth = .Height
.AltPanel.Height = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Height = .TempWidth
.TempMovedOnce = 2
END IF
IF .TempMovedOnce = 1 AND .AltPanel.Align = 2 THEN
.TempWidth = .Height
.AltPanel.Height = 0
.AltPanel.Visible = 1
.AltPanel.Visible = 0
.AltPanel.Height = .TempWidth
.AltPanel.Top = .AltPanel.Top - .Height
.TempMovedOnce = 2
END IF
END IF
IF .Docked = 1 THEN
.UndockedForm.Show
.Panel.PARENT = .UndockedForm
ReleaseCapture
SetCapture (.Panel.Handle)
.Docked = 0
.AltDock = 0
IF .OnDock <> 0 THEN CALLFUNC (.OnDock, 0, 0)
END IF
.Visible = 0
.AltPanel.Visible = 0
END IF
IF .Docked = 0 THEN
.UndockedForm.Left = Screen.MOUSEX - .PrevX
.UndockedForm.Top = Screen.MOUSEY - .PrevY
IF .UndockedForm.Left > .TempPoint.x - 29 AND .UndockedForm.Left < .TempPoint.x + 29 AND .UndockedForm.Top > .TempPoint.y - 29 AND .UndockedForm.Top < .TempPoint.y + 29 THEN
.Docked = 1
.Visible = 1
.Panel.PARENT = THIS
SetCapture (.Panel.Handle)
.ByProg = 1
IF .OnDock <> 0 THEN CALLFUNC (.OnDock, 1, 0)
.AltDock = 0
.UndockedForm.CLOSE
END IF
IF .Style = 1 THEN
.TempPoint.X = 0
.TempPoint.Y = 0
ClientToScreen(.AltPanel.Handle, .TempPoint)
IF .UndockedForm.Left > .TempPoint.x - 29 AND .UndockedForm.Left < .TempPoint.x + 29 AND .UndockedForm.Top > .TempPoint.y - 29 AND .UndockedForm.Top < .TempPoint.y + 29 THEN
.Docked = 1
.AltPanel.Visible = 1
.Panel.PARENT = .AltPanel
SetCapture (.Panel.Handle)
.ByProg = 1
IF .OnDock <> 0 THEN CALLFUNC (.OnDock, 1, 1)
.AltDock = 1
.UndockedForm.CLOSE
END IF
END IF
END IF
END IF
END WITH : END EVENT
CONSTRUCTOR
UndockedHeight = 400
UndockedWidth = 170
Docked = 1
Canvas.Align = 5
Canvas.PARENT = THIS.Panel
BevelOuter = 0
Panel.BevelOuter = 0
Panel.Align = 5
Align = 3
AltPanel.Align = 4
AltPanel.Visible = 0
AltPanel.BevelOuter = 0
AltPanel.PARENT = THIS
UndockedForm.BorderStyle = 0
Client.PARENT = THIS.Panel
Client.Top = 25
Client.Left = 5
Client.Width = THIS.Panel.Width - 10
Client.Height = THIS.Panel.Height - 30
Client.BevelOuter = 2
Panel.PARENT = THIS
CloseButton.PARENT = THIS.Panel
CloseButton.Width = 0
CloseButton.Height = 0
TempImg.FillRect(0,0,THIS.TempImg.Width, THIS.TempImg.Height, -2147483633)
TempImg.FillRect(1,1,3,3,-2147483628)
TempImg.FillRect(1,5,3,7,-2147483628)
TempImg.FillRect(1,9,3,11,-2147483628)
TempImg.FillRect(0,0,2,2,-2147483632)
TempImg.FillRect(0,4,2,6,-2147483632)
TempImg.FillRect(0,8,2,10,-2147483632)
TempImg.Transparent = 1
TempImg.Width = 3
TempImg.Height = 11
DragCursor = -21
ST1_TitleBackground = -2147483632
TitleColor = 0
END CONSTRUCTOR
END TYPE
$ENDIF
DECLARE SUB BFMoveMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory" (byref Destination AS LONG, byref Source AS BLENDFUNCTION, Length AS LONG)
$DEFINE tmAlpha -1
DEFLNG AlphaPreMultiplyArray(0 TO 46) = { _
&H000000C8, &H85087D8B, &H9C840FFF, &H8B000000, _
&H67F70447, &H0FC08508, &H00009584, &H8BC18900, _
&HFF85147F, &H0081840F, &H458B0000, &H79C08514, _
&H035F8A2C, &H1B74DB84, &H74FFFB80, &H02478A16, _
&H6788E3F6, &H01478A02, &H6788E3F6, &HF6078A01, _
&H832788E3, &H754904C7, &HEBC031D8, &H0D078B5A, _
&HFF000000, &HC7830789, &HF1754904, &H850C458B, _
&H8B4474C0, &H478B087D, &H0867F704, &H7F8BC189, _
&H14458B14, &H0475C085, &H09EB1F8B, &H81105D8B, _
&H000000CB, &H39078BFF, &HC70675D8, &H00000007, _
&H04C78300, &H31EE7549, &HB80CEBC0, &H000001E7, _
&H3FB805EB, &HC9000020, &H000010C2 }
TYPE QBitmapEx EXTENDS QBITMAP
PRIVATE:
info AS TBITMAP
hpen AS LONG
hbrush AS LONG
oldpen AS LONG
oldbrush AS LONG
PUBLIC:
PenStyle AS LONG
PenSize AS INTEGER
SUB DrawIco(left AS INTEGER,top AS INTEGER,width AS INTEGER,height AS INTEGER,handle AS LONG)
DrawIconEx(QBitmapEx.handle,left,top,handle,width,height,0,0,DI_NORMAL)
END SUB
SUB CopyToClipboard
DIM hBitmap AS INTEGER
DIM bitmap AS QBITMAP
bitmap.bmp=THIS.bmp
bitmap.pixelformat=0
hBitmap=GetCurrentObject(bitmap.handle,OBJ_BITMAP)
clipboard.OPEN
clipboard.clear
clipboard.SetAsHandle(CF_BITMAP,hBitmap)
clipboard.CLOSE
END SUB
SUB PasteFromClipboard(x AS SHORT,y AS SHORT)
DIM hDC AS INTEGER
DIM hBitmap AS INTEGER
DIM hOldBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
hDC=CreateCompatibleDC(QBitmapEx.handle)
hOldBitmap=SelectObject(hDC,hBitmap)
BitBlt(QBitmapEx.handle,x,y,QBitmapEx.info.bmwidth,QBitmapEx.info.bmheight,hDC,0,0,SRCCOPY)
SelectObject(hDC,hOldBitmap)
DeleteDC(hDC)
END IF
END SUB
FUNCTION GetWidthClipboard AS INTEGER
DIM hBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
result=QBitmapEx.info.bmwidth
END IF
END FUNCTION
FUNCTION GetHeightClipboard AS INTEGER
DIM hBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QBitmapEx.info),QBitmapEx.info)
result=QBitmapEx.info.bmheight
END IF
END FUNCTION
FUNCTION CanPaste() AS LONG
result=clipboard.hasformat(CF_BITMAP)
END FUNCTION
FUNCTION Pointer AS LONG
DIM hBM AS LONG
DIM hObj AS LONG
DIM lpInfo AS STRING*24
IF QBitmapEx.Width = 0 OR QBitmapEx.Height = 0 THEN
RESULT = 0
GOTO EXIT_FUNCTION
END IF
hBM = GetCurrentObject(QBitmapEx.Handle, OBJ_BITMAP)
IF hBM = 0 THEN RESULT = 0 : GOTO EXIT_FUNCTION
hObj = GetObject(hBM, SIZEOF(QBitmapEx.Info), QBitmapEx.Info)
IF hObj = 0 THEN RESULT = 0 : GOTO EXIT_FUNCTION
RESULT = QBitmapEx.Info.bmBits
EXIT_FUNCTION:
END FUNCTION
SUB circle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QBitmapEx.hbrush=GetStockObject(NULL_BRUSH)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
Ellipse(QBitmapEx.handle,x1,y1,x2,y2)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
END SUB
SUB circleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.hbrush=CreateSolidBrush(fill)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
Ellipse(QBitmapEx.handle,x1,y1,x2,y2)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
DeleteObject(QBitmapEx.hbrush)
END SUB
SUB rectangle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QBitmapEx.hbrush=GetStockObject(NULL_BRUSH)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
Rectangle(QBitmapEx.handle,x1,y1,x2,y2)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
END SUB
SUB RoundRect(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG)
QBitmapEx.hbrush=GetStockObject(NULL_BRUSH)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
RoundRect(QBitmapEx.handle,x1,y1,x2,y2,x3,y3)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
END SUB
SUB RoundRectFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG,fill AS LONG)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.hbrush=CreateSolidBrush(fill)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
RoundRect(QBitmapEx.handle,x1,y1,x2,y2,x3,y3)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
DeleteObject(QBitmapEx.hbrush)
END SUB
SUB rectangleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.hbrush=CreateSolidBrush(fill)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
Rectangle(QBitmapEx.handle,x1,y1,x2,y2)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hpen)
DeleteObject(QBitmapEx.hbrush)
END SUB
SUB line(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QBitmapEx.hpen=CreatePen(QBitmapEx.PenStyle,QBitmapEx.PenSize,c)
QBitmapEx.oldpen=SelectObject(QBitmapEx.handle,QBitmapEx.hpen)
MoveToEx(QBitmapEx.handle,x1,y1,0)
LineTo(QBitmapEx.handle,x2,y2)
SelectObject(QBitmapEx.handle,QBitmapEx.oldpen)
DeleteObject(QBitmapEx.hpen)
END SUB
SUB FillSurface(x AS INTEGER,y AS INTEGER,c AS LONG)
QBitmapEx.hbrush=CreateSolidBrush(c)
QBitmapEx.oldbrush=SelectObject(QBitmapEx.handle,QBitmapEx.hbrush)
ExtFloodFill(QBitmapEx.handle,x,y,QBitmapEx.pixel(x,y),1)
SelectObject(QBitmapEx.handle,QBitmapEx.oldbrush)
DeleteObject(QBitmapEx.hbrush)
END SUB
SUB InvertColor(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
PatBlt(QBitmapEx.handle,x,y,Width,Height,DSTINVERT)
END SUB
SUB mirror(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
StretchBlt(QBitmapEx.handle,x+width,y,-Width,Height,QBitmapEx.handle,x,y,Width,Height,SRCCOPY)
END SUB
SUB flip(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
StretchBlt(QBitmapEx.handle,x,y+height,Width,-Height,QBitmapEx.handle,x,y,Width,Height,SRCCOPY)
END SUB
SUB LoadOtherImage(FileName AS STRING,Progress AS boolean,Language AS STRING)
IF NViewLibPresent THEN
DIM hDC AS INTEGER
DIM hBitmap AS LONG
DIM hOldBitmap AS INTEGER
DIM FilExts AS STRING
FilExts = UCASE$(RIGHT$(FileName, LEN(FileName) - RINSTR(FileName, ".") + 1))
IF (NViewLibPresent = 2) AND INSTR(".JPG.JPEG.JIF.ICO", FilExts) THEN
THIS.PixelFormat = pf24bit
hBitmap = JpegDLL_LoadImageFile(0&, FileName)
THIS.width=JpegDLL_ImageWidth(hBitmap)
THIS.height=JpegDLL_ImageHeight(hBitmap)
ELSE
THIS.PixelFormat = pf24bit
NViewSetLanguage(language)
hBitmap=NViewLoad(FileName,Progress)
THIS.width=NViewGetWidth()
THIS.height=NViewGetHeight()
END IF
hDC = 0
IF hBitmap<>0 THEN
hDC=CreateCompatibleDC(QBitmapEx.handle)
hOldBitmap=SelectObject(hDC,hBitmap)
BitBlt(QBitmapEx.handle,0,0,THIS.width,THIS.height,hDC,0,0,SRCCOPY)
SelectObject(hDC,hOldBitmap)
DeleteDC(hDC)
DeleteObject(hBitmap)
END IF
END IF
END SUB
SUB SaveAsJpg(FileName AS STRING,Quality AS INTEGER)
DIM hBitmap AS INTEGER
DIM path AS STRING
DIM File AS STRING
DIM bitmap AS QBITMAP
IF NViewLibPresent AND (FileName<>"" ) THEN
path=LEFT$(FileName,RINSTR(FileName,"\"))
IF DIREXISTS(path) THEN
File=path+"temp.bmp"
bitmap.pixelformat = pf16bit
bitmap.width=THIS.width
bitmap.height=THIS.height
bitmap.draw(0,0,THIS.bmp)
bitmap.pixelformat = pf24bit
bitmap.SaveToFile(File)
hBitmap=NViewLoad(File,false)
NViewSaveAsJPG(Quality,FileName)
DeleteObject(hBitmap)
KILL File
END IF
END IF
END SUB
FUNCTION AlphaBlend(BMPDest AS QBITMAP, BMPSource AS QBITMAP, PercentBlend AS SINGLE) AS LONG
DIM AlphaConst AS BYTE
DIM BF AS BLENDFUNCTION
DIM BFpointer AS LONG
DIM Rtn AS LONG
DIM aFormat AS LONG
QBitmapEx.BMP = BMPDest.BMP
IF PercentBlend < 0 THEN
aFormat = AC_SRC_ALPHA
ELSE
aFormat = 0
END IF
AlphaConst= ROUND(ABS(255 * PercentBlend))
WITH BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = AlphaConst
.AlphaFormat = aFormat
END WITH
BFMoveMemory(BFpointer, BF, SIZEOF(BF))
IF aFormat = AC_SRC_ALPHA THEN
DIM BMPTemp AS QBITMAP
BMPTemp.BMP = BMPSource.BMP
DIM bmInfo AS TBITMAP
DIM hBM AS LONG
DIM hObj AS LONG
IF BMPSource.PixelFormat = pf32bit THEN
hBM = GetCurrentObject(BMPTemp.Handle, OBJ_BITMAP)
hObj = GetObject(hBM, SIZEOF(bmInfo), bmInfo)
Rtn = CallWindowProc(VARPTR(AlphaPreMultiplyArray(0)), bmInfo, 0, 0, -1)
ELSE
BMPTemp.PixelFormat = pf32bit
hBM = GetCurrentObject(BMPTemp.Handle, OBJ_BITMAP)
hObj = GetObject(hBM, SIZEOF(bmInfo), bmInfo)
Rtn = CallWindowProc(VARPTR(AlphaPreMultiplyArray(0)), bmInfo, _
BMPSource.Transparent, BMPSource.TransparentColor, BMPSource.TransparentMode)
END IF
IF Rtn THEN
SetLastError(Rtn)
Rtn = 0
ELSE
Rtn = 1
END IF
Rtn = AlphaBlend(QBitmapEx.Handle, 0, 0, QBitmapEx.Width, QBitmapEx.Height, _
BMPTemp.Handle, 0, 0, BMPTemp.Width, BMPTemp.Height, BFPointer)
DeleteObject(hBM)
ELSE
Rtn = AlphaBlend(QBitmapEx.Handle, 0, 0, QBitmapEx.Width, _
QBitmapEx.Height, BMPSource.Handle, 0, 0, _
BMPSource.Width, BMPSource.Height, BFPointer)
END IF
RESULT = Rtn
END FUNCTION
CONSTRUCTOR
PenStyle=PS_SOLID
PenSize=1
END CONSTRUCTOR
END TYPE
TYPE QImageEx EXTENDS QIMAGE
PRIVATE:
bitmap AS QBITMAP
PUBLIC:
SUB CopyToClipboard(rect AS QRECT)
DIM hDC AS INTEGER
DIM hBitmap AS INTEGER
DIM hOldBitmap AS INTEGER
DIM width AS INTEGER
DIM height AS INTEGER
width=rect.right-rect.left
height=rect.bottom-rect.top
hDC=CreateCompatibleDC(QImageEx.handle)
hBitmap=CreateCompatibleBitmap(QImageEx.handle,width,height)
hOldBitmap=SelectObject(hDC,hBitmap)
BitBlt(hDC,0,0,width,height,QImageEx.handle,rect.left,rect.top,SRCCOPY)
clipboard.OPEN
clipboard.clear
clipboard.SetAsHandle(CF_BITMAP,hBitmap)
clipboard.CLOSE
SelectObject(hDC,hOldBitmap)
DeleteDC(hDC)
DeleteObject(hBitmap)
END SUB
SUB PasteFromClipboard
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
QImageEx.handle=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
END IF
END SUB
SUB LoadFromFile(FileName AS STRING,width AS SHORT,height AS SHORT,real AS boolean)
IF real THEN
QImageEx.bitmap.bmp=FileName
QImageEx.handle=LoadImage(Application.hInstance,fileName,0,QImageEx.bitmap.width,QImageEx.bitmap.height,&H10)
ELSE
QImageEx.handle=LoadImage(Application.hInstance,fileName,0,width,height,&H10)
END IF
END SUB
FUNCTION CanPaste AS boolean
result=clipboard.hasformat(CF_BITMAP)
END FUNCTION
SUB LoadOtherImage(FileName AS STRING,Progress AS boolean,Language AS STRING)
DIM i AS INTEGER
DIM FilExts AS STRING
IF NViewLibPresent THEN
IF FileName<>"" AND FILEEXISTS(FileName) THEN
i = INSTR(LEN(FileName)-5, FileName, ".")
FilExts = UCASE$(MID$(FileName, i, 4))
IF (NViewLibPresent = 2) AND INSTR(".JPG.JPEG.JIF.ICO", FilExts) THEN
THIS.handle = JpegDLL_LoadImageFile(0&, FileName)
THIS.width = JpegDLL_ImageWidth(THIS.handle)
THIS.height = JpegDLL_ImageHeight(THIS.handle)
ELSE
NViewSetLanguage(language)
THIS.handle = NViewLoad(FileName,Progress)
THIS.width = NViewGetWidth
THIS.height = NViewGetHeight
END IF
END IF
END IF
END SUB
END TYPE
TYPE QCanvasEx EXTENDS QCANVAS
PRIVATE:
hpen AS LONG
hbrush AS LONG
oldpen AS LONG
oldbrush AS LONG
PUBLIC:
info AS TBITMAP
MixMode AS LONG
PenStyle AS LONG
PenSize AS INTEGER
SUB DrawIco(left AS INTEGER,top AS INTEGER,width AS INTEGER,height AS INTEGER,handle AS LONG)
DrawIconEx(QCanvasEx.handle,left,top,handle,width,height,0,0,DI_NORMAL)
END SUB
SUB CopyToClipboard(rect AS QRECT)
DIM hDC AS INTEGER
DIM hBitmap AS INTEGER
DIM hOldBitmap AS INTEGER
DIM width AS INTEGER
DIM height AS INTEGER
width=rect.right-rect.left
height=rect.bottom-rect.top
hDC=CreateCompatibleDC(QCanvasEx.handle)
hBitmap=CreateCompatibleBitmap(QCanvasEx.handle,width,height)
hOldBitmap=SelectObject(hDC,hBitmap)
BitBlt(hDC,0,0,width,height,QCanvasEx.handle,rect.left,rect.top,SRCCOPY)
clipboard.OPEN
clipboard.clear
clipboard.SetAsHandle(CF_BITMAP,hBitmap)
clipboard.CLOSE
SelectObject(hDC,hOldBitmap)
DeleteDC(hDC)
DeleteObject(hBitmap)
END SUB
SUB PasteFromClipboard(x AS SHORT,y AS SHORT)
DIM hDC AS INTEGER
DIM hBitmap AS INTEGER
DIM hOldBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
hDC=CreateCompatibleDC(QCanvasEx.handle)
hOldBitmap=SelectObject(hDC,hBitmap)
BitBlt(QCanvasEx.handle,x,y,QCanvasEx.info.bmwidth,QCanvasEx.info.bmheight,hDC,0,0,SRCCOPY)
SelectObject(hDC,hOldBitmap)
DeleteDC(hDC)
END IF
END SUB
FUNCTION GetWidthClipboard AS INTEGER
DIM hBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
result=QCanvasEx.info.bmwidth
END IF
END FUNCTION
FUNCTION GetHeightClipboard AS INTEGER
DIM hBitmap AS INTEGER
IF clipboard.hasformat(CF_BITMAP) THEN
clipboard.OPEN
hBitmap=clipboard.GetAsHandle(CF_BITMAP)
clipboard.CLOSE
GetObject(hBitmap,SIZEOF(QCanvasEx.info),QCanvasEx.info)
result=QCanvasEx.info.bmheight
END IF
END FUNCTION
FUNCTION CanPaste AS boolean
result=clipboard.hasformat(CF_BITMAP)
END FUNCTION
SUB circle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QCanvasEx.hbrush=GetStockObject(NULL_BRUSH)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
Ellipse(QCanvasEx.handle,x1,y1,x2,y2)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
END SUB
SUB circleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.hbrush=CreateSolidBrush(fill)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
Ellipse(QCanvasEx.handle,x1,y1,x2,y2)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
DeleteObject(QCanvasEx.hbrush)
END SUB
SUB rectangle(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QCanvasEx.hbrush=GetStockObject(NULL_BRUSH)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
Rectangle(QCanvasEx.handle,x1,y1,x2,y2)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
END SUB
SUB RoundRect(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG)
QCanvasEx.hbrush=GetStockObject(NULL_BRUSH)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
RoundRect(QCanvasEx.handle,x1,y1,x2,y2,x3,y3)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
END SUB
SUB RoundRectFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,x3 AS INTEGER,y3 AS INTEGER,c AS LONG,fill AS LONG)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.hbrush=CreateSolidBrush(fill)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
RoundRect(QCanvasEx.handle,x1,y1,x2,y2,x3,y3)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
DeleteObject(QCanvasEx.hbrush)
END SUB
SUB rectangleFilled(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG,fill AS LONG)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.hbrush=CreateSolidBrush(fill)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
Rectangle(QCanvasEx.handle,x1,y1,x2,y2)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hpen)
DeleteObject(QCanvasEx.hbrush)
END SUB
SUB line(x1 AS INTEGER,y1 AS INTEGER,x2 AS INTEGER,y2 AS INTEGER,c AS LONG)
QCanvasEx.hpen=CreatePen(QCanvasEx.PenStyle,QCanvasEx.PenSize,c)
QCanvasEx.oldpen=SelectObject(QCanvasEx.handle,QCanvasEx.hpen)
SetROP2(QCanvasEx.handle,QCanvasEx.mixmode)
MoveToEx(QCanvasEx.handle,x1,y1,0)
LineTo(QCanvasEx.handle,x2,y2)
SelectObject(QCanvasEx.handle,QCanvasEx.oldpen)
DeleteObject(QCanvasEx.hpen)
END SUB
SUB FillSurface(x AS INTEGER,y AS INTEGER,c AS LONG)
QCanvasEx.hbrush=CreateSolidBrush(c)
QCanvasEx.oldbrush=SelectObject(QCanvasEx.handle,QCanvasEx.hbrush)
ExtFloodFill(QCanvasEx.handle,x,y,QCanvasEx.pixel(x,y),1)
SelectObject(QCanvasEx.handle,QCanvasEx.oldbrush)
DeleteObject(QCanvasEx.hbrush)
END SUB
SUB TextOut(x AS INTEGER,y AS INTEGER,s AS STRING,fc AS LONG,bc AS LONG)
SetBkMode(QCanvasEx.handle,TRANSPARENT)
super.TextOut(x,y,s,fc,bc)
SetBkMode(QCanvasEx.handle,OPAQUE)
END SUB
SUB InvertColor(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
PatBlt(QCanvasEx.handle,x,y,Width,Height,DSTINVERT)
END SUB
SUB mirror(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
StretchBlt(QCanvasEx.handle,x+width,y,-Width,Height,QCanvasEx.handle,x,y,Width,Height,SRCCOPY)
END SUB
SUB flip(x AS INTEGER,y AS INTEGER,width AS INTEGER,height AS INTEGER)
StretchBlt(QCanvasEx.handle,x,y+height,Width,-Height,QCanvasEx.handle,x,y,Width,Height,SRCCOPY)
END SUB
CONSTRUCTOR
MixMode=R2_COPYPEN
PenStyle=PS_SOLID
PenSize=1
END CONSTRUCTOR
END TYPE
DECLARE SUB OnComError_EventTemplate (strErrorMessage AS STRING)
DECLARE SUB OnOpen_EventTemplate
DECLARE SUB OnClose_EventTemplate
DECLARE SUB OnWriteString_EventTemplate
DECLARE SUB OnReadString_EventTemplate
TYPE COMPORT EXTENDS QOBJECT
OnComError AS EVENT (OnComError_EventTemplate)
OnOpen AS EVENT (OnOpen_EventTemplate)
OnClose AS EVENT (OnClose_EventTemplate)
OnWriteString AS EVENT (OnWriteString_EventTemplate)
OnReadString AS EVENT (OnReadString_EventTemplate)
Handle AS LONG
Port AS STRING
BaudRate AS DWORD
DataBits AS BYTE
Parity AS BYTE
StopBits AS BYTE
ReadBufSize AS DWORD
WriteBufSize AS DWORD
BytesNotRead AS DWORD
BytesNotWritten AS DWORD
InQue AS DWORD PROPERTY SET GetInQue
OutQue AS DWORD PROPERTY SET GetOutQue
Connected AS BYTE
CONSTRUCTOR
Port = "COM1"
BaudRate = 9600
DataBits = 8
Parity = NOPARITY
StopBits = 1
ReadBufSize = 1024
WriteBufSize = 1024
BytesNotRead = 0
BytesNotWritten = 0
Connected = FALSE
END CONSTRUCTOR
PRIVATE:
FUNCTION FormatError AS STRING
DIM Buffer AS STRING
DIM lngRet AS LONG
Buffer=SPACE$(1024)
lngRet=FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, _
0, _
GetLastError(), _
LANG_NEUTRAL, _
Buffer, _
LEN(Buffer), _
0)
Result=LEFT$(Buffer,lngRet)
END FUNCTION
PRIVATE:
SUB GetCommStatus
DIM lngStatus AS LONG
DIM dwErrorFlags AS DWORD
DIM udtCommStat AS COMSTAT
lngStatus = ClearCommError(ComPort.Handle, _
dwErrorFlags, _
udtCommStat)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_CHANGING_PORTSETTINGS & ComPort.FormatError)
END IF
ELSE
ComPort.BytesNotWritten = udtCommStat.cbOutQue
ComPort.BytesNotRead = udtCommStat.cbInQue
ComPort.InQue = udtCommStat.cbInQue
ComPort.OutQue = udtCommStat.cbOutQue
END IF
END SUB
PROPERTY SET GetInQue(myVoid AS DWORD)
Comport.GetCommStatus
END PROPERTY
PROPERTY SET GetOutQue(myVoid AS DWORD)
Comport.GetCommStatus
END PROPERTY
PUBLIC:
SUB OPEN
DIM udtCommTimeOuts AS COMMTIMEOUTS
DIM udtDCB AS DCB
DIM lngStatus AS LONG
ComPort.Handle = CreateFile(COMPORT.Port, _
GENERIC_READ OR GENERIC_WRITE, _
FILE_SHARE_READ OR FILE_SHARE_WRITE, _
0&, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, _
0&)
IF ComPort.Handle = -1 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError,ERROR_OPEN_PORT & ComPort.FormatError)
END IF
GOTO EXIT_SUB
END IF
lngStatus = SetupComm(ComPort.Handle,_
ComPort.ReadBufSize,_
ComPort.WriteBufSize)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_PORT_BUFFERS & ComPort.FormatError)
END IF
GOTO EXIT_SUB
END IF
lngStatus = PurgeComm(ComPort.Handle,_
PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_PURGE_BUFFERS & ComPort.FormatError)
END IF
GOTO EXIT_SUB
END IF
udtCommTimeOuts.ReadIntervalTimeout = -1
udtCommTimeOuts.ReadTotalTimeoutMultiplier = 0
udtCommTimeOuts.ReadTotalTimeoutConstant = 1000
udtCommTimeOuts.WriteTotalTimeoutMultiplier = 0
udtCommTimeOuts.WriteTotalTimeoutMultiplier = 1000
lngStatus = SetCommTimeouts(ComPort.Handle,_
udtCommTimeOuts)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_TIMEOUTS & ComPort.FormatError)
END IF
GOTO EXIT_SUB
END IF
lngStatus = GetCommState (ComPort.Handle, udtDCB)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_RETRIEVE_PORTSETTINGS & ComPort.FormatError)
END IF
GOTO EXIT_SUB
END IF
udtDCB.BaudRate = ComPort.BaudRate
udtDCB.ByteSize = ComPort.DataBits
udtDCB.Parity = ComPort.Parity
udtDCB.StopBits = ComPort.StopBits
lngStatus = SetCommState (ComPort.Handle, udtDCB)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_CHANGING_PORTSETTINGS & ComPort.FormatError)
END IF
ELSE
ComPort.Connected = TRUE
IF ComPort.OnOpen > 0 THEN
CALLFUNC ComPort.OnOpen
END IF
END IF
EXIT_SUB:
END SUB
PUBLIC:
SUB PurgeIn ()
PurgeComm(ComPort.Handle, PURGE_RXABORT OR PURGE_RXCLEAR)
END SUB
SUB PurgeOut
PurgeComm(ComPort.Handle, PURGE_TXABORT OR PURGE_TXCLEAR)
END SUB
PUBLIC:
SUB CLOSE
DIM lngStatus AS LONG
lngStatus = CloseHandle (ComPort.Handle)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_CLOSING_PORT & ComPort.FormatError)
END IF
ELSE
ComPort.Connected = FALSE
IF ComPort.OnClose > 0 THEN
CALLFUNC ComPort.OnClose
END IF
END IF
END SUB
PUBLIC:
SUB WriteString (strData AS STRING, intWait AS INTEGER)
DIM lngStatus AS LONG
DIM dwBytesToWrite AS DWORD
DIM dwByesWritten AS DWORD
dwBytesToWrite=LEN(strData)
lngStatus = WriteFile(ComPort.Handle, _
strData, _
dwBytesToWrite, _
dwByesWritten, _
0&)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_WRITING_PORT & ComPort.FormatError)
END IF
ELSE
IF intWait THEN SLEEP.ms(intWait)
ComPort.GetCommStatus
IF Comport.BytesNotWritten = 0 THEN
IF ComPort.OnWriteString > 0 THEN
CALLFUNC ComPort.OnWriteString
END IF
ELSE
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_SENDING_DATA)
END IF
END IF
END IF
END SUB
PUBLIC:
FUNCTION ReadString (dwRdSize AS DWORD, intWait AS INTEGER) AS STRING
DIM lngStatus AS LONG
DIM dwBytesRead AS DWORD
DIM strReadBuffer AS STRING
strReadBuffer=SPACE$(ComPort.ReadBufSize)
lngStatus = ReadFile(Comport.Handle, _
strReadBuffer, _
dwRdSize, _
dwBytesRead, _
0&)
IF lngStatus = 0 THEN
IF ComPort.OnComError > 0 THEN
CALLFUNC (ComPort.OnComError, ERROR_READING_PORT & ComPort.FormatError)
END IF
ELSE
Result = LEFT$(strReadBuffer, dwBytesRead)
IF intWait THEN SLEEP.ms(intWait)
ComPort.GetCommStatus
IF ComPort.OnReadString > 0 THEN
CALLFUNC ComPort.OnReadString
END IF
END IF
END FUNCTION
END TYPE
$DEFINE QCOMPORT COMPORT
$IFNDEF __QMENU_INC
$DEFINE __QMENU_INC
DECLARE SUB QM_OnMouseHover_eventTemplate(Xpos AS LONG, Ypos AS LONG, Descript AS STRING)
DIM gRQ2_MeasureItem AS MEASUREITEMSTRUCT
DIM gRQ2_DrawItem AS DRAWITEMSTRUCT
TYPE QMenuEx EXTENDS QIMAGELIST
PUBLIC:
Font AS QFONT
MaskColor AS LONG
BackColor AS LONG
ForeColor AS LONG
DisabledColor AS LONG
HighLightColor AS LONG
HighLightTextColor AS LONG
Outline AS LONG
FontSize AS WORD PROPERTY SET Set_FontSize
Transparent AS INTEGER
TransparentColor AS INTEGER
OnMouseHover AS EVENT(QM_OnMouseHover_eventTemplate)
PRIVATE:
MenuParent AS LONG
Bmp AS QBITMAP
TextBMP AS QBITMAP
hWnd AS INTEGER
MyWndProc AS LONG
pOldProc AS LONG
flagWinProc AS LONG
image(1000) AS QBITMAP
descp(1000) AS STRING
DescripFlag AS WORD
LastMenu AS LONG
LastCount AS INTEGER
Margin AS INTEGER
WITH QmenuEx
SUB ShowDescription (wParam AS LONG, LParam AS LONG, ID AS LONG)
IF (lParam = 0) AND ((wParam AND &HFFFF) = &HFFFF) THEN
ELSE
CALLFUNC(.OnMouseHover, Screen.MOUSEX, Screen.MOUSEY, .descp(ID))
END IF
END SUB
SUB DrawText (clr AS INTEGER)
DIM S AS STRING
DIM I AS WORD
DIM tLeft AS LONG
DIM X AS INTEGER
DIM Y AS INTEGER
S=VARPTR$(gRQ2_DrawItem.itemData)
X=.width + .Margin
IF INSTR(S,"&")>0 THEN
.Font.AddStyles(2)
.bmp.Font=.Font
Y=((gRQ2_DrawItem.bottom-gRQ2_DrawItem.top)-.bmp.TextHeight(S))\2
.Font.DelStyles(2)
.bmp.Font=.Font
ELSE
Y=((gRQ2_DrawItem.bottom-gRQ2_DrawItem.top)-.bmp.TextHeight(S))\2
END IF
I=INSTR(S, "&")
IF I THEN
.bmp.TextOut(gRQ2_DrawItem.left+X,gRQ2_DrawItem.top+Y,LEFT$(S, I-1),clr,-1)
.Font.AddStyles(2)
.bmp.Font=.Font
.bmp.TextOut(gRQ2_DrawItem.left+X+.bmp.TextWidth(LEFT$(S, I-1)),gRQ2_DrawItem.top+Y,MID$(S, I+1, 1),clr,-1)
.Font.DelStyles(2)
.bmp.Font=.Font
S=S - "&"
.bmp.TextOut(gRQ2_DrawItem.left+X+.bmp.TextWidth(LEFT$(S, I)),gRQ2_DrawItem.top+Y,MID$(S, I+1, LEN(S)),clr,-1)
ELSE
.bmp.TextOut(gRQ2_DrawItem.left+X,gRQ2_DrawItem.top+Y,S,clr,-1)
END IF
END SUB
FUNCTION WindowProc (hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG, tmp AS LONG) AS LONG
DIM h AS LONG: h = .Height - 1
DIM S AS STRING
SELECT CASE uMsg
CASE WM_MEASUREITEM
MEMCPY(gRQ2_MeasureItem, lParam, SIZEOF(gRQ2_MeasureItem))
IF gRQ2_MeasureItem.CtlType = ODT_MENU THEN
S = VARPTR$(gRQ2_MeasureItem.itemData)
gRQ2_MeasureItem.itemWidth = LEN(S) * .Font.Size * 0.6 + .width + .Margin
gRQ2_MeasureItem.itemHeight = .Height + 3
MEMCPY(lParam, gRQ2_MeasureItem, SIZEOF(gRQ2_MeasureItem))
RESULT = -1
ELSE
QmenuEx.WindowProc = CallWindowProc(QmenuEx.pOldProc, hwnd, uMsg, wParam, lParam)
END IF
CASE WM_DRAWITEM
MEMCPY(gRQ2_DrawItem, lParam, SIZEOF(gRQ2_DrawItem))
IF gRQ2_DrawItem.CtlType = ODT_MENU THEN
QmenuEx.ShowDescription (wParam, LParam, gRQ2_DrawItem.itemID)
.Bmp.Handle = gRQ2_DrawItem.hDC
IF (ODS_SELECTED AND gRQ2_DrawItem.itemState) <> 0 THEN
.Bmp.FillRect(gRQ2_DrawItem.left+1,gRQ2_DrawItem.top,gRQ2_DrawItem.right,gRQ2_DrawItem.bottom, .HighLightColor)
.Bmp.Draw (gRQ2_DrawItem.left+1,gRQ2_DrawItem.top+1,.image(gRQ2_DrawItem.itemID).BMP)
IF .Outline THEN
.Bmp.Line (gRQ2_DrawItem.left,gRQ2_DrawItem.top,gRQ2_DrawItem.left+h,gRQ2_DrawItem.top, &HFFFFFF)
.Bmp.Line (gRQ2_DrawItem.left,gRQ2_DrawItem.top,gRQ2_DrawItem.left,gRQ2_DrawItem.top+h, &HFFFFFF)
.Bmp.Line (gRQ2_DrawItem.left,gRQ2_DrawItem.top+h,gRQ2_DrawItem.left+h+1,gRQ2_DrawItem.top+h, &H808080)
.Bmp.Line (gRQ2_DrawItem.left+h,gRQ2_DrawItem.top+h,gRQ2_DrawItem.left+h,gRQ2_DrawItem.top, &H808080)
END IF
IF (ODS_DISABLED AND gRQ2_DrawItem.itemState) <> 0 THEN
.DrawText(.DisabledColor)
ELSE
.DrawText(.HighLightTextColor)
END IF
ELSEIF(ODS_DISABLED AND gRQ2_DrawItem.itemState) <> 0 THEN
.bmp.FillRect(gRQ2_DrawItem.left,gRQ2_DrawItem.top,gRQ2_DrawItem.right,gRQ2_DrawItem.bottom,.BackColor)
.bmp.Draw(gRQ2_DrawItem.left+1,gRQ2_DrawItem.top+1, .image(gRQ2_DrawItem.itemID).BMP)
.DrawText(.DisabledColor)
ELSE
.Bmp.FillRect(gRQ2_DrawItem.left,gRQ2_DrawItem.top,gRQ2_DrawItem.right,gRQ2_DrawItem.bottom, .BackColor)
.Bmp.Draw(gRQ2_DrawItem.left+1,gRQ2_DrawItem.top+1,.image(gRQ2_DrawItem.itemID).BMP)
.DrawText(.ForeColor)
END IF
Result = -1
ELSE
QmenuEx.WindowProc = CallWindowProc(QmenuEx.pOldProc, hwnd, uMsg, wParam, lParam)
END IF
CASE WM_MENUSELECT
IF QmenuEx.DescripFlag THEN
QmenuEx.ShowDescription wParam, LParam, gRQ2_DrawItem.itemID
END IF
QmenuEx.WindowProc = CallWindowProc(QmenuEx.pOldProc, hwnd, uMsg, wParam, lParam)
CASE ELSE
QmenuEx.WindowProc = CallWindowProc(QmenuEx.pOldProc, hwnd, uMsg, wParam, lParam)
END SELECT
END FUNCTION
SUB ClearDescription
DIM i AS WORD
FOR i = 1 TO 1000
.descp(i) = " "
NEXT i
END SUB
PUBLIC:
SUB Init(Form AS QFORM)
IF .flagWinProc = FALSE THEN
.hWnd = form.Handle
INC gRQ2_WndProcNum
BIND gRQ2_WndProc(gRQ2_WndProcNum) TO QmenuEx.WindowProc
.MyWndProc = gRQ2_SetNewCallBack(gRQ2_lpMasterWndProc, gRQ2_WndProcNum)
.pOldProc = SetWindowLong(form.Handle, GWL_WNDPROC, .MyWndProc)
.flagWinProc = TRUE
END IF
END SUB
FUNCTION CLOSE () AS LONG
RESULT = SetWindowLong(QMenuEx.hWnd, GWL_WNDPROC, QMenuEx.pOldProc)
END SUB
PROPERTY SET Set_FontSize(NewSize AS WORD)
DIM nHeight AS LONG
IF NewSize > 4 THEN
.Font.Size = NewSize
.FontSize = NewSize
.Bmp.Font.Size= NewSize
nHeight = .Bmp.TextHeight("A")
IF .Height < nHeight THEN .Height = nHeight + 2
END IF
END PROPERTY
SUB PARENT(TheMenuParent AS QMENUITEM)
IF TheMenuParent.Handle <> 0 THEN .MenuParent = TheMenuParent.Handle
END SUB
SUB AddBMPFile(MenuItem AS QMENUITEM, FileName$)
.image(MenuItem.Command).LoadFromFile(FileName$)
.image(.LastMenu).Transparent = .Transparent
.image(.LastMenu).TransparentColor = .TransparentColor
END SUB
SUB ICOFile (MenuItem AS QMENUITEM, FileName$)
.AddICOFile(FileName$)
.image(MenuItem.Command).BMP = .GetICO(.Count-1)
.image(.LastMenu).Transparent = .Transparent
.image(.LastMenu).TransparentColor = .TransparentColor
.LastCount = .Count
END SUB
FUNCTION AddDescription(MenuItem AS QMENUITEM, descripcion AS STRING) AS LONG
DIM S AS STRING
DIM flag AS INTEGER
DIM tmpBMP AS QBITMAP
RESULT = 0
IF QMenuEx.MenuParent = 0 THEN SHOWMESSAGE "no menu Parent": GOTO EXIT_FUNCTION
S = MenuItem.CAPTION
flag = MF_BYPOSITION + MF_OWNERDRAW
IF MenuItem.Enabled = false THEN flag = flag + MF_DISABLED
ModifyMenu(QMenuEx.MenuParent, MenuItem.MenuIndex, flag, MenuItem.Command, VARPTR(S))
IF .DescripFlag = 0 THEN .DescripFlag = 1
.descp(MenuItem.Command)= descripcion
.LastMenu = MenuItem.Command
IF .LastCount < .Count THEN
.LastCount = .Count
tmpBMP.Width = 30 : tmpBMP.Height = 30
.Draw(tmpBMP, 0,0,.Count)
.Width = tmpBMP.width
.Height = tmpBMP.Height
END IF
EXIT_FUNCTION:
END FUNCTION
FUNCTION MenuModify(item AS QMENUITEM, picture AS QIMAGE, descripcion AS STRING) AS LONG
DIM capn AS STRING
DIM S AS STRING
DIM flag AS INTEGER
RESULT = 0
IF .MenuParent = 0 THEN SHOWMESSAGE "no menu Parent": GOTO EXIT_FUNCTION
capn = item.CAPTION
flag = MF_BYPOSITION + MF_OWNERDRAW
IF item.Enabled = false THEN flag=flag + MF_DISABLED
ModifyMenu(.MenuParent, item.MenuIndex, flag, Item.Command, VARPTR(capn))
.LastMenu = Item.Command
.image(.LastMenu).bmp=picture.bmp
.Width = .image(.LastMenu).width
.Height = .image(.LastMenu).Height
.image(.LastMenu).Transparent = .Transparent
.image(.LastMenu).TransparentColor = .TransparentColor
IF .DescripFlag = 0 THEN .DescripFlag = 1
.descp(Item.Command)= descripcion
RESULT = 1
EXIT_FUNCTION:
END FUNCTION
SUB DelBitmap(item AS QMENUITEM)
DIM s AS STRING
DIM flag AS INTEGER
s = item.CAPTION
flag = MF_BYPOSITION + MF_STRING
IF item.Enabled = false THEN flag = flag+MF_DISABLED
ModifyMenu(.MenuParent, item.MenuIndex, flag, Item.Command, VARPTR(s))
END SUB
END WITH
CONSTRUCTOR
Transparent = True
TransparentColor = 0
DescripFlag = 0
ClearDescription
Height = 18
Width = 18
flagWinProc = FALSE
BackColor = clMenu
ForeColor = clMenuText
DisabledColor = GetSysColor(COLOR_GRAYTEXT)
HighLightColor = GetSysColor(COLOR_HIGHLIGHT)
HighLightTextColor = clMenuText
OutLine = False
Margin = 9
LastCount = 0
END CONSTRUCTOR
END TYPE
$ENDIF
$IFNDEF _RQDIALOGINC
$DEFINE _RQDIALOGINC
$DEFINE fdOpen 0
$DEFINE fdSave 1
CONST fdStrTerm$ = CHR$(0) + CHR$(0)
CONST fdMaxFiles = 256
TYPE QFILEDIALOG EXTENDS QOBJECT
PRIVATE:
tmpFileName AS STRING
tmpFilter AS STRING
tmpFileTitle AS STRING
OFN AS OPENFILENAME
PUBLIC:
PARENT AS LONG
CAPTION AS STRING
Filter AS STRING
FilterIndex AS INTEGER
InitialDir AS STRING
Mode AS INTEGER
WarnIfOverWrite AS INTEGER
Filename AS STRING
FileTitle AS STRING
DefaultExt AS STRING
MultiSelect AS INTEGER
SelCount AS INTEGER
NoChangeDir AS INTEGER
Files(fdMaxFiles) AS STRING
CONSTRUCTOR
PARENT = 0
CAPTION = "Open" + STRING$(243, 0)
Filter = "All Files|*.*" + STRING$(243, 0)
FilterIndex = 0
InitialDir = STRING$(256, 0)
Mode = 0
WarnIfOverWrite = 1
Filename = STRING$(1024, 0)
tmpFileName = STRING$(1024, 0)
DefaultExt = STRING$(256, 0)
MultiSelect = 0
SelCount = 0
NoChangeDir = 0
END CONSTRUCTOR
FUNCTION EXECUTE() AS LONG
DIM FndSpace1 AS INTEGER
DIM FndSpace2 AS INTEGER
DIM StrLenth AS INTEGER
DIM MyHresult AS LONG
WITH QFILEDIALOG
.OFN.lStructSize = SIZEOF(QfileDialog.OFN)
.OFN.hwndOwner = .PARENT
.OFN.hInstance = 0
IF RIGHT$(QFILEDIALOG.Filter, 2) <> fdStrTerm$ THEN QFILEDIALOG.Filter = QFILEDIALOG.Filter + fdStrTerm$
.tmpFilter = REPLACESUBSTR$(.Filter, "|", CHR$(0))
.OFN.lpstrFilter = VARPTR(QfileDialog.tmpFilter)
.OFN.nFilterIndex = .FilterIndex
IF .FileName = "" THEN
.tmpFileName = STRING$(1024,0)
ELSE
.tmpFileName = .FileName
IF LEN(.FileName) < 1024 THEN .tmpFileName = .tmpFileName + STRING$(1024-LEN(QfileDialog.FileName),0)
END IF
.OFN.lpstrFile = VARPTR(QfileDialog.tmpFileName)
.OFN.nMaxFile = LEN(QfileDialog.tmpFileName)
.tmpFileTitle = STRING$(1024,0)
.OFN.nMaxFileTitle = 1024
.OFN.lpstrFileTitle = VARPTR(QfileDialog.tmpFileTitle)
IF QfileDialog.InitialDir <> "" THEN
.OFN.lpstrInitialDir = VARPTR(QfileDialog.InitialDir)
ELSE
.OFN.lpstrInitialDir = 0&
END IF
.OFN.lpstrTitle = VARPTR(QfileDialog.CAPTION)
IF .DefaultExt <> "" THEN .OFN.lpstrDefExt = VARPTR(QfileDialog.DefaultExt)
IF .WarnIfOverWrite THEN
.OFN.flags =OFN_HIDEREADONLY OR OFN_OVERWRITEPROMPT
ELSE
.OFN.flags =OFN_HIDEREADONLY
END IF
IF .MultiSelect THEN .OFN.flags = .OFN.flags OR OFN_ALLOWMULTISELECT OR OFN_EXPLORER
IF .NoChangeDir THEN .OFN.flags = .OFN.flags OR OFN_NOCHANGEDIR
SELECT CASE .Mode
CASE = fdOpen
MyHresult = GetOpenFileName(QfileDialog.OFN)
CASE = fdSave
MyHresult = GetSaveFileName(QfileDialog.OFN)
CASE ELSE
SHOWMESSAGE "Invalid Mode in FileDialog"
END SELECT
IF MyHresult <> 0 THEN
MEMCPY(VARPTR(QfileDialog.tmpFileName), QfileDialog.OFN.lpstrFile, QfileDialog.OFN.nMaxFile)
StrLenth = INSTR(QfileDialog.tmpFileName, fdStrTerm$)
.FileTitle = STRING$(.OFN.nMaxFileTitle, 32)
MEMCPY(VARPTR(QfileDialog.FileTitle), QfileDialog.OFN.lpstrFileTitle, QfileDialog.OFN.nMaxFile)
.FileTitle = LEFT$(.FileTitle, (INSTR(.FileTitle, fdStrTerm$))-1)
IF .MultiSelect THEN
.tmpFileName = LEFT$(QfileDialog.tmpFileName, StrLenth)
.tmpFileName = REPLACESUBSTR$(.tmpFileName, CHR$(0), CHR$(255))
FndSpace1 = 1: FndSpace2 = 0
.SelCount = -1
DO
FndSpace2 = INSTR(FndSpace1, .tmpFileName, CHR$(255))
IF FndSpace2 = 0 THEN
EXIT DO
ELSE
.SelCount++
.Files(.SelCount) = MID$(.tmpFileName, FndSpace1, (FndSpace2 - FndSpace1))
FndSpace1 = FndSpace2 + 1
IF .SelCount > fdMaxFiles THEN EXIT DO
END IF
LOOP UNTIL FndSpace2 >= StrLenth
.FileName = ""
FOR FndSpace1 = 1 TO StrLenth - 1
FndSpace2 = ASC(MID$(.tmpFileName,FndSpace1, 1))
IF (FndSpace2 <> 0) AND (FndSpace2 <> 255) THEN .FileName = .FileName + CHR$(FndSpace2)
NEXT FndSpace1
IF .SelCount = 0 THEN
.Files(1) = .FileTitle
.Files(0) = .FileName - .FileTitle
.SelCount = 1
END IF
IF RIGHT$(.Files(0),1) <>"\" THEN .Files(0)= .Files(0) + "\"
ELSE
.FileName = LEFT$(QfileDialog.tmpFileName, StrLenth-1)
END IF
END IF
RESULT = MyHresult
END WITH
END FUNCTION
END TYPE
$ENDIF
$DEFINE cdNormal 0
$DEFINE cdFullOpen 1
$DEFINE cdNoFullOpen 2
TYPE QCOLORDIALOG EXTENDS QOBJECT
PRIVATE:
CC AS CHOOSECOLOR
MyWndProc AS LONG
PUBLIC:
CAPTION AS STRING
COLOR AS LONG
Colors(1 TO 16) AS LONG
Style AS LONG
Left AS LONG
Top AS LONG
WITH QCOLORDIALOG
FUNCTION HookProc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DIM R AS QRECT
IF uMsg=WM_INITDIALOG THEN
GetWindowRect(hWnd,R)
IF (.Left >= 0) OR (.Top >=0) THEN
MoveWindow(hWnd, .Left, .Top, (R.Right-R.Left),(R.Bottom-R.Top),0)
ELSE
MoveWindow(hWnd,((Screen.Width-(R.Right-R.Left))/2),((Screen.Height-(R.Bottom-R.Top))/2),(R.Right-R.Left),(R.Bottom-R.Top),0)
END IF
IF LEN(.CAPTION) THEN SetWindowText(hWnd, QCOLORDIALOG.CAPTION)
Result=true
ELSE
Result = false
END IF
END FUNCTION
FUNCTION EXECUTE AS LONG
DIM i AS LONG
.CC.lStructSize=SIZEOF(QCOLORDIALOG.CC)
.CC.hWndOwner = Application.Handle
.CC.RGBResult=.COLOR
FOR i=1 TO 16
.CC.lpCustColors(i)=.Colors(i)
NEXT i
.CC.Flags=CC_RGBINIT
SELECT CASE .Style
CASE cdFullOpen
.CC.Flags =.CC.Flags OR CC_FULLOPEN
CASE cdNoFullOpen
.CC.Flags =.CC.Flags OR CC_PREVENTFULLOPEN
END SELECT
IF (.CAPTION <> "") THEN
.CC.Flags=.CC.Flags OR CC_ENABLEHOOK
.CC.lpfnHook = CODEPTR(QCOLORDIALOG.HookProc)
END IF
IF ChooseColorDlg(.CC) <> 0 THEN
FOR i=1 TO 16
.Colors(i)=.CC.lpCustColors(i)
NEXT i
.COLOR=.CC.RGBResult
Result=true
ELSE
Result=false
END IF
END FUNCTION
CONSTRUCTOR
CAPTION=""
Left = Screen.Width\3
Top = Screen.Height\3
Colors(1)=&H0
Colors(2)=&H808080
Colors(3)=&H000080
Colors(4)=&H008080
Colors(5)=&H008000
Colors(6)=&H808000
Colors(7)=&H800000
Colors(8)=&H800080
Colors(9)=&HFFFFFF
Colors(10)=&HC0C0C0
Colors(11)=&H0000FF
Colors(12)=&H00FFFF
Colors(13)=&H00FF00
Colors(14)=&HFFFF00
Colors(15)=&HFF0000
Colors(16)=&HFF00FF
Top = -1
left = -1
END CONSTRUCTOR
END WITH
END TYPE
TYPE QDriveComboBox EXTENDS QCOMBOBOX
SUB GetDrives
DIM ASC_A AS INTEGER
DIM ASC_Z AS INTEGER
DIM i AS INTEGER
DIM name AS STRING
ASC_A=65
ASC_Z=ASC_A+25
FOR i=ASC_A TO ASC_Z
IF GetDriveType(CHR$(i)&":\")<>1 THEN
name=CHR$(i)+":\"
QDriveComboBox.AddItems name
END IF
NEXT i
QDriveComboBox.ItemIndex=0
END SUB
SUB AddItems
END SUB
SUB DelItems
END SUB
SUB Clear
END SUB
CONSTRUCTOR
END CONSTRUCTOR
END TYPE
TYPE QAbout EXTENDS QOBJECT
private:
form AS QFORM
BtOk AS QBUTTON
cadre AS QGROUPBOX
label1 AS QLABEL
label2 AS QLABEL
label3 AS QLABEL
label4 AS QLABEL
width AS SHORT
height AS SHORT
send AS STRING
public:
image AS QIMAGE
CAPTION AS STRING
AppName AS STRING
AppVersion AS STRING
text AS STRING
Email AS STRING
Web AS STRING
AppFont AS QFONT
TextFont AS QFONT
EmailFont AS QFONT
WebFont AS QFONT
SUB Show
WITH QAbout
.image.PARENT=.cadre
.image.top=15
.image.left=10
.image.autosize=true
.label1.autosize=true
.label1.left=.image.left+.image.width+20
.label1.font=.AppFont
.label1.CAPTION=.AppName
IF .AppVersion<>"" THEN
IF .AppName<>"" THEN .label1.CAPTION=.label1.CAPTION+CHR$(13)
.label1.CAPTION=.label1.CAPTION+"Version "+.AppVersion
END IF
IF .image.height>.label1.height THEN
.label1.top=INT((.image.height-.label1.height)/2)+.image.top
.height=.image.top+.image.height
ELSE
.label1.top=.image.top
.height=.label1.top+.label1.height
END IF
.label1.PARENT=.cadre
IF .text<>"" THEN
.label2.autosize=true
.label2.font=.TextFont
.label2.CAPTION=.text
.label2.left=10
.label2.top=.height+10
.height=.label2.top+.label2.height
.label2.PARENT=.cadre
END IF
IF .Email<>"" THEN
.label3.autosize=true
.label3.Font=.EmailFont
IF .label3.Font.COLOR=-2147483640 THEN .label3.Font.COLOR=&HFF0000
.label3.Cursor=-21
.label3.CAPTION="Email:"+.Email
.label3.left=10
.label3.top=.height+10
.height=.label3.top+.label3.height
.label3.PARENT=.cadre
END IF
IF .Web<>"" THEN
.label4.autosize=true
.label4.Font=.WebFont
IF .label4.Font.COLOR=-2147483640 THEN .label4.Font.COLOR=&HFF0000
.label4.Cursor=-21
.label4.CAPTION="Web:"+.Web
.label4.left=10
.label4.top=.height+10
.height=.label4.top+.label4.height
.label4.PARENT=.cadre
END IF
.cadre.top=5
.cadre.left=10
.width=(.label1.left+.label1.width)
IF .text<>"" THEN
IF (.label2.left+.label2.width)>.width THEN .width=(.label2.left+.label2.width)
END IF
IF .Email<>"" THEN
IF (.label3.left+.label3.width)>.width THEN .width=(.label3.left+.label3.width)
END IF
IF .Web<>"" THEN
IF (.label4.left+.label4.width)>.width THEN .width=(.label4.left+.label4.width)
END IF
.width=.width+20
.cadre.width=.width
.cadre.height=.height+10
.cadre.PARENT=.form
.label2.left=(.width-.label2.width)/2
.label3.left=(.width-.label3.width)/2
.label4.left=(.width-.label4.width)/2
.form.width=.cadre.left+.cadre.width+15
.form.height=.cadre.top+.cadre.height+60
.form.borderstyle=3
.form.CAPTION=.CAPTION
.form.center
.BtOk.PARENT=.form
.BtOk.CAPTION="Ok"
.BtOk.default=1
.BtOk.top=.form.clientheight-.BtOk.height-5
.BtOk.left=INT((.form.clientwidth-.BtOk.width)/2)
.form.SHOWMODAL
END WITH
END SUB
EVENT BtOk.OnClick
QAbout.form.modalresult=1
END EVENT
EVENT label3.OnClick
QAbout.send="mailto:"+QAbout.Email
ShellExecute(0,"open",QAbout.send,"","",1)
END EVENT
EVENT label4.OnClick
IF INSTR(LCASE$(QAbout.Web),"http")=0 THEN
QAbout.send="http://"+QAbout.Web
ELSE
QAbout.send=QAbout.Web
END IF
ShellExecute(0,"open",QAbout.send,"","",1)
END EVENT
CONSTRUCTOR
image.transparent=true
text=""
Email=""
Web=""
END CONSTRUCTOR
END TYPE
TYPE QDebug EXTENDS QOBJECT
PRIVATE:
RowNum AS INTEGER
Redit AS QRICHEDIT
PUBLIC:
Visible AS LONG PROPERTY SET Set_Visible
Enabled AS LONG PROPERTY SET Set_Enabled
Form AS QFORM
TestSockets AS INTEGER
PROPERTY SET Set_Visible(VisibleValue AS LONG)
IF VisibleValue = 1 THEN
THIS.Form.Show
THIS.Redit.PARENT = THIS.Form
EnableWindow(THIS.Form.Handle, THIS.Enabled)
ELSE
THIS.Form.CLOSE
END IF
END PROPERTY
PROPERTY SET Set_Enabled(EnabledValue AS LONG)
THIS.Enabled = EnabledValue
IF THIS.Form.Visible THEN EnableWindow(THIS.Form.Handle, THIS.Enabled)
END PROPERTY
SUB PrintWrap (StringToPrint AS STRING)
DIM RowHeight AS INTEGER
DIM NewStr AS STRING
IF QDebug.Visible = 1 THEN
IF THIS.Form.Visible = 0 THEN THIS.Form.Show
IF THIS.Redit.Visible THEN THIS.Redit.Visible= 0
NewStr = StringToPrint + SPACE$(THIS.Form.ClientWidth)
RowHeight = THIS.Form.TextHeight(NewStr)
INC(THIS.RowNum, RowHeight)
IF THIS.RowNum> (THIS.Form.ClientHeight - RowHeight) THEN THIS.RowNum = 0
THIS.Form.TextOut(0, THIS.RowNum, NewStr, 0, &HFFFFFF)
EnableWindow(THIS.Form.Handle, THIS.Enabled)
DOEVENTS
END IF
END SUB
SUB PrintStr(StringToPrint AS STRING)
IF QDebug.Visible = 1 THEN
IF THIS.Form.Visible = 0 THEN
THIS.Form.Show
THIS.Redit.PARENT = THIS.Form
THIS.Redit.Visible = 1
THIS.Redit.Height = THIS.Form.ClientHeight
THIS.Redit.Width = THIS.Form.ClientWidth
END IF
THIS.Redit.AddStrings(StringToPrint)
THIS.Redit.SelStart=LEN(THIS.Redit.Text)
SENDMESSAGE(THIS.Redit.handle, &HB7, 0, 0)
EnableWindow(THIS.Form.Handle, THIS.Enabled)
DOEVENTS
END IF
END SUB
SUBI PRINT(...)
DIM TheWholeStr AS STRING
DIM i AS INTEGER
DIM j AS INTEGER
TheWholeStr = ""
j = PARAMSTRCOUNT
IF PARAMVALCOUNT > PARAMSTRCOUNT THEN j = PARAMVALCOUNT
FOR i = 1 TO j
IF i<= PARAMSTRCOUNT THEN TheWholeStr = TheWholeStr + PARAMSTR$(i) + " "
IF i<= PARAMVALCOUNT THEN TheWholeStr = TheWholeStr + STR$(PARAMVAL(i)) + " "
NEXT i
THIS.PrintStr(TheWholeStr)
END SUBI
SUB Bug (StringToPrint AS STRING)
THIS.PrintStr(StringToPrint)
END SUB
SUB SetError(NewErr AS LONG)
SetLastError(NewErr)
END SUB
FUNCTION ErrNum() AS DWORD
DIM Rtn AS DWORD
IF THIS.TestSockets THEN
Rtn = WSAGetLastError
ELSE
Rtn = GetLastError()
END IF
THIS.PRINT(Rtn)
RESULT = Rtn
END FUNCTION
FUNCTION Err$ AS STRING
DIM Buffer AS STRING
DIM lngRet AS LONG
Buffer=SPACE$(512)
lngRet=FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, _
0&, _
GetLastError(), _
LANG_NEUTRAL, _
@Buffer, _
LEN(Buffer), _
0&)
THIS.PRINT(LEFT$(Buffer,lngRet))
RESULT = LEFT$(Buffer,lngRet)
END FUNCTION
CONSTRUCTOR
RowNum = 0
Visible = 1
Enabled = 1
Form.AutoScroll = 1
Form.Height = 600
Form.Width = 180
Form.CAPTION = "Debug"
Redit.Scrollbars = 2
TestSockets = 0
SetError(0&)
END CONSTRUCTOR
END TYPE
TYPE Qlistviewex EXTENDS QLISTVIEW
ParentPanel AS QPANEL
Header AS QPANEL
ColHeader(100) AS QCOOLBTN
csv AS QSTRINGLIST
csvFile AS STRING
Separator AS STRING
Columns_count AS INTEGER
FlatHeaders AS INTEGER
Top AS LONG PROPERTY SET Set_Top
Left AS LONG PROPERTY SET Set_Left
Width AS LONG PROPERTY SET Set_Width
Height AS LONG PROPERTY SET Set_Height
Visible AS LONG PROPERTY SET Set_Visible
PRIVATE:
lx AS INTEGER
ly AS INTEGER
ix AS INTEGER
iy AS INTEGER
PUBLIC:
CONSTRUCTOR
WITH parentpanel
.borderstyle = 0
.bevelouter = 0
END WITH
WITH header
.PARENT = Qlistviewex.parentpanel
.height = 20
.align = alTop
.bevelouter = 0
.borderstyle = 0
END WITH
Columns_Count = 0
separator = ";"
showcolumnheaders = 0
FlatHeaders = 1
END CONSTRUCTOR
PROPERTY SET Set_Top(mTop AS LONG)
THIS.parentpanel.Top = mTop
END PROPERTY
PROPERTY SET Set_Left(mLeft AS LONG)
THIS.parentpanel.Left = mLeft
END PROPERTY
PROPERTY SET Set_Width(mWidth AS LONG)
THIS.parentpanel.Width = mWidth
END PROPERTY
PROPERTY SET Set_Height(mHeight AS LONG)
THIS.parentpanel.Height = mHeight
END PROPERTY
PROPERTY SET Set_Visible(mVisible AS LONG)
THIS.parentpanel.Visible = mVisible
END PROPERTY
FUNCTION FieldsCount AS INTEGER
result = TALLY(Qlistviewex.csv.item(0), Qlistviewex.Separator) + 1
END FUNCTION
SUB FastClear
DEFINT oldviewstyle,oldfontsize
oldfontsize = Qlistviewex.font.size
oldviewstyle = Qlistviewex.viewstyle
WITH QlistviewEx
.viewstyle = 1
.font.size = 1
.clear
.font.size = oldfontsize
.viewstyle = oldviewstyle
END WITH
END SUB
SUB load
QListviewEx.fastclear
DIM field AS STRING
qlistviewex.sorttype = 0
THIS.ly = Qlistviewex.csv.itemcount
FOR THIS.lx = 0 TO (THIS.ly - 1)
WITH qlistviewex
field = FIELD$(.CSV.item(.lx), .separator, 1)
IF field = "" THEN field = "-"
.additems field
.iy = .fieldscount
FOR THIS.ix = 2 TO THIS.iy
field = FIELD$(.CSV.item(THIS.lx), .separator, THIS.ix)
IF field = "" THEN field = "-"
.addsubitem (THIS.lx, field)
NEXT
END WITH
NEXT
END SUB
SUB loadfromcsvfile
QlistviewEx.csv.loadfromfile(QlistviewEx.csvFile)
QlistviewEx.load
END SUB
SUB Sortby (Criterium AS STRING)
THIS.iy = QlistviewEx.Fieldscount
THIS.ly = QlistviewEx.Itemcount
FOR THIS.ix = 0 TO (THIS.iy - 1)
IF QlistviewEx.column(THIS.ix).CAPTION = Criterium THEN
IF THIS.ix <> 0 THEN
WITH QlistviewEx
.sorttype = 0
THIS.lx = 0
DO
SWAP (.item(THIS.lx).CAPTION, .subitem(THIS.lx, THIS.ix - 1))
INC(THIS.lx)
LOOP UNTIL THIS.lx = (THIS.ly)
.sorttype = 2
.sorttype = 0
THIS.lx = 0
DO
SWAP (.item(THIS.lx).CAPTION, .subitem(THIS.lx, THIS.ix - 1))
INC(THIS.lx)
LOOP UNTIL THIS.lx = (THIS.ly)
END WITH
ELSE
QlistviewEx.sorttype = 2
END IF
END IF
NEXT THIS.ix
END SUB
SUB Exclude (Column AS INTEGER, Criterium AS STRING)
Criterium = UCASE$(criterium)
IF column = 0 THEN
WITH QlistviewEx
THIS.lx = 0
THIS.ly = .itemcount
DO
IF UCASE$(.item(THIS.lx).CAPTION) = Criterium THEN
.delitems(THIS.lx)
DEC(THIS.lx)
DEC(THIS.ly)
END IF
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
END WITH
ELSE
WITH QlistviewEx
THIS.lx = 0
THIS.ly = .itemcount
DO
IF UCASE$(.subitem(THIS.lx, Column - 1)) = Criterium THEN
.delitems(THIS.lx)
DEC(THIS.lx)
DEC(THIS.ly)
END IF
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
END WITH
END IF
END SUB
SUB columnclick (hcapt AS QCOOLBTN)
Qlistviewex.sortby (hcapt.CAPTION)
END SUB
SUB draw()
qlistviewex.PARENT = Qlistviewex.parentpanel
qlistviewex.align = alClient
qlistviewex.viewstyle = 3
qlistviewex.gridlines = 1
THIS.ix = 0
THIS.iy = Qlistviewex.Columns_Count
IF THIS.iy <> 0 THEN
DO
qlistviewex.ColHeader(THIS.ix).CAPTION = qlistviewex.column(THIS.ix).CAPTION
qlistviewex.ColHeader(THIS.ix).width = qlistviewex.column(THIS.ix).width
IF THIS.ix = 0 THEN qlistviewex.ColHeader(THIS.ix).width = qlistviewex.column(THIS.ix).width + 2
qlistviewex.colheader(THIS.ix).PARENT = qlistviewex.header
qlistviewex.colheader(THIS.ix).align = alLeft
qlistviewex.colheader(THIS.ix).flat = qlistviewex.Flatheaders
qlistviewex.colheader(THIS.ix).onclick = Qlistviewex.columnclick
INC(THIS.ix)
LOOP UNTIL THIS.ix = THIS.iy
END IF
END SUB
SUB addcol (coltoadd AS STRING)
THIS.lx = 0
THIS.ly = (TALLY(coltoadd, "/") + 1)
DO
WITH QlistviewEx
.addcolumns FIELD$(coltoadd, "/", THIS.lx + 1)
.Columns_count = (.Columns_count + 1)
END WITH
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
QlistviewEx.draw
END SUB
SUB updatecsv
DIM stringtoadd AS STRING
THIS.lx = 0
THIS.ly = QlistviewEx.itemcount
THIS.iy = QlistviewEx.Fieldscount - 1
QlistviewEx.csv.clear
DO
WITH QlistviewEx
stringtoadd = .item(THIS.lx).CAPTION
THIS.ix = 0
DO
stringtoadd = stringtoadd + .separator + .subitem(THIS.lx, THIS.ix)
INC(THIS.ix)
LOOP UNTIL THIS.ix = THIS.iy
stringtoadd = REPLACESUBSTR$(stringtoadd, (.separator + "-" + .separator), _
(.separator + .separator))
.csv.additems stringtoadd
END WITH
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
END SUB
SUB filter (Column AS INTEGER, criterium AS STRING)
criterium = UCASE$(criterium)
THIS.lx = 0
THIS.ly = QlistviewEx.itemcount
DO
SELECT CASE column
CASE 0
IF UCASE$(THIS.item(THIS.lx).CAPTION) = criterium THEN
ELSE
THIS.delitems(THIS.lx)
DEC(THIS.lx)
DEC(THIS.ly)
END IF
CASE ELSE
IF UCASE$(THIS.subitem(THIS.lx, column - 1)) = criterium THEN
ELSE
THIS.delitems(THIS.lx)
DEC(THIS.lx)
DEC(THIS.ly)
END IF
END SELECT
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
END SUB
SUB SaveToCsvFile
WITH QlistviewEx
.updateCSV
.csv.savetofile (.csvfile)
END WITH
END SUB
SUB SaveToFileAs
DIM ulvexdlg AS QSAVEDIALOG
IF ulvexdlg.EXECUTE THEN
WITH QlistviewEx
.csv.savetofile (ulvexdlg.filename)
END WITH
END IF
END SUB
SUB DirectSaveAs
DIM dsavedlg AS QSAVEDIALOG
DIM tempfsstring AS STRING
IF dsavedlg.EXECUTE THEN
DIM Direct_Save_FS AS QFILESTREAM
Direct_Save_FS.OPEN(dsavedlg.filename, 65535)
WITH QlistviewEx
THIS.lx = 0
THIS.ly = .itemcount
DO
tempfsstring = ""
tempfsstring = .item(THIS.lx).CAPTION
THIS.iy = .fieldscount - 1
THIS.ix = 0
DO
tempfsstring = tempfsstring + .separator + .subitem(THIS.lx, THIS.ix)
INC(THIS.ix)
LOOP UNTIL THIS.ix = THIS.iy
Direct_Save_FS.writeline(tempfsstring)
INC(THIS.lx)
LOOP UNTIL THIS.lx = THIS.ly
END WITH
Direct_Save_FS.CLOSE
END IF
END SUB
END TYPE
$DEFINE PSD_DEFAULTMINMARGINS 0
$DEFINE PSD_MINMARGINS &H1
$DEFINE PSD_MARGINS &H2
$DEFINE PSD_INTHOUSANDTHSOFINCHES &H4
$DEFINE PSD_INHUNDREDTHSOFMILLIMETERS &H8
$DEFINE PSD_DISABLEMARGINS &H10
$DEFINE PSD_DISABLEPRINTER &H20
$DEFINE PSD_NOWARNING &H80
$DEFINE PSD_DISABLEORIENTATION &H100
$DEFINE PSD_DISABLEPAPER &H200
$DEFINE PSD_RETURNDEFAULT &H400
$DEFINE PSD_SHOWHELP &H800
$DEFINE PSD_ENABLEPAGESETUPHOOK &H2000
$DEFINE PSD_ENABLEPAGESETUPTEMPLATE &H8000
$DEFINE PSD_ENABLEPAGESETUPTEMPLATEHANDLE &H20000
$DEFINE PSD_ENABLEPAGEPAINTHOOK &H40000
$DEFINE PSD_DISABLEPAGEPAINTING &H80000
$DEFINE PSD_NONETWORKBUTTON &H200000
$DEFINE WM_INITDIALOG_PSD &H110
TYPE TPSD
lStructSize AS LONG
hWndOwner AS LONG
hDevMode AS LONG
hDevNames AS LONG
Flags AS LONG
ptPaperSizeX AS LONG
ptPaperSizeY AS LONG
rtMinMarginLeft AS LONG
rtMinMarginTop AS LONG
rtMinMarginRight AS LONG
rtMinMarginBottom AS LONG
rtMarginLeft AS LONG
rtMarginTop AS LONG
rtMarginRight AS LONG
rtMarginBottom AS LONG
hInstance AS LONG
lParam AS LONG
lpfnPageSetupHook AS LONG
lpfnPagePaintHook AS LONG
lpPageSetupTemplate AS LONG
hPageSetupTemplate AS LONG
END TYPE
$IFNDEF __WIN32API
DECLARE FUNCTION PageSetupDlg LIB "COMDLG32" ALIAS "PageSetupDlgA" (PTR AS TPSD) AS LONG
$ENDIF
TYPE QPageSetup EXTENDS QOBJECT
Private:
PSD AS TPSD
MyWndProc AS LONG
Public:
CAPTION AS STRING
DisablePrinter AS boolean
DisablePaper AS boolean
DisableOrient AS boolean
DisableMargins AS boolean
Orientation AS boolean PROPERTY SET SetOrientation
MarginLeft AS LONG PROPERTY SET SetMarginLeft
MarginTop AS LONG PROPERTY SET SetMarginTop
MarginRight AS LONG PROPERTY SET SetMarginRight
MarginBottom AS LONG PROPERTY SET SetMarginBottom
PageWidth AS LONG PROPERTY SET SetPageWidth
PageHeight AS LONG PROPERTY SET SetPageHeight
Private:
FUNCTION HookProc(hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG, tmp AS LONG) AS LONG
DIM R AS QRECT
IF uMsg=WM_INITDIALOG_PSD THEN
GetWindowRect(hWnd,R)
MoveWindow(hWnd,((Screen.Width-(R.Right-R.Left))/2),((Screen.Height-(R.Bottom-R.Top))/2),(R.Right-R.Left),(R.Bottom-R.Top),0)
IF LEN(QPageSetup.CAPTION) THEN
SetWindowText(hWnd,QPageSetup.CAPTION)
END IF
Result=true
ELSE
Result=false
END IF
END FUNCTION
Public:
PROPERTY SET SetOrientation(value AS boolean)
END PROPERTY
PROPERTY SET SetMarginLeft(value AS LONG)
QPageSetup.PSD.rtMarginLeft=value*100
END PROPERTY
PROPERTY SET SetMarginTop(value AS LONG)
QPageSetup.PSD.rtMarginTop=value*100
END PROPERTY
PROPERTY SET SetMarginRight(value AS LONG)
QPageSetup.PSD.rtMarginRight=value*100
END PROPERTY
PROPERTY SET SetMarginBottom(value AS LONG)
QPageSetup.PSD.rtMarginBottom=value*100
END PROPERTY
PROPERTY SET SetPageWidth(value AS boolean)
END PROPERTY
PROPERTY SET SetPageHeight(value AS boolean)
END PROPERTY
FUNCTION EXECUTE AS boolean
QPageSetup.PSD.lStructSize = SIZEOF(QPageSetup.PSD)
QPageSetup.PSD.hWndOwner=Application.handle
QPageSetup.PSD.Flags=PSD_MARGINS+PSD_MINMARGINS
IF QPageSetup.CAPTION<>"" THEN
QPageSetup.PSD.Flags=QPageSetup.PSD.Flags+PSD_ENABLEPAGESETUPHOOK
INC gRQ2_WndProcNum
QPageSetup.PSD.lpfnPageSetupHook = gRQ2_SetNewCallBack(gRQ2_lpMasterWndProc, gRQ2_WndProcNum)
QPageSetup.MyWndProc = gRQ2_SetNewCallBack(gRQ2_lpMasterWndProc, gRQ2_WndProcNum)
BIND gRQ2_WndProc(gRQ2_WndProcNum) TO QPageSetup.HookProc
END IF
IF QPageSetup.DisablePrinter THEN
QPageSetup.PSD.Flags=QPageSetup.PSD.Flags+PSD_DISABLEPRINTER
END IF
IF QPageSetup.DisablePaper THEN
QPageSetup.PSD.Flags=QPageSetup.PSD.Flags+PSD_DISABLEPAPER
END IF
IF QPageSetup.DisableOrient THEN
QPageSetup.PSD.Flags=QPageSetup.PSD.Flags+PSD_DISABLEORIENTATION
END IF
IF QPageSetup.DisableMargins THEN
QPageSetup.PSD.Flags=QPageSetup.PSD.Flags+PSD_DISABLEMARGINS
END IF
IF PageSetupDlg(QPageSetup.PSD) THEN
QPageSetup.EXECUTE=true
QPageSetup.PageWidth=ROUND(QPageSetup.PSD.ptPaperSizeX/100)
QPageSetup.PageHeight=ROUND(QPageSetup.PSD.ptPaperSizeY/100)
IF QPageSetup.PageWidth>QPageSetup.PageHeight THEN
QPageSetup.Orientation=true
ELSE
QPageSetup.Orientation=false
END IF
QPageSetup.MarginLeft=QPageSetup.PSD.rtMarginLeft/100
QPageSetup.MarginTop=QPageSetup.PSD.rtMarginTop/100
QPageSetup.MarginRight=QPageSetup.PSD.rtMarginRight/100
QPageSetup.MarginBottom=QPageSetup.PSD.rtMarginBottom/100
ELSE
QPageSetup.EXECUTE=false
END IF
END FUNCTION
CONSTRUCTOR
CAPTION=""
DisablePrinter=false
DisablePaper=false
DisableOrient=false
DisableMargins=false
END CONSTRUCTOR
END TYPE
FUNCTION Application.Path() AS STRING
DIM MyPath AS STRING
DIM PathLen AS INTEGER
MyPath = COMMAND$(0)
MyPath = LEFT$(MyPath, LEN(MyPath) - LEN(Application.ExeName))
PathLen = LEN(MyPath)
IF PathLen > 3 THEN
MyPath = LEFT$(MyPath, PathLen-1)
END IF
RESULT = MyPath
END FUNCTION
FUNCTION Application.SetPriority(MyPriority AS LONG) AS LONG
DIM hProcess AS LONG
DIM hR AS LONG
hProcess = GetCurrentProcess
hR = SetPriorityClass(hProcess, MyPriority)
RESULT = hR
END FUNCTION
FUNCTION Application.GetPriority() AS LONG
DIM hProcess AS LONG
DIM hR AS LONG
hProcess = GetCurrentProcess
hR = GetPriorityClass(hProcess)
RESULT = hR
END FUNCTION
$DEFINE sysHibernateAsk 1
$DEFINE sysHibernateForce 2
$DEFINE sysSleepAsk 3
$DEFINE sysSleepForce 4
TYPE QSYSTEM EXTENDS QOBJECT
PRIVATE:
rtn AS LONG
MemStats AS MEMORYSTATUS
ProcHandle AS LONG
MyFlag AS LONG
PUBLIC:
MajorVersion AS INTEGER
MinorVersion AS INTEGER
ACLineStatus AS INTEGER
PercentBattery AS INTEGER
PowerStatus AS INTEGER PROPERTY SET SetPowerStatus
FUNCTION OSName$() AS STRING
DIM OSV AS OSVERSIONINFO
OSV.dwOSVersionInfoSize = SIZEOF(OSV)
THIS.rtn=GetVersionEx(OSV)
IF THIS.rtn = 0 THEN RESULT = "ERROR" : GOTO EXIT_FUNCTION
THIS.MajorVersion = OSV.dwMajorVersion
THIS.MinorVersion = OSV.dwMinorVersion
SELECT CASE OSV.dwPlatformId
CASE VER_PLATFORM_WIN32_NT
IF OSV.dwMajorVersion > 5 THEN RESULT = "Newer than XP"
IF (OSV.dwMajorVersion = 5 AND OSV.dwMinorVersion = 2 ) THEN RESULT = "Windows Server 2003"
IF (OSV.dwMajorVersion = 5 AND OSV.dwMinorVersion = 1 ) THEN RESULT = "Windows XP"
IF (OSV.dwMajorVersion = 5 AND OSV.dwMinorVersion = 0 ) THEN RESULT = "Windows 2000"
IF OSV.dwMajorVersion <= 4 THEN RESULT = "Windows NT"
CASE VER_PLATFORM_WIN32_WINDOWS
IF (OSV.dwMajorVersion = 4 AND OSV.dwMinorVersion = 90 ) THEN RESULT = "Windows ME"
IF (OSV.dwMajorVersion = 4 AND OSV.dwMinorVersion = 10 ) THEN RESULT = "Windows 98"
IF (OSV.dwMajorVersion = 4 AND OSV.dwMinorVersion = 0 ) THEN RESULT = "Windows 95"
CASE VER_PLATFORM_WIN32s
RESULT = "Win32s"
CASE ELSE
RESULT = "Not Windows"
END SELECT
EXIT_FUNCTION:
END FUNCTION
PROPERTY SET SetPowerStatus(TheStatus AS LONG)
DIM powr AS SYSTEM_POWER_STATUS
IF TheStatus > 0 THEN
IF TheStatus = sysHibernateAsk THEN
IF MESSAGEDLG("Hibernate the compuer now (Save all data first)?", mtConfirmation, (mbYes OR mbNo), 0) = mrYes THEN THIS.rtn = SetSuspendState(0,0,0)
END IF
IF TheStatus = sysHibernateForce THEN THIS.rtn = SetSuspendState(0,1,0)
IF TheStatus = sysSleepAsk THEN
IF MESSAGEDLG("Sleep the compuer now (Save all data first)?", mtConfirmation, (mbYes OR mbNo), 0) = mrYes THEN THIS.rtn = SetSuspendState(1,0, 0)
END IF
IF TheStatus = sysSleepForce THEN THIS.rtn = SetSuspendState(1,1,0)
ELSE
THIS.rtn = GetSystemPowerStatus(powr)
IF THIS.rtn = 0 THEN
RESULT = BATTERY_LIFE_UNKNOWN
ELSE
THIS.PowerStatus = INT(powr.BatteryFlag)
THIS.ACLineStatus = powr.ACLineStatus
THIS.PercentBattery = powr.BatteryLifePercent
END IF
END IF
END PROPERTY
FUNCTION PercentFreeMemory() AS DWORD
GlobalMemoryStatus(THIS.MemStats)
RESULT = 100-THIS.MemStats.dwMemoryLoad
END FUNCTION
FUNCTION AvailableMemory() AS DWORD
GlobalMemoryStatus(THIS.MemStats)
RESULT = THIS.MemStats.dwAvailPhys
END FUNCTION
FUNCTION TotalMemory() AS DWORD
GlobalMemoryStatus(THIS.MemStats)
RESULT = THIS.MemStats.dwTotalPhys
END FUNCTION
FUNCTION UsedMemory() AS DWORD
GlobalMemoryStatus(THIS.MemStats)
RESULT = THIS.MemStats.dwTotalPhys - THIS.MemStats.dwAvailPhys
END FUNCTION
FUNCTION PageFileMemory() AS DWORD
GlobalMemoryStatus(THIS.MemStats)
RESULT = THIS.MemStats.dwAvailPageFile
END FUNCTION
FUNCTION DiskFreeSpace(RootPathName AS STRING) AS DOUBLE
DIM FreeBytesAvail AS LARGE_INTEGER
DIM TtlBytes AS LARGE_INTEGER
DIM TTlFree AS LARGE_INTEGER
DIM dblFreeSpace AS DOUBLE
RESULT = 0
IF GetDiskFreeSpaceEx(RootPathName, FreeBytesAvail, TtlBytes, TTlFree) THEN
IF FreeBytesAvail.LowPart < 0 THEN
dblFreeSpace = FreeBytesAvail.HighPart * 2 ^ 32 + FreeBytesAvail.LowPart + 4294967296#
ELSE
dblFreeSpace = FreeBytesAvail.HighPart * 2 ^ 32 + FreeBytesAvail.LowPart
END IF
RESULT = dblFreeSpace/1048576
END IF
END FUNCTION
FUNCTION MouseWheelPresent() AS LONG
DIM tmpStr AS STRING
tmpStr = THIS.OSName$
IF tmpStr <> "Windows 95" THEN
RESULT = GetSystemMetrics(SM_MOUSEWHEELPRESENT)
ELSE
RESULT = 0&
END IF
END FUNCTION
FUNCTION ScrollBarWidth() AS LONG
RESULT = GetSystemMetrics(SM_CXVSCROLL)
END FUNCTION
FUNCTION ScrollBarHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYHSCROLL)
END FUNCTION
FUNCTION CaptionBarHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYCAPTION)
END FUNCTION
FUNCTION WindowBorderWidth() AS LONG
RESULT = GetSystemMetrics(SM_CXBORDER)
END FUNCTION
FUNCTION WindowBorderHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYBORDER)
END FUNCTION
FUNCTION IconWidth() AS LONG
RESULT = GetSystemMetrics(SM_CXICON)
END FUNCTION
FUNCTION IconHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYICON)
END FUNCTION
FUNCTION MenuBarHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYMENU)
END FUNCTION
FUNCTION NetworkPresent() AS LONG
RESULT = GetSystemMetrics(SM_NETWORK)
END FUNCTION
FUNCTION SlowProcessor() AS LONG
RESULT = GetSystemMetrics(SM_SLOWMACHINE)
END FUNCTION
FUNCTION ShowControlPanel(PanelName AS STRING,index AS INTEGER) AS LONG
DIM Keywd AS STRING
DIM PID AS LONG
KeyWd = UCASE$(LEFT$(PanelName,4))
SELECT CASE KeyWd
CASE = "MOUS"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0,"+STR$(index), 5)
CASE = "KEYB"
IF index >1 THEN index=0
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,"+STR$(index), 5)
CASE = "PRIN"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL main.cpl @2", 5)
CASE "FONT"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL main.cpl @3", 5)
CASE "DISP"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL desk.cpl @0,"+STR$(index), 5)
CASE "TIME"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl @0", 5)
CASE "DIAL", "TELE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL telephon.cpl @0,"+STR$(index), 5)
CASE "SYST"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @0"+STR$(index), 5)
CASE "ADD "
IF (UCASE$(LEFT$(PanelName, 12) = "ADD NEW HARD")) THEN
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", 5)
END IF
IF (UCASE$(LEFT$(PanelName, 12) = "ADD OR REMOV")) THEN
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0,"+STR$(index), 5)
END IF
CASE "SCAN"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL sticpl.cpl @0", 5)
CASE "THEM"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL themes.cpl @0", 5)
CASE "POWE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL powercfg.cpl @0,"+STR$(index), 5)
CASE "PASS"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL password.cpl @0,"+STR$(index), 5)
CASE "MODE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL modem.cpl @0,"+STR$(index), 5)
CASE "MMDE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @0,"+STR$(index), 5)
CASE "SOUN"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1", 5)
CASE "GAME"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL joy.cpl @0,"+STR$(index), 5)
CASE "REGI"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL intl.cpl @0,"+STR$(index), 5)
CASE "INTE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl @0,"+STR$(index), 5)
CASE "USER"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl @1,"+STR$(index), 5)
CASE "ACCE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL access.cpl @0,"+STR$(index), 5)
CASE "FIRE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL firewall.cpl @0,"+STR$(index), 5)
CASE "NETS"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL netsetup.cpl @0,"+STR$(index), 5)
CASE "DIRE"
PID = SHELL("rundll32.exe shell32.dll,Control_RunDLL directx.cpl @0,"+STR$(index), 5)
CASE ELSE
PID = 0
END SELECT
RESULT = PID
END FUNCTION
PRIVATE:
SUB DoShutDown
DIM Thndl AS LONG
DIM MyLUID AS LUID
DIM MyPriv AS TOKEN_PRIVILEGES
DIM MyNewPriv AS TOKEN_PRIVILEGES
DIM ret AS LONG
DIM pdword AS INTEGER
This.ProcHandle = GetCurrentProcess()
ret = OpenProcessToken(This.ProcHandle, TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, @Thndl)
ret = LookupPrivilegeValue("", "SeShutdownPrivilege", MyLUID)
MyPriv.PrivilegeCount = 1
MyPriv.Attributes = SE_PRIVILEGE_ENABLED
MyPriv.LowPart = MyLUID.LowPart
MyPriv.HighPart = MyLUID.HighPart
pdword = 4 + (12 * MyNewPriv.PrivilegeCount)
ret = AdjustTokenPrivileges(Thndl, False, MyPriv, 4 + (12 * MyPriv.PrivilegeCount), MyNewPriv,@pdword)
Ret = ExitWindowsEx(This.MyFlag, 0)
END SUB
PUBLIC:
SUB ShutDown
This.MyFlag = EWX_SHUTDOWN
This.DoShutDown
END SUB
SUB ShutDownForce
This.MyFlag = EWX_FORCE OR EWX_SHUTDOWN
This.DoShutDown
END SUB
SUB LogOff
This.MyFlag = EWX_LOGOFF
This.DoShutDown
END SUB
SUB Reboot
This.MyFlag = EWX_REBOOT
This.DoShutDown
END SUB
CONSTRUCTOR
SetPowerStatus(0)
OSName$
MyFlag = EWX_LOGOFF
END CONSTRUCTOR
END TYPE
FUNCTION Screen.MousePresent() AS LONG
RESULT = GetSystemMetrics(SM_MOUSEPRESENT)
END FUNCTION
FUNCTION Screen.MouseSwap() AS LONG
RESULT = GetSystemMetrics(SM_SWAPBUTTON)
END FUNCTION
FUNCTION Screen.MouseButtons() AS LONG
RESULT = GetSystemMetrics(SM_CMOUSEBUTTONS)
END FUNCTION
FUNCTION Screen.SetMouseXY(X AS LONG, Y AS LONG) AS LONG
RESULT = SetCursorPos(X, Y)
END FUNCTION
FUNCTION Screen.ClientWidth() AS LONG
RESULT = GetSystemMetrics(SM_CXFULLSCREEN)
END FUNCTION
FUNCTION Screen.ClientHeight() AS LONG
RESULT = GetSystemMetrics(SM_CYFULLSCREEN)
END FUNCTION
FUNCTION Screen.Monitors() AS LONG
RESULT = GetSystemMetrics(SM_CMONITORS)
END FUNCTION
FUNCTION Screen.SetResolution(X AS DWORD, Y AS DWORD, bpp AS WORD, Freq AS DWORD) AS LONG
DIM DevM AS DEVMODE
DIM erg AS LONG
RESULT = 0
MEMSET(DevM,0,SIZEOF(DevM))
DevM.dmSize = SIZEOF(DevM)
DevM.dmFields = DM_PELSWIDTH OR DM_PELSHEIGHT OR DM_BITSPERPEL
DevM.dmPelsWidth = X
DevM.dmPelsHeight = Y
DevM.dmBitsPerPel = bpp
IF Freq<> 0 THEN
DevM.dmFields = DevM.dmFields OR DM_DISPLAYFREQUENCY
DevM.dmDisplayFrequency = Freq
END IF
erg = ChangeDisplaySettings(DevM, CDS_TEST)
SELECT CASE erg
CASE DISP_CHANGE_SUCCESSFUL
erg = ChangeDisplaySettings(devm, CDS_DYNAMIC)
CASE DISP_CHANGE_RESTART
SHOWMESSAGE "You must restart your computer for new screen resolution setting."
CASE DISP_CHANGE_FAILED
SHOWMESSAGE "Change Screen Resolution Failed"
CASE DISP_CHANGE_BADMODE
SHOWMESSAGE "Invalid Screen Resolution parameters"
CASE ELSE
SHOWMESSAGE "Undefined result: " + STR$(erg) + " in SetResolution"
END SELECT
RESULT = erg
END FUNCTION
FUNCTION Screen.GetPixelDepth() AS LONG
DIM DC AS INTEGER
DC=GetDC(0)
RESULT = GetDeviceCaps(DC, BITSPIXEL)
ReleaseDC(0,DC)
END FUNCTION
FUNCTION Screen.EnumResolution(ListView AS QLISTBOX) AS LONG
DIM DevM AS DevMode
DIM fEnd AS LONG, iMode AS LONG
DIM TheRstr AS STRING
DEFSTR DeviceName = ""
RESULT = 0
DevM.dmSize = SIZEOF(DevM)
iMode = 0
DO
fEnd = EnumDisplaySettings(DeviceName, iMode, DevM)
TheRstr = STR$(DevM.dmPelsWidth) + " x " +_
STR$(DevM.dmPelsHeight) + " x " + STR$(DevM.dmBitsPerPel) + " BPP"
ListView.AddItems(TheRstr)
iMode++
LOOP UNTIL (fEnd = 0)
RESULT = 1
END FUNCTION
FUNCTION Screen.CaptureToBMP(TheRect AS QRECT, CapBitMap AS QBITMAP) AS LONG
DIM DeskhWnd AS LONG
DIM DeskDC AS LONG
DIM retrn AS LONG
DIM TmpForm AS QFORM
DeskhWnd=GetDesktopWindow()
DeskDC = CreateDC("DISPLAY", "", "", 0)
IF TheRect.Bottom = 0 AND TheRect.Top = 0 AND TheRect.Right = 0 AND TheRect.Left = 0 THEN
CapBitMap.Height= Screen.Height
CapBitMap.Width = Screen.Width
ELSE
CapBitMap.Height = TheRect.Bottom - TheRect.Top
CapBitMap.Width = TheRect.Right - TheRect.Left
END IF
retrn = BitBlt(CapBitMap.Handle,_
0, 0,_
CapBitMap.Width,_
CapBitMap.Height,_
DeskDC,_
TheRect.Left, TheRect.Top,_
&HCC0020)
Screen.CaptureToBMP = retrn
RESULT = retrn
IF retrn = 0 THEN
SHOWMESSAGE "Screen Capture Failed"
GOTO EXIT_FUNCTION
END IF
TmpForm.Draw(0,0, CapBitMap.BMP)
TmpForm.CLOSE
EXIT_FUNCTION:
END FUNCTION
FUNCTION Screen.CaptureToFile(TheRect AS QRECT, OutFileName AS STRING) AS LONG
DIM DeskhWnd AS LONG
DIM DeskDC AS LONG
DIM CapBitMap AS QBITMAP
DIM retrn AS LONG
DeskhWnd=GetDesktopWindow()
DeskDC = CreateDC("DISPLAY", "", "", 0)
IF TheRect.Bottom = 0 AND TheRect.Top = 0 AND TheRect.Right = 0 AND TheRect.Left = 0 THEN
CapBitMap.Height= Screen.Height
CapBitMap.Width = Screen.Width
ELSE
CapBitMap.Height = TheRect.Bottom - TheRect.Top
CapBitMap.Width = TheRect.Right - TheRect.Left
END IF
retrn = BitBlt(CapBitMap.Handle,_
0, 0,_
CapBitMap.Width,_
CapBitMap.Height,_
DeskDC,_
TheRect.Left, TheRect.Top,_
&HCC0020)
Screen.CaptureToFile = retrn
IF retrn = 0 THEN
SHOWMESSAGE "Screen Capture Failed"
GOTO EXIT_FUNCTION
END IF
IF OutFileName <> "" THEN
CapBitMap.SaveToFile(OutFileName)
END IF
EXIT_FUNCTION:
END FUNCTION
FUNCTION Screen.GetPixel(x AS INTEGER, y AS INTEGER) AS LONG
DIM DC AS INTEGER
DIM COLOR AS LONG
DC=GetDC(0)
COLOR=GetPixel(DC,x,y)
ReleaseDC(0,DC)
result=COLOR
END FUNCTION
FUNCTION HexToDec(hex AS STRING)AS LONG
DIM bit AS LONG
DIM valbit AS INTEGER
DIM i AS INTEGER
DIM value AS INTEGER
hex=REVERSE$(hex)
bit=1
value=0
FOR i=1 TO LEN(hex)
IF MID$(hex,i,1)="A" THEN
value=value+(10*bit)
ELSEIF MID$(hex,i,1)="B" THEN
value=value+(11*bit)
ELSEIF MID$(hex,i,1)="C" THEN
value=value+(12*bit)
ELSEIF MID$(hex,i,1)="D" THEN
value=value+(13*bit)
ELSEIF MID$(hex,i,1)="E" THEN
value=value+(14*bit)
ELSEIF MID$(hex,i,1)="F" THEN
value=value+(15*bit)
ELSE
value=value+(VAL(MID$(hex,i,1))*bit)
END IF
IF (bit*16)<2147483647 THEN bit=bit*16
NEXT i
result=value
END FUNCTION
FUNCTIONI UDTPTR(...) AS LONG
RESULT = PARAMVAL(1)
END FUNCTION
FUNCTION CONVBASEx$(StrToConvert AS STRING, _
FromBase AS BYTE, _
ToBase AS BYTE) AS STRING
DEFSTR WorkStr = UCASE$(LTRIM$(RTRIM$(StrToConvert)))
DEFSTR DigitStr
DEFLNG Digit, DigitVal
DEFDBL DigitPwr
DEFDBL Accum = 0
FOR Digit = 0 TO LEN(WorkStr) - 1
DigitStr = WorkStr[LEN(WorkStr) - Digit]
DigitVal = VAL(CONVBASE$(DigitStr, FromBase, 10))
Accum = Accum + DigitVal * FromBase ^ Digit
NEXT
IF Accum = 0 THEN Result = "0" : EXIT FUNCTION
WorkStr = ""
FOR Digit = 0 TO 99
DigitPwr = ToBase ^ Digit
IF INT(Accum / DigitPwr) = 0 THEN EXIT FOR
NEXT
FOR Digit = Digit - 1 TO 0 STEP - 1
DigitPwr = ToBase ^ Digit
DigitVal = INT(Accum / DigitPwr)
IF DigitVal THEN
WorkStr = WorkStr + CONVBASE$(STR$(DigitVal), 10, ToBase)
Accum = Accum - DigitVal * DigitPwr
ELSE
WorkStr = WorkStr + "0"
END IF
NEXT
Result = WorkStr
END FUNCTION
$DEFINE gRQ2_CONVBASE_Orig CONVBASE$
FUNCTIONI gRQ2_CONVBASEFixed(...) AS STRING
DIM StrExpression AS STRING
DIM fromBase AS INTEGER
DIM toBase AS INTEGER
DEFINT errFlag = 0
StrExpression = UCASE$(PARAMSTR$(1))
IF LEN(StrExpression) > 8 THEN
RESULT = CONVBASEx$(StrExpression, PARAMVAL(1), PARAMVAL(1))
ELSE
IF StrExpression = "FFFFFFFF" THEN errFlag = TRUE
fromBase = PARAMVAL(1)
IF fromBase = 0 THEN errFlag = TRUE
toBase = PARAMVAL(2)
IF toBase = 0 THEN errFlag = TRUE
IF errFlag THEN
RESULT = "0"
ELSE
RESULT = gRQ2_CONVBASE_Orig(StrExpression, fromBase, toBase)
END IF
END IF
END FUNCTIONI
$DEFINE CONVBASE$ gRQ2_CONVBASEFixed
FUNCTION gRQ2_MasterWndProc(iFuncIndex AS LONG, hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
RESULT = CALLFUNC(gRQ2_WndProc(iFuncIndex), hwnd, uMsg, wParam, lParam, iFuncIndex)
END FUNCTION
$ENDIF
|
|