-- Win32Lib -- "Bleeding Edge" 0.45r -- (c) 2000 David Cuny -- -- This library provides access to the Win32 API from a fairly high -- level, hiding most of the guts from the user. ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- info on topics ----------------------------------------------------------------------------- --/topic Attributes --/info -- These are routines that let you inspect and alter attributes of -- controls. For more specialized routines, see: -- -- /li /"Edit Control": Working with text edit controls -- ( /EditText, /MleText ). -- /li /"List Control": Working with lists ( /List, /SortedList ), -- combos ( /Combo, /SortedCombo ), etc. -- /li /"Scroll Control": Working with scrollbars ( /HScroll, /VScroll ) -- and trackbars ( /HTrackBar, /VTrackbar ). -- ----------------------------------------------------------------------------- --/topic Controls --/info -- Controls are the basic elements of Windows programs. You can -- /create them, query and change /Attributes, and respond to -- /Events. -- -- See Also: /Attributes, /Control, /"Edit Control", /"List Control", -- /"Scroll Control" ----------------------------------------------------------------------------- --/topic Dialogs --/info -- These are functions the bring up common dialogs. ----------------------------------------------------------------------------- --/topic Edit Control --/info -- These are routines that let you inspect and alter attributes of -- the text edit controls, /EditText and /MleText. ----------------------------------------------------------------------------- --/topic Events --/info -- Events are routines that are triggered in response to actions taken -- by the user of the application - mouse clicks, key presses, resizing -- windows, and so on. ----------------------------------------------------------------------------- --/topic Fonts --/info -- These routines allow you to work with text graphics: displaying text, -- changing the font, and so on. ----------------------------------------------------------------------------- --/topic Graphics --/info -- These are routines that allow you to draw on controls, typically -- a /Window, /Pixmap or /Printer. -- -- The predefined colors are: --/code -- Black, Blue, Green, Cyan, Red, Magenta, Brown -- White, Gray, BrightBlue, BrightGreen, BrightCyan, -- BrightRed, BrightMagenta, Yellow and BrightWhite --/endcode ----------------------------------------------------------------------------- --/topic List Control --/info -- These are routines that let you inspect and alter attributes of -- controls with lists: /Combo, /DropDownList, /List, /SimpleCombo, -- /SortedCombo, /SortedList. -- -- The first item in a list is 1, not 0. This makes it consistant with -- Euphoria's indexing method, but can be a bit confusing if you are -- used to working with zero-based arrays. ----------------------------------------------------------------------------- --/topic Low Level Routines --/info -- These routines give you access to C data structures, the device context, -- and other Win32 API goodies. ----------------------------------------------------------------------------- --/topic Mouse --/info -- These are routines that deal with the mouse and mouse pointer. ----------------------------------------------------------------------------- --/topic Printing --/info -- These are routines that allow you to interact with the /Printer. ----------------------------------------------------------------------------- --/topic Scroll Control --/info -- These routines let you inspect and alter attributes of the scroll -- bar controls /HScroll and /VScroll and track bar controls /HTrackBar -- and /VTrackBar. ----------------------------------------------------------------------------- --/topic Types --/info -- These are data types defined by Win32Lib. ----------------------------------------------------------------------------- --/topic Utilities --/info -- These are routines that didn't seem to fit in any other category. ----------------------------------------------------------------------------- --/topic XPM --/info -- These routines deal with a portable graphics file format called XPM - -- "X Pixmap". XPM graphics can be embedded in programs as text data. include machine.e include dll.e include msgbox.e include file.e include get.e include wildcard.e -- upper case include image.e -- read_bitmap without warning -- with trace object ok ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Generic Tools -- These are routines that I use often enough to wish they were part of -- the standard Euphoria library ----------------------------------------------------------------------------- --/topic Types --/type int( i ) --/desc Same as the declaration integer(). --/ret True if /i i is an integer global type int( integer i ) return 1 end type ----------------------------------------------------------------------------- --/topic Types --/type seq( s ) --/desc Same as the declaration sequence(). --/ret True if /i i is a sequence. global type seq( sequence s ) return 1 end type -- NEW! 0.31 made global ----------------------------------------------------------------------------- --/topic Utilities --/func findKey( key, list ) --/desc Find key in list. --/ret Index of sublist with matching key. -- -- Example: -- --/code -- -- find a value from a list -- integer at -- at = findKey( name, nameList ) --/endcode global function findKey( object key, sequence list ) for i = 1 to length( list ) do if compare( list[i][1], key ) = 0 then return i end if end for return 0 end function ----------------------------------------------------------------------------- function removeIndex( integer index, sequence list ) -- remove item from list at index postition -- ex: removeIndex( 2, "abcd" ) -- --> "acd" return list[1..index-1] & list[index+1..length(list)] end function ----------------------------------------------------------------------------- function iif( atom test, object ifTrue, object ifFalse ) -- returns ifTrue if flag is true, else returns ifFalse -- ex: ? iff( 1, "this", "that" ) -- --> "this" if test then return ifTrue else return ifFalse end if end function -- NEW! 0.42 added for XPM support ------------------------------------------------------------------------------ function removeNth( integer i, sequence s ) -- remove the nth element return s[1..i-1] & s[i+1..length(s)] end function -- NEW! 0.42 added for XPM support ------------------------------------------------------------------------------ function ltrim( sequence s ) -- remove leading spaces integer stopped -- marks where non-space was found stopped = -1 for i = 1 to length( s ) do if s[i] != ' ' then stopped = i exit end if end for if stopped = -1 then -- all spaces return "" else -- trim return s[stopped..length(s)] end if end function ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- DLL Links ----------------------------------------------------------------------------- global function linkDLL(sequence name) -- dynamically link a DLL atom handle -- open the dll handle = open_dll( name ) if handle = NULL then -- give error and abort ok = message_box( "Couldn't find DLL " & name, "Win32Lib Error", MB_ICONHAND+MB_TASKMODAL ) -- abort abort(1) end if return handle end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func linkFunc( dll, name, args, result ) --/desc Dynamically link a C routine as a Euphoria function. --/ret Handle to C function. -- Essentially the same as /i define_c_func, but -- generates an error message and aborts if the routine -- can't be linked to. -- -- Example: --/code -- constant xLoadIcon = linkFunc(user32, "LoadIconA", {C_POINTER, C_POINTER}, C_POINTER) --/endcode global function linkFunc(atom dll, sequence name, sequence args, atom result) -- dynamically link a C routine as a Euphoria function integer handle handle = define_c_func(dll, name, args, result) if handle = -1 then -- give error and abort ok = message_box( "Couldn't link to C function " & name, "Win32Lib Error", MB_ICONHAND+MB_TASKMODAL ) -- abort abort(1) end if return handle end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func linkProc( dll, name, args, result ) --/desc Dynamically link a C routine as a Euphoria procedure. --/ret Handle to C procedure. -- Essentially the same as /i define_c_proc, but -- generates an error message and aborts if the routine -- can't be linked to. -- -- Example: -- --/code -- constant xKillTimer = linkProc(user32, "KillTimer", {C_POINTER, C_UINT}) --/endcode global function linkProc(atom dll, sequence name, sequence args) integer handle handle = define_c_proc(dll, name, args) if handle = -1 then -- give error and abort ok = message_box( "Couldn't link to C procedure " & name, "Win32Lib Error", MB_ICONHAND+MB_TASKMODAL ) -- abort abort(1) end if return handle end function -- get handles to all dll routines that we need global atom user32, -- user interface gdi32, -- graphic device interface winmm, -- multi-media comdlg32, -- common dialogs comctl32, -- common controls kernel32, -- memory shell32 -- shell extentions -- winspool -- windows spool file -- link to the dlls user32 = linkDLL("user32.dll") gdi32 = linkDLL("gdi32.dll") winmm = linkDLL("winmm.dll") comdlg32 = linkDLL("comdlg32.dll") -- NEW! 0.40 common controls comctl32 = linkDLL("comctl32.dll") kernel32 = linkDLL("kernel32.dll") shell32 = linkDLL("shell32.dll") -- winspool = linkDLL("winspool.dll") global constant -- creating windows xLoadIcon = linkFunc(user32, "LoadIconA", {C_POINTER, C_POINTER}, C_POINTER), xGetStockObject = linkFunc(gdi32, "GetStockObject", {C_INT}, C_POINTER), xRegisterClassEx = linkFunc(user32, "RegisterClassExA", {C_POINTER}, C_POINTER), xUnregisterClass = linkFunc(user32, "UnregisterClassA", {C_POINTER, C_POINTER}, C_LONG), xExtractIcon = linkFunc(shell32, "ExtractIconA", {C_INT, C_POINTER, C_INT}, C_INT), xCreateWindow = linkFunc(user32, "CreateWindowExA", {C_LONG,C_POINTER,C_POINTER,C_LONG,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_POINTER,C_POINTER,C_POINTER}, C_UINT), xShowWindow = linkFunc(user32, "ShowWindow", {C_POINTER, C_INT}, C_INT), xUpdateWindow = linkProc(user32, "UpdateWindow", {C_POINTER}), xSetForegroundWindow = linkFunc(user32, "SetForegroundWindow", {C_POINTER}, C_POINTER ), -- NEW! 0.44b -- cursors xLoadCursor = linkFunc(user32, "LoadCursorA", {C_POINTER, C_POINTER}, C_POINTER), xSetCursor = linkFunc(user32, "SetCursor", {C_POINTER}, C_LONG), -- NEW! 0.44e xShowCursor = linkFunc(user32, "ShowCursor", {C_INT}, C_INT), xCreateCursor = linkFunc(user32, "CreateCursor", {C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_POINTER}, C_POINTER), xDestroyCursor = linkFunc(user32, "DestroyCursor", {C_POINTER}, C_LONG), -- class addresses xGetClassLong = linkFunc(user32, "GetClassLongA", {C_POINTER, C_INT}, C_POINTER), xSetClassLong = linkFunc(user32, "SetClassLongA", {C_POINTER, C_INT, C_LONG}, C_POINTER), -- message passing xGetMessage = linkFunc(user32, "GetMessageA", {C_POINTER,C_POINTER,C_UINT,C_UINT}, C_INT), xTranslateMessage = linkProc(user32, "TranslateMessage", {C_INT}), xDispatchMessage = linkProc(user32, "DispatchMessageA", {C_POINTER}), xSendMessage = linkFunc(user32, "SendMessageA", {C_POINTER, C_UINT, C_LONG, C_LONG}, C_LONG), -- sound support -- NEW! 0.44d now a function xPlaySound = linkFunc(winmm, "PlaySound", {C_INT, C_INT, C_INT}, C_INT), -- device context xSelectObject = linkFunc(gdi32, "SelectObject", {C_POINTER, C_POINTER}, C_POINTER), xGetClientRect = linkFunc(user32, "GetClientRect", {C_POINTER, C_POINTER}, C_INT), xDrawText = linkProc(user32, "DrawTextA", {C_POINTER,C_POINTER,C_INT,C_POINTER,C_UINT} ), xPostQuitMessage = linkProc(user32, "PostQuitMessage", {C_INT}), xDefWindowProc = linkFunc(user32, "DefWindowProcA", {C_POINTER,C_UINT,C_LONG,C_LONG}, C_POINTER ), xCreateDC = linkFunc(gdi32, "CreateDCA", repeat( C_POINTER, 4 ), C_LONG), xGetDC = linkFunc(user32, "GetDC", {C_POINTER}, C_UINT), xReleaseDC = linkFunc(user32, "ReleaseDC", {C_POINTER, C_POINTER}, C_INT), xMoveToEx = linkFunc(gdi32, "MoveToEx", {C_POINTER, C_INT, C_INT, C_POINTER}, C_LONG), -- update window support xBeginPaint = linkFunc(user32, "BeginPaint", {C_POINTER, C_POINTER}, C_INT), xEndPaint = linkProc(user32, "EndPaint", {C_POINTER, C_POINTER}), xGetUpdateRect = linkFunc(user32, "GetUpdateRect", {C_POINTER, C_POINTER, C_LONG}, C_LONG), xGetUpdateRgn = linkFunc(user32, "GetUpdateRgn", {C_POINTER, C_POINTER, C_LONG}, C_LONG), xExcludeUpdateRgn = linkFunc(user32, "ExcludeUpdateRgn", {C_POINTER, C_POINTER}, C_LONG), xInvalidateRect = linkFunc(user32, "InvalidateRect", {C_POINTER, C_POINTER, C_LONG}, C_LONG), xValidateRect = linkFunc(user32, "ValidateRect", {C_POINTER, C_POINTER}, C_LONG), xInvalidateRgn = linkFunc(user32, "InvalidateRgn", {C_POINTER, C_POINTER, C_LONG}, C_LONG), xValidateRgn = linkFunc(user32, "ValidateRgn", {C_POINTER, C_POINTER}, C_LONG), xRedrawWindow = linkFunc(user32, "RedrawWindow", {C_POINTER, C_POINTER, C_POINTER, C_UINT}, C_LONG), -- graphics xCreatePen = linkFunc(gdi32, "CreatePen", {C_INT, C_INT, C_LONG}, C_LONG), xCreateSolidBrush = linkFunc(gdi32, "CreateSolidBrush", {C_POINTER}, C_LONG), xLineTo = linkFunc(gdi32, "LineTo", {C_POINTER, C_INT, C_INT}, C_LONG), xGetPixel = linkFunc(gdi32, "GetPixel", {C_POINTER, C_INT, C_INT}, C_LONG), xSetPixel = linkFunc(gdi32, "SetPixel", {C_POINTER, C_INT, C_INT, C_LONG}, C_LONG), xRectangle = linkFunc(gdi32, "Rectangle", {C_POINTER, C_INT, C_INT, C_INT, C_LONG}, C_LONG), xRoundRect = linkFunc(gdi32, "RoundRect", {C_POINTER, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT}, C_LONG), xEllipse = linkFunc(gdi32, "Ellipse", {C_POINTER, C_INT, C_INT, C_INT, C_INT}, C_LONG), xArc = linkFunc(gdi32, "Arc", {C_POINTER, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT}, C_LONG), xChord = linkFunc(gdi32, "Chord", {C_POINTER, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT}, C_LONG), xPie = linkFunc(gdi32, "Pie", {C_POINTER, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT, C_INT}, C_LONG), xPolygon = linkFunc(gdi32, "Polygon", {C_POINTER, C_POINTER, C_INT}, C_LONG), -- timers xSetTimer = linkProc(user32, "SetTimer", {C_POINTER,C_UINT,C_UINT,C_POINTER} ), xKillTimer = linkProc(user32, "KillTimer", {C_POINTER, C_UINT}), -- text xTextOut = linkProc(gdi32, "TextOutA", {C_POINTER, C_INT, C_INT, C_POINTER, C_INT}), xSetWindowText = linkFunc(user32, "SetWindowTextA", {C_POINTER, C_POINTER}, C_INT), xGetWindowText = linkFunc(user32, "GetWindowTextA", {C_POINTER, C_POINTER, C_INT}, C_INT), xGetWindowTextLength= linkFunc(user32, "GetWindowTextLengthA", {C_POINTER}, C_INT), xEnableWindow = linkProc(user32, "EnableWindow", {C_POINTER, C_LONG}), xIsWindowVisible = linkFunc(user32, "IsWindowVisible", {C_POINTER}, C_INT), xIsWindowEnabled = linkFunc(user32, "IsWindowEnabled", {C_POINTER}, C_INT), xGetKeyState = linkFunc(user32, "GetKeyState", {C_INT}, C_INT), xSetFocus = linkProc(user32, "SetFocus", {C_POINTER} ), xGetWindowLong = linkFunc(user32, "GetWindowLongA", {C_POINTER, C_INT}, C_LONG ), xSetWindowLong = linkFunc(user32, "SetWindowLongA", {C_POINTER, C_INT, C_LONG}, C_INT), xCallWindowProc = linkFunc(user32, "CallWindowProcA", {C_POINTER, C_POINTER, C_UINT, C_LONG, C_LONG}, C_LONG), -- menus xLoadMenu = linkFunc(user32, "LoadMenuA", {C_POINTER, C_POINTER}, C_LONG), xLoadMenuIndirect = linkFunc(user32, "LoadMenuIndirectA", {C_POINTER}, C_POINTER), xGetMenu = linkFunc(user32, "GetMenu", {C_POINTER}, C_POINTER), xSetMenu = linkFunc(user32, "SetMenu", {C_POINTER, C_POINTER}, C_LONG), xHiliteMenuItem = linkFunc(user32, "HiliteMenuItem", {C_POINTER, C_POINTER, C_UINT, C_UINT}, C_LONG), xGetMenuString = linkFunc(user32, "GetMenuStringA", {C_POINTER, C_UINT, C_POINTER, C_INT, C_UINT}, C_LONG), xGetMenuState = linkFunc(user32, "GetMenuState", {C_POINTER, C_UINT, C_UINT}, C_LONG), xDrawMenuBar = linkFunc(user32, "DrawMenuBar", {C_POINTER}, C_LONG), xGetSystemMenu = linkFunc(user32, "GetSystemMenu", {C_POINTER, C_LONG}, C_POINTER), xCreateMenu = linkFunc(user32, "CreateMenu", {}, C_POINTER), xCreatePopupMenu = linkFunc(user32, "CreatePopupMenu", {}, C_POINTER), xDestroyMenu = linkFunc(user32, "DestroyMenu", {C_POINTER}, C_LONG), xCheckMenuItem = linkFunc(user32, "CheckMenuItem", {C_POINTER, C_UINT, C_UINT}, C_LONG), xEnableMenuItem = linkFunc(user32, "EnableMenuItem", {C_POINTER, C_UINT, C_UINT}, C_LONG), xGetSubMenu = linkFunc(user32, "GetSubMenu", {C_POINTER, C_INT}, C_POINTER), xGetMenuItemID = linkFunc(user32, "GetMenuItemID", {C_POINTER, C_INT}, C_UINT), xGetMenuItemCount = linkFunc(user32, "GetMenuItemCount", {C_POINTER}, C_INT), xInsertMenu = linkFunc(user32, "InsertMenuA", {C_POINTER, C_UINT, C_UINT, C_UINT, C_POINTER}, C_LONG), xAppendMenu = linkFunc(user32, "AppendMenuA", {C_POINTER, C_UINT, C_UINT, C_POINTER}, C_POINTER), xModifyMenu = linkFunc(user32, "ModifyMenuA", {C_POINTER, C_UINT, C_UINT, C_UINT, C_POINTER}, C_LONG), xRemoveMenu = linkFunc(user32, "RemoveMenu", {C_POINTER, C_UINT, C_UINT}, C_LONG), xDeleteMenu = linkFunc(user32, "DeleteMenu", {C_POINTER, C_UINT, C_UINT}, C_LONG), xSetMenuItemBitmaps = linkFunc(user32, "SetMenuItemBitmaps", {C_LONG, C_UINT, C_UINT, C_POINTER, C_POINTER}, C_LONG), xGetMenuCheckMarkDimensions = linkFunc(user32, "GetMenuCheckMarkDimensions", {}, C_LONG), xTrackPopupMenu = linkFunc(user32, "TrackPopupMenu", {C_POINTER, C_UINT, C_INT, C_INT, C_INT, C_POINTER, C_POINTER}, C_LONG), -- messages xPostMessage = linkFunc(user32, "PostMessageA", {C_POINTER, C_UINT, C_INT, C_LONG}, C_LONG), -- used by EZ_FONT xSaveDC = linkFunc(gdi32, "SaveDC", {C_POINTER}, C_INT), xSetGraphicsMode = linkFunc(gdi32, "SetGraphicsMode", {C_POINTER, C_INT}, C_INT), xModifyWorldTransform = linkFunc(gdi32, "ModifyWorldTransform", {C_POINTER, C_POINTER, C_LONG}, C_LONG), xSetViewportOrgEx = linkFunc(gdi32, "SetViewportOrgEx", {C_POINTER, C_INT, C_INT, C_POINTER}, C_LONG), xSetWindowOrgEx = linkFunc(gdi32, "SetWindowOrgEx", {C_POINTER, C_INT, C_INT, C_POINTER}, C_LONG), xGetDeviceCaps = linkFunc(gdi32, "GetDeviceCaps", {C_POINTER, C_INT}, C_INT), xDPtoLP = linkFunc(gdi32, "DPtoLP", {C_POINTER, C_POINTER, C_INT}, C_LONG), xCreateFontIndirect = linkFunc(gdi32, "CreateFontIndirectA", {C_POINTER}, C_POINTER), xGetTextMetrics = linkFunc(gdi32, "GetTextMetricsA", {C_POINTER, C_POINTER}, C_LONG), xDeleteObject = linkFunc(gdi32, "DeleteObject", {C_POINTER}, C_LONG), xRestoreDC = linkFunc(gdi32, "RestoreDC", {C_POINTER, C_INT}, C_LONG), xGetTextExtentPoint = linkFunc(gdi32, "GetTextExtentPoint32A", {C_POINTER, C_POINTER, C_INT, C_POINTER}, C_LONG), -- NEW! 0.41 for tooltips xMapWindowPoints = linkFunc(user32, "MapWindowPoints", {C_POINTER, C_POINTER, C_POINTER, C_INT}, C_INT), xGetCursorPos = linkFunc(user32, "GetCursorPos", {C_POINTER}, C_INT), -- graphic modes xSetMapMode = linkFunc(gdi32, "SetMapMode", {C_POINTER, C_INT}, C_INT), xGetMapMode = linkFunc(gdi32, "GetMapMode", {C_POINTER}, C_INT), xGetObject = linkFunc(gdi32, "GetObjectA", {C_POINTER, C_INT, C_POINTER}, C_INT), xCreatePalette = linkFunc(gdi32, "CreatePalette", {C_POINTER}, C_POINTER), -- system colors xGetSysColor = linkFunc(user32, "GetSysColor", {C_INT}, C_LONG), xSetSysColors = linkFunc(user32, "SetSysColors", {C_INT, C_POINTER, C_LONG}, C_LONG), -- bitmap graphics xGetWindowExtEx = linkFunc(gdi32, "GetWindowExtEx", {C_POINTER, C_POINTER}, C_LONG), xCreateCompatibleBitmap = linkFunc(gdi32, "CreateCompatibleBitmap", {C_POINTER, C_INT, C_INT}, C_POINTER), xSetBitmapBits = linkFunc(gdi32, "SetBitmapBits", {C_POINTER, C_LONG, C_POINTER}, C_LONG), xSelectPalette = linkFunc(gdi32, "SelectPalette", {C_POINTER, C_POINTER, C_LONG}, C_POINTER), xRealizePalette = linkFunc(gdi32, "RealizePalette", {C_POINTER}, C_UINT), xSetDIBitsToDevice = linkFunc(gdi32, "SetDIBitsToDevice", {C_POINTER, C_INT, C_INT, C_LONG, C_LONG, C_INT, C_INT, C_UINT, C_UINT, C_POINTER, C_POINTER, C_UINT}, C_INT), xStretchDIBits = linkFunc(gdi32, "StretchDIBits", {C_POINTER,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_POINTER,C_UINT,C_LONG},C_INT), xBitBlt = linkFunc(gdi32, "BitBlt", {C_POINTER,C_INT,C_INT,C_INT,C_INT,C_POINTER,C_INT,C_INT,C_LONG},C_LONG), xSetROP2 = linkFunc(gdi32, "SetROP2", {C_POINTER, C_LONG}, C_LONG ), xCreateCompatibleDC = linkFunc(gdi32, "CreateCompatibleDC", {C_POINTER}, C_POINTER), xDeleteDC = linkFunc(gdi32, "DeleteDC", {C_POINTER}, C_POINTER), xCreateBitmap = linkFunc(gdi32, "CreateBitmap", {C_INT, C_INT, C_UINT, C_UINT, C_POINTER}, C_POINTER), xCreateBitmapIndirect = linkFunc(gdi32, "CreateBitmapIndirect", {C_POINTER}, C_POINTER), xCreateDIBitmap = linkFunc(gdi32, "CreateDIBitmap", {C_POINTER, C_POINTER, C_LONG, C_LONG, C_POINTER, C_LONG}, C_LONG ), xLoadImage = linkFunc(user32, "LoadImageA",{C_POINTER, C_POINTER, C_UINT, C_INT, C_INT, C_UINT}, C_POINTER ), -- scroll bars xSetScrollPos = linkFunc(user32, "SetScrollPos", {C_POINTER, C_INT, C_INT, C_LONG}, C_INT), xGetScrollPos = linkFunc(user32, "GetScrollPos", {C_POINTER, C_INT}, C_INT), xSetScrollRange = linkFunc(user32, "SetScrollRange", {C_POINTER, C_INT, C_INT, C_INT, C_LONG}, C_LONG), xGetScrollRange = linkFunc(user32, "GetScrollRange", {C_POINTER, C_INT, C_POINTER, C_POINTER}, C_LONG), xShowScrollBar = linkFunc(user32, "ShowScrollBar", {C_POINTER, C_INT, C_LONG}, C_LONG), xEnableScrollBar = linkFunc(user32, "EnableScrollBar", {C_POINTER, C_UINT, C_UINT}, C_LONG), xSetScrollInfo = linkFunc(user32, "SetScrollInfo", {C_POINTER, C_INT, C_POINTER, C_LONG}, C_INT), xGetScrollInfo = linkFunc(user32, "SetScrollInfo", {C_POINTER, C_INT, C_POINTER}, C_POINTER), -- extending the text attributes xSetTextColor = linkFunc(gdi32, "SetTextColor", {C_POINTER, C_LONG}, C_LONG), xSetTextAlign = linkFunc(gdi32, "SetTextAlign", {C_POINTER, C_UINT}, C_UINT), xSetTextJustification = linkFunc(gdi32, "SetTextJustification", {C_POINTER, C_INT, C_INT}, C_LONG), xSetBkColor = linkFunc(gdi32, "SetBkColor", {C_POINTER, C_LONG}, C_LONG), xSetBkMode = linkFunc(gdi32, "SetBkMode", {C_POINTER, C_INT}, C_INT), xGetBkColor = linkFunc(gdi32, "GetBkColor", {C_POINTER}, C_LONG), xGetWindowRect = linkFunc(user32, "GetWindowRect", {C_POINTER, C_POINTER}, C_LONG), -- DPtoLP = linkFunc(gdi32, "DPtoLP", {C_LONG, C_POINTER, C_LONG}, C_LONG), -- common dialogs xGetOpenFileName = linkFunc(comdlg32, "GetOpenFileNameA", {C_POINTER}, C_LONG), xGetSaveFileName = linkFunc(comdlg32, "GetSaveFileNameA", {C_POINTER}, C_LONG), xGetFileTitle = linkFunc(comdlg32, "GetFileTitleA", {C_POINTER, C_POINTER, C_INT}, C_INT), -- NEW! 0.45m xChooseFont = linkFunc(comdlg32, "ChooseFontA", {C_POINTER},C_LONG), -- NEW! 0.43 xPrintDlg = linkFunc(comdlg32, "PrintDlgA", {C_POINTER}, C_LONG), xStartDoc = linkFunc(gdi32, "StartDocA", {C_LONG, C_POINTER}, C_LONG), xStartPage = linkFunc(gdi32, "StartPage", {C_LONG}, C_LONG), xEndPage = linkFunc(gdi32, "EndPage", {C_LONG}, C_LONG), xEndDoc = linkFunc(gdi32, "EndDoc", {C_LONG}, C_LONG), xAbortDoc = linkFunc(gdi32, "AbortDoc", {C_LONG}, C_LONG), -- memory xGlobalAlloc = linkFunc(kernel32, "GlobalAlloc", {C_UINT, C_LONG}, C_POINTER), xGlobalFree = linkFunc(kernel32, "GlobalFree", {C_POINTER}, C_POINTER), -- position of windows xGetViewportOrgEx = linkFunc(gdi32, "GetViewportOrgEx", {C_POINTER, C_POINTER}, C_LONG), xClientToScreen = linkFunc(user32, "ClientToScreen", {C_POINTER, C_POINTER}, C_LONG), xScreenToClient = linkFunc(user32, "ScreenToClient", {C_POINTER, C_POINTER}, C_LONG), xCloseWindow = linkFunc(user32, "CloseWindow", {C_POINTER}, C_LONG), xMoveWindow = linkFunc(user32, "MoveWindow", {C_POINTER, C_INT, C_INT, C_INT, C_INT, C_LONG}, C_LONG), xSetWindowPos = linkFunc(user32, "SetWindowPos", {C_POINTER, C_POINTER, C_INT, C_INT, C_INT, C_INT, C_UINT}, C_LONG), xGetWindowPlacement = linkFunc(user32, "GetWindowPlacement", {C_POINTER, C_POINTER}, C_LONG), xSetWindowPlacement = linkFunc(user32, "SetWindowPlacement", {C_POINTER, C_POINTER}, C_LONG), xDestroyWindow = linkFunc(user32, "DestroyWindow", {C_POINTER}, C_LONG), -- NEW! 0.41 xGetActiveWindow = linkFunc(user32, "GetActiveWindow", {}, C_POINTER ), -- rectangles xDrawFocusRect = linkFunc(user32, "DrawFocusRect", {C_POINTER, C_POINTER}, C_LONG), xDrawFrameControl = linkFunc(user32, "DrawFrameControl", {C_POINTER, C_POINTER, C_UINT, C_UINT}, C_LONG), -- carets xCreateCaret = linkFunc(user32, "CreateCaret", {C_POINTER, C_POINTER, C_LONG, C_LONG}, C_LONG ), xGetCaretBlinkTime = linkFunc(user32, "GetCaretBlinkTime", {}, C_LONG ), xSetCaretBlinkTime = linkFunc(user32, "SetCaretBlinkTime", {C_LONG}, C_LONG ), xDestroyCaret = linkFunc(user32, "DestroyCaret", {}, C_LONG ), xHideCaret = linkFunc(user32, "HideCaret", {C_POINTER}, C_LONG ), xShowCaret = linkFunc(user32, "ShowCaret", {C_POINTER}, C_LONG ), xSetCaretPos = linkFunc(user32, "SetCaretPos", {C_LONG, C_LONG}, C_LONG ), xGetCaretPos = linkFunc(user32, "GetCaretPos", {C_POINTER}, C_LONG ), xSetCapture = linkFunc(user32,"SetCapture",{C_UINT},C_INT), xReleaseCapture = linkProc(user32,"ReleaseCapture",{}), -- NEW! 0.40 common controls xInitCommonControls = linkProc(comctl32,"InitCommonControls",{}), -- NEW! 0.45k color dialog xColorDlg = linkFunc(comdlg32, "ChooseColorA", {C_POINTER}, C_LONG), -- NEW! 0.44b xGetSystemMetrics = linkFunc(user32, "GetSystemMetrics", {C_INT},C_LONG), xShellExecute = linkFunc( shell32, "ShellExecuteA", {C_LONG, C_LONG, C_LONG, C_LONG, C_LONG, C_LONG}, C_LONG ), -- NEW! 0.45k xDragQueryFile = linkFunc(shell32, "DragQueryFileA", {C_POINTER, C_INT, C_POINTER, C_INT}, C_INT) ----------------------------------------------------------------------------- -- NEW! 0.40 global constant True = 1, False = 0 ----------------------------------------------------------------------------- -- NEW! 0.40 initialize common controls c_proc( xInitCommonControls, {} ) ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- ERROR HANDLING -- NEW! 0.45j integer xCleanUp, -- the "clean up" routine showWarnings -- if false, suppresses warning messages xCleanUp = -1 -- defined later showWarnings = True -- display warning messages ----------------------------------------------------------------------------- --/topic Utilities --/proc abortErr( message ) --/desc Display an error message, and abort. -- -- Example: -- --/code -- abortErr( "Fatal error. Bummer, dude." ) --/endcode global procedure abortErr( sequence s ) -- give message ok = message_box( s, "Win32Lib Error", MB_ICONHAND+MB_TASKMODAL ) -- clean up if xCleanUp > -1 then call_proc( xCleanUp, {} ) end if ok = 1/0 -- abort abort(0) end procedure ----------------------------------------------------------------------------- --/topic Utilities --/proc warnErr( message ) --/desc Display an error message, with option to abort. -- -- Example: -- --/code -- warnErr( "Bad data. Abort program?" ) --/endcode global procedure warnErr( sequence s ) -- give message if flag set -- NEW! 0.45j added ShowWarnings flag if showWarnings then if message_box( s, "Win32Lib Error", MB_ICONHAND+MB_TASKMODAL+MB_OKCANCEL ) = IDCANCEL then if xCleanUp > -1 then call_proc( xCleanUp, {} ) end if -- abort abort(0) end if end if end procedure -- NEW! 0.45j ----------------------------------------------------------------------------- --/topic Utilities --/proc setWarning( flag ) --/desc Hides warning messages from user. -- Since 'warning' messages (triggered by /warnErr) are only warnings and -- not fatal, it may be advantageous to suppress them in an application. -- -- Example: -- --/code -- -- suppress warning messages -- setWarning( False ) --/endcode global procedure setWarning( integer flag ) -- show or suppress warnErr messages showWarnings = flag end procedure ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- MATH ----------------------------------------------------------------------------- --/topic Low Level Routines --/func or_all( s ) --/desc Performs /i or_bits on all the elements of the sequence. --/ret OR'd value of sequence elements. -- -- Typically used to combine a series of attribute -- flags together. -- -- Example: -- -- /code -- -- combine flags -- integer flags -- flags = or_all( { WS_CHILD, WS_VISIBLE, BS_PUSHBUTTON, WS_TABSTOP} ) -- /endcode global function or_all(sequence s) -- or together all elements of a sequence atom result result = 0 for i = 1 to length(s) do result = or_bits(result, s[i]) end for return result end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func lo_word( a ) --/desc Get low portion of number. --/ret Low 16 bits of a 32 bit word. -- Typically used to decode Win32 message values when several values -- are packed into a single number. -- -- Example: -- -- /code -- -- extract the low portion from lParam -- integer x -- x = lo_word( lParam ) -- /endcode global function lo_word( atom a ) -- return low word return and_bits( a, #FFFF ) end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func hi_word( a ) --/desc Returns high portion of word. --/ret High 16 bits of a 32 bit word. -- Typically used to decode Win32 message values when several values -- are packed into a single number. -- -- Example: -- -- /code -- -- extract the high portion from lParam -- integer y -- y = hi_word( lParam ) -- /endcode global function hi_word( atom a ) -- return high word return floor(a/power(2, 16)) end function -- NEW! 0.45f ----------------------------------------------------------------------------- --/topic Low Level Routines --/func pack_word( low, high ) --/desc Packs values into word. --/ret 32 bit word with low value in low 16 bits, high value in high 16 bits. -- Typically used to encode a message parameter into a 32 bit word. -- -- Example: -- -- /code -- -- pack min and max into parameter -- integer y -- lParam = pack_word( min, max ) -- /endcode global function pack_word( integer low, integer high ) -- return packed 32 bit value -- mask values low = and_bits( low, #FFFF ) high = and_bits( high, #FFFF ) -- pack values return ( high * #10000 ) + low end function ----------------------------------------------------------------------------- --/topic Utilities --/func abs( a ) --/desc Absolute value. --/ret Absolute value of the atom. global function abs( atom a ) if a < 0 then return -a else return a end if end function ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- FILE I/O ----------------------------------------------------------------------------- function readBytes( integer hFile, integer size ) -- read bytes from file sequence s s = repeat( 0, size ) for i = 1 to size do s[i] = getc( hFile ) end for return s end function ----------------------------------------------------------------------------- function readLong( integer hFile ) -- read a Long from the file return bytes_to_int( readBytes( hFile, 4 ) ) end function ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- DATA topic Low Level Routines ----------------------------------------------------------------------------- sequence strings -- stores addresses of strings used in topic Low Level Routines strings = {} ----------------------------------------------------------------------------- function allot_string( sequence s ) -- allocate a string for a structure atom at -- place string in memory at = allocate_string( s ) if at = 0 then -- out of string space abortErr( "Unable to allocate string space." ) end if -- save location for garbage collection strings = append( strings, at ) -- return the address return at end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/proc free_strings() --/desc Free strings created by /store. -- Free any strings that have been allocated to the structure. If the -- structure uses any /b Lpsz data types, you should call -- /free_strings when you free the structure. -- -- Example: -- --/code -- -- call Win32 StartDoc routine -- atom di, result -- -- -- allocate the structure -- di = allocate_struct( SIZEOF_DOCINFO ) -- -- -- store the values -- store( di, DOCINFO_cbSize, SIZEOF_DOCINFO ) -- store( di, DOCINFO_lpszDocName, job ) -- -- result = c_func( xStartDoc, { printerDC, di } ) -- -- -- free the structure -- free( di ) -- free_strings() --/endcode global procedure free_strings() -- for each allocated string... for i = 1 to length( strings ) do -- ...free string free( strings[i] ) end for -- clear the address list strings = {} end procedure ----------------------------------------------------------------------------- global constant Byte = -1, Word = -2, Integer = Word, Long = -3, -- NEW! 0.45m renamed Dword to DWord DWord = Long, -- NEW! 0.45f UInt = Long, Lpsz = -4, -- NEW! 0.45m Ptr = Long integer allottedSize allottedSize = 0 ----------------------------------------------------------------------------- --/topic Low Level Routines --/func allot( i ) --/desc Allocate space in structure for a new field. --/ret Pointer to allotted memory. -- Allowable types are: -- /li /b Byte: 8 bit value -- /li /b Word: 16 bit value -- /li /b Integer: 16 bit value, save as /b Word -- /li /b Long: 32 bit value -- /li /b DWord: 32 bit value, same as /b Long -- /li /b Ptr: 32 bit value, same as /b Long -- /li /b Lpsz: Long pointer (32 bits) to zero delimited string -- -- Example: -- -- /code -- global constant -- rectLeft = /allot( Long ), -- rectTop = /allot( Long ), -- rectRight = /allot( Long ), -- rectBottom = /allot( Long ), -- SIZEOF_RECT = /allotted_size() -- /endcode global function allot( integer i ) integer soFar, diff, size -- save position soFar = allottedSize -- if not a pre-defined type, make sure it gets a word boundary if i > 0 then diff = remainder( soFar, 4 ) if diff then -- word align soFar = soFar + 4 - diff end if -- size is actual size size = i elsif i = Byte then size = 1 elsif i = Word then size = 2 elsif i = Long then size = 4 elsif i = Lpsz then size = 4 end if -- allot space allottedSize = allottedSize + size -- return size and data type return { soFar, i } end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func allotted_size() --/desc Return allocate size of structure, and reset for new structure. --/ret Allotted size of structure. -- -- Example: -- -- /code -- global constant -- rectLeft = /allot( Long ), -- rectTop = /allot( Long ), -- rectRight = /allot( Long ), -- rectBottom = /allot( Long ), -- SIZEOF_RECT = /allotted_size() -- /endcode global function allotted_size() -- returns allotted size, and clears size integer soFar soFar = allottedSize allottedSize = 0 return soFar end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/proc store( structure, field, value ) --/desc Store a value into a structure. -- Type conversion is automatic. For example, if an /b Lpsz field is -- used, the value is automatically converted from a sequence to a -- C-style string, and the address of that string is stored in the -- structure. -- -- /b Note: Strings are allotted using /i allot_string(), and -- must be freed using /free_string. -- -- Example: -- --/code -- -- allocate RECT structure, and populate it -- atom rect -- -- -- allocate the structure -- rect = /allocate_struct( SIZEOF_RECT ) -- -- -- store values into the structure -- /store( rect, rectLeft, x1 ) -- /store( rect, rectTop, y1 ) -- /store( rect, rectRight, x2 ) -- /store( rect, rectBottom, y2 ) --/endcode global procedure store( atom struct, sequence s, object o ) -- fetch the data based on the type integer offset, size -- rest data type offset = s[1] size = s[2] -- read, based on size if size = Byte then -- poke a byte poke( struct+offset, o ) elsif size = Word then -- poke a word s = int_to_bytes( o ) poke( struct+offset, s[1..2] ) elsif size = Long then -- poke a long poke4( struct+offset, o ) elsif size = Lpsz then -- if atom, treat as long if atom( o ) then poke4( struct+offset, o ) else -- poke the address of the allotted string poke4( struct+offset, allot_string( o ) ) end if else -- poke a string poke( struct+offset, o ) end if end procedure ----------------------------------------------------------------------------- --/topic Low Level Routines --/func peek_string( address ) --/desc Get sequence from address holding C-style string. --/ret Sequence containing the C-style string. -- This is typically done automatically by the /fetch -- function. -- -- Example: -- --/code -- -- get a C-string from address -- sequence s -- -- s = /peek_string( address ) --/endcode global function peek_string(atom a) integer i sequence s s = "" if a then i = peek(a) while i do s = append(s, i) a = a + 1 i = peek(a) end while end if return s end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func fetch( structure address, field ) --/desc Fetch field from structure. --/ret Field from a structure. -- Data conversion is automatic. For example, if the field is -- an /b Lpsz, a sequence containing the string will automatically -- be returned. -- -- Example: -- /code -- -- fetch the average character width from the text metrics structure -- width = /fetch( tm, tmAveCharWidth ) -- /endcode global function fetch( atom struct, sequence s ) -- fetch the data based on the type integer size, char atom at -- address is struct + offset at = struct + s[1] -- get data size size = s[2] -- read, based on size if size = Byte then -- return byte return peek( at ) elsif size = Word then -- return word return bytes_to_int( peek({at, 2}) & {0, 0} ) elsif size = Long then -- return long return peek4s( at ) elsif size = Lpsz then -- get the pointer at = peek4u(at) -- return the string return peek_string( at ) else -- return the string return( peek( {at, size} ) ) end if end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func allocate_struct( structure ) --/desc Allocate memory for structure, and initialize to zero. --/ret Address of allocated structure. -- -- Example: -- /code -- atom pt -- -- -- allocate a point structure -- pt = /allocate_struct( SIZEOF_POINT ) -- /endcode global function allocate_struct( integer size ) -- allocate space for a structure -- and initialize to zero atom at at = allocate( size ) mem_set( at, 0, size ) return at end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/func address( structure address, field ) --/desc Get address of /i field in structure. --/ret Address of the field in the structure. -- This is typically used if the structure contains an array of topic Low Level Routines. -- -- In this snippet, the /b memBitmapInfo structure contains an array -- of /b RGBQUAD colors. The array is populated with the values in -- the pal: -- -- /code -- -- get the start of the rgbQuad array -- rgbQuad = /address( memBitmapInfo, bmiColors ) -- -- -- copy the pal to memory -- for i = 1 to colors do -- -- -- store values -- /store( rgbQuad, rgbRed, pal[i][1] ) -- /store( rgbQuad, rgbGreen, pal[i][2] ) -- /store( rgbQuad, rgbBlue, pal[i][3] ) -- /store( rgbQuad, rgbReserved, 0 ) -- -- -- move to next quad -- rgbQuad += SIZEOF_RGBQUAD -- -- end for -- -- /endcode global function address( atom addr, object o ) -- return address in structure if atom( o ) then return addr + o else return addr + o[1] end if end function ----------------------------------------------------------------------------- function loadStructFromFile( integer hFile, atom into, integer bytes ) -- load structure on file directly into a memory structure sequence s -- the sequence will hold the data temporarily s = repeat( 0, bytes ) -- for each byte in the structure for i = 1 to bytes do -- get a byte from the file s[i] = getc( hFile ) end for -- look for a -1 if find( -1, s ) then -- end of file, return failure return 0 end if -- load structure poke( into, s ) -- return success return 1 end function ----------------------------------------------------------------------------- -- defining a window global constant winExSize = allot( Long ), winExStyle = allot( Long ), winExProc = allot( Long ), winExClsExtra = allot( Long ), winExExtra = allot( Long ), winExInstance = allot( Long ), winExIcon = allot( Long ), winExCursor = allot( Long ), winExBackground = allot( Long ), winExMenuName = allot( Lpsz ), winExClassName = allot( Lpsz ), winExIconSm = allot( Long ), SIZEOF_WNDCLASSEX = allotted_size(), SIZEOF_MESSAGE = 40, ----------------------------------------------------------------------------- -- Type RECT rectLeft = allot( Long ), rectTop = allot( Long ), rectRight = allot( Long ), rectBottom = allot( Long ), SIZEOF_RECT = allotted_size(), ----------------------------------------------------------------------------- -- Type PAINTSTRUCT psHdc = allot( Long ), psErase = allot( Long ), psPaintRect = allot( SIZEOF_RECT ), psRestore = allot( Long ), psIncUpdate = allot( Long ), psRgbReserved = allot( 32 ), SIZEOF_PAINTSTRUCT = allotted_size(), ----------------------------------------------------------------------------- -- defining a font lfHeight = allot( Long ), lfWidth = allot( Long ), lfEscapement = allot( Long ), lfOrientation = allot( Long ), lfWeight = allot( Long ), lfItalic = allot( Byte ), lfUnderline = allot( Byte ), lfStrikeOut = allot( Byte ), lfCharSet = allot( Byte ), lfOutPrecision = allot( Byte ), lfClipPrecision = allot( Byte ), lfQuality = allot( Byte ), lfPitchAndFamily = allot( Byte ), lfFaceName = allot( 32 ), SIZEOF_LOGFONT = allotted_size(), ----------------------------------------------------------------------------- -- Type TEXTMETRIC tmHeight = allot( Long ), tmAscent = allot( Long ), tmDescent = allot( Long ), tmInternalLeading = allot( Long ), tmExternalLeading = allot( Long ), tmAveCharWidth = allot( Long ), tmMaxCharWidth = allot( Long ), tmWeight = allot( Long ), tmOverhang = allot( Long ), tmDigitizedAspectX = allot( Long ), tmDigitizedAspectY = allot( Long ), tmFirstChar = allot( Byte ), tmLastChar = allot( Byte ), tmDefaultChar = allot( Byte ), tmBreakChar = allot( Byte ), tmItalic = allot( Byte ), tmUnderlined = allot( Byte ), tmStruckOut = allot( Byte ), tmPitchAndFamily = allot( Byte ), tmCharSet = allot( Byte ), ntmFlags = allot( Long ), ntmSizeEM = allot( Long ), ntmCellHeight = allot( Long ), ntmAveWidth = allot( Long ), SIZEOF_TEXTMETRIC = allotted_size(), ----------------------------------------------------------------------------- -- Type POINT ptX = allot( Long ), ptY = allot( Long ), SIZEOF_POINT = allotted_size(), -- 8 ----------------------------------------------------------------------------- -- NEW! 0.41 -- Type MSG msgHWnd = allot( Long ), msgMessage = allot( Integer ), msgWParam = allot( Long ), msgLParam = allot( Long ), msgTime = allot( Long ), msgPt = allot( SIZEOF_POINT ), SIZEOF_MSG = allotted_size(), ----------------------------------------------------------------------------- -- Type SIZE sizX = allot( Long ), sizY = allot( Long ), SIZEOF_SIZE = allotted_size(), ----------------------------------------------------------------------------- -- Type BITMAP bmType = allot( Long ), bmWidth = allot( Long ), bmHeight = allot( Long ), bmWidthBytes = allot( Long ), bmPlanes = allot( Word ), bmBitsPixel = allot( Word ), bmBits = allot( Long ), SIZEOF_BITMAP = allotted_size(), ----------------------------------------------------------------------------- -- Type BITMAPFILEHEADER bfType = allot( 2 ), bfSize = allot( DWord ), bfReserved1 = allot( Word ), bfReserved2 = allot( Word ), bfOffBits = allot( DWord ), SIZEOF_BITMAPFILEHEADER = allotted_size(), ----------------------------------------------------------------------------- -- Type BITMAPINFOHEADER biSize = allot( DWord ), biWidth = allot( Long ), biHeight = allot( Long ), biPlanes = allot( Word ), biBitCount = allot( Word ), biCompression = allot( DWord ), biSizeImage = allot( DWord ), biXPelsPerMeter = allot( Long ), biYPelsPerMeter = allot( Long ), biClrUsed = allot( DWord ), biClrImportant = allot( DWord ), SIZEOF_BITMAPINFOHEADER = allotted_size(), ----------------------------------------------------------------------------- -- Type BITMAPCOREHEADER bcSize = allot( Long ), bcWidth = allot( Word ), bcHeight = allot( Word ), bcPlanes = allot( Word ), bcBitCount = allot( Word ), SIZEOF_BITMAPCOREHEADER = allotted_size(), ----------------------------------------------------------------------------- -- Type RGBTRIPLE rgbtBlue = allot( Byte ), rgbtGreen = allot( Byte ), rgbtRed = allot( Byte ), SIZEOF_RGBTRIPLE = allotted_size(), ----------------------------------------------------------------------------- -- Type RGBQUAD rgbBlue = allot( Byte ), rgbGreen = allot( Byte ), rgbRed = allot( Byte ), rgbReserved = allot( Byte ), SIZEOF_RGBQUAD = allotted_size(), ----------------------------------------------------------------------------- -- Type BITMAPINFO bmiHeader = allot( SIZEOF_BITMAPINFOHEADER ), bmiColors = allot( SIZEOF_RGBQUAD*2 ), SIZEOF_BITMAPINFO = allotted_size(), ----------------------------------------------------------------------------- -- Type PALLETTEENTRY peBlue = allot( Byte ), peGreen = allot( Byte ), peRed = allot( Byte ), peFlags = allot( Byte ), SIZEOF_PALETTEENTRY = allotted_size(), ----------------------------------------------------------------------------- -- Type LOGPALETTE palVersion = allot( Word ), palNumEntries = allot( Word ), palPalEntr = allot( SIZEOF_PALETTEENTRY*2 ), SIZEOF_LOGPALETTE = allotted_size(), ----------------------------------------------------------------------------- -- Type OPENFILENAME ofnStructSize = allot( Long ), ofnOwner = allot( Long ), ofnInstance = allot( Long ), ofnFilter = allot( Lpsz ), ofnCustomFilter = allot( Lpsz ), ofnMaxCustFilter = allot( DWord ), ofnFilterIndex = allot( DWord ), ofnFile = allot( Lpsz ), ofnMaxFile = allot( DWord ), ofnFileTitle = allot( Lpsz ), ofnMaxFileTitle = allot( DWord ), ofnInitialDir = allot( Lpsz ), ofnTitle = allot( Lpsz ), ofnFlags = allot( DWord ), ofnFileOffset = allot( Word ), ofnFileExtension = allot( Word ), ofnDefExt = allot( Lpsz ), ofnCustData = allot( DWord ), ofnHook = allot( Long ), ofnTemplateName = allot( Long ), SIZEOF_OPENFILENAME = allotted_size(), -- 76 -- NEW! 0.45k ----------------------------------------------------------------------------- -- Type COLORDLG COLORDLG_lStructSize = allot(DWord), COLORDLG_hwndOwner = allot(Long), COLORDLG_hInstance = allot(Long), COLORDLG_rgbResult = allot(Long), COLORDLG_lpCustColors = allot(Long), COLORDLG_Flags = allot(DWord), COLORDLG_lCustData = allot(Long), COLORDLG_lpfnHook = allot(Long), COLORDLG_lpTemplateName = allot(Lpsz), SIZEOF_COLORDLG = allotted_size(), ----------------------------------------------------------------------------- -- Type SCROLLINFO sifSize = allot( Long ), sifMask = allot( Long ), sifMin = allot( Long ), sifMax = allot( Long ), sifPage = allot( Long ), sifPos = allot( Long ), sifTrackPos = allot( Long ), SIZEOF_SCROLLINFO = allotted_size(), ----------------------------------------------------------------------------- -- TOOLINFO tiSize = allot( Integer ), tiFlags = allot( Integer ), tiHWnd = allot( Long ), tiId = allot( Integer ), tiRect = allot( SIZEOF_RECT ), tiInstance = allot( Long ), tiText = allot( Lpsz ), SIZEOF_TOOLINFO = allotted_size(), -- NEW! 0.43 ----------------------------------------------------------------------------- -- Type PRINTDLG PRINTDLG_lStructSize = allot( DWord ), PRINTDLG_hwndOwner = allot( Long ), PRINTDLG_hDevMode = allot( Long ), PRINTDLG_hDevNames = allot( Long ), PRINTDLG_hdc = allot( Long ), PRINTDLG_flags = allot( DWord ), PRINTDLG_nFromPage = allot( Word ), PRINTDLG_nToPage = allot( Word ), PRINTDLG_nMinPage = allot( Word ), PRINTDLG_nMaxPage = allot( Word ), PRINTDLG_nCopies = allot( Word ), PRINTDLG_hInstance = allot( Long ), PRINTDLG_lCustData = allot( DWord ), PRINTDLG_lpfnPrintHook = allot( Long ), PRINTDLG_lpfnSetupHook = allot( Long ), PRINTDLG_lpPrintTemplateName = allot( Long ), PRINTDLG_lpSetupTemplateName = allot( Long ), PRINTDLG_hPrintTemplate = allot( Long ), PRINTDLG_hSetupTemplate = allot( Long ), SIZEOF_PRINTDLG = allotted_size(), -- NEW! 0.43 ----------------------------------------------------------------------------- -- Type DOCINFO DOCINFO_cbSize = allot( Long ), DOCINFO_lpszDocName = allot( Lpsz ), DOCINFO_lpszOutput = allot( Lpsz ), DOCINFO_lpszDatatype = allot( Lpsz ), DOCINFO_fwType = allot( DWord ), SIZEOF_DOCINFO = allotted_size(), -- NEW! 0.45f ----------------------------------------------------------------------------- -- Type TC_ITEM TC_ITEM_mask = allot( UInt ), TC_ITEM_lpReserved1 = allot( UInt ), TC_ITEM_lpReserved2 = allot( UInt ), TC_ITEM_pszText = allot( Lpsz ), TC_ITEM_cchTextMax = allot( Integer ), TC_ITEM_iImage = allot( Integer ), TC_ITEM_lParam = allot( Long ), SIZEOF_TC_ITEM = allotted_size(), -- NEW! 0.45m ----------------------------------------------------------------------------- -- type CHOOSEFONT CF_lStructSize = allot( DWord ), CF_hwndOwner = allot( Ptr ), CF_hDC = allot( Ptr ), CF_hLogFont = allot( Ptr ), CF_iPointSize = allot( Long ), CF_Flags = allot( DWord ), CF_rgbColors = allot( DWord ), CF_lCustData = allot( Long ), CF_lpfnHook = allot( Ptr ), CF_lpTemplateName = allot( Ptr ), CF_hInstance = allot( Ptr ), CF_lpszStyle = allot( Lpsz ), CF_nFontType = allot( Word ), CF_FillerAlign = allot( Word ), CF_nSizeMin = allot( Long ), CF_nSizeMax = allot( Long ), SIZEOF_CHOOSEFONT = allotted_size(), -- NEW! 0.45f ----------------------------------------------------------------------------- -- type NMHDR NMHDR_hwndFrom = allot( Long ), NMHDR_idFrom = allot( UInt ), NMHDR_code = allot( UInt ), SIZEOF_NMHDR = allotted_size(), ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Device Parameters for GetDeviceCaps() DRIVERVERSION = 0, -- Device driver version TECHNOLOGY = 2, -- Device classification HORZSIZE = 4, -- Horizontal size in millimeters VERTSIZE = 6, -- Vertical size in millimeters HORZRES = 8, -- Horizontal width in pixels VERTRES = 10, -- Vertical width in pixels BITSPIXEL = 12, -- Number of bits per pixel PLANES = 14, -- Number of planes NUMBRUSHES = 16, -- Number of brushes the device has NUMPENS = 18, -- Number of pens the device has NUMMARKERS = 20, -- Number of markers the device has NUMFONTS = 22, -- Number of fonts the device has NUMCOLORS = 24, -- Number of colors the device supports PDEVICESIZE = 26, -- Size required for device descriptor CURVECAPS = 28, -- Curve capabilities LINECAPS = 30, -- Line capabilities POLYGONALCAPS = 32, -- Polygonal capabilities TEXTCAPS = 34, -- Text capabilities CLIPCAPS = 36, -- Clipping capabilities RASTERCAPS = 38, -- Bitblt capabilities ASPECTX = 40, -- Length of the X leg ASPECTY = 42, -- Length of the Y leg ASPECTXY = 44, -- Length of the hypotenuse LOGPIXELSX = 88, -- Logical pixels/inch in X LOGPIXELSY = 90, -- Logical pixels/inch in Y SIZEPALETTE = 104, -- Number of entries in physical palette NUMRESERVED = 106, -- Number of reserved entries in palette COLORRES = 108, -- Actual color resolution -- Printing related DeviceCaps. These replace the appropriate Escapes PHYSICALWIDTH = 110, -- Physical Width in device units PHYSICALHEIGHT = 111, -- Physical Height in device units PHYSICALOFFSETX = 112, -- Physical Printable Area x margin PHYSICALOFFSETY = 113, -- Physical Printable Area y margin SCALINGFACTORX = 114, -- Scaling factor x SCALINGFACTORY = 115 -- Scaling factor y ----------------------------------------------------------------------------- global constant -- Class styles CS_VREDRAW = #1, CS_HREDRAW = #2, CS_KEYCVTWINDOW = #4, CS_DBLCLKS = #8, CS_OWNDC = #20, CS_CLASSDC = #40, CS_PARENTDC = #80, CS_NOKEYCVT = #100, CS_NOCLOSE = #200, CS_SAVEBITS = #800, CS_BYTEALIGNCLIENT = #1000, CS_BYTEALIGNWINDOW = #2000, CS_PUBLICCLASS = #4000, -- ShowWindow() Commands SW_HIDE = 0, SW_SHOWNORMAL = 1, SW_NORMAL = 1, SW_SHOWMINIMIZED = 2, SW_SHOWMAXIMIZED = 3, SW_MAXIMIZE = 3, SW_SHOWNOACTIVATE = 4, SW_SHOW = 5, SW_MINIMIZE = 6, SW_SHOWMINNOACTIVE = 7, SW_SHOWNA = 8, SW_RESTORE = 9, SW_SHOWDEFAULT = 10, SW_MAX = 10, -- Window Messages WM_NULL = #0, WM_CREATE = #1, WM_DESTROY = #2, WM_MOVE = #3, WM_SIZE = #5, WM_ACTIVATE = #6, -- -- WM_ACTIVATE state values WA_INACTIVE = 0, WA_ACTIVE = 1, WA_CLICKACTIVE = 2, WM_SETFOCUS = #7, WM_KILLFOCUS = #8, WM_ENABLE = #A, WM_SETREDRAW = #B, WM_SETTEXT = #C, WM_GETTEXT = #D, WM_GETTEXTLENGTH = #E, WM_PAINT = #F, WM_CLOSE = #10, WM_QUERYENDSESSION = #11, WM_QUIT = #12, WM_QUERYOPEN = #13, WM_ERASEBKGND = #14, WM_SYSCOLORCHANGE = #15, WM_ENDSESSION = #16, WM_SHOWWINDOW = #18, WM_WININICHANGE = #1A, WM_DEVMODECHANGE = #1B, WM_ACTIVATEAPP = #1C, WM_FONTCHANGE = #1D, WM_TIMECHANGE = #1E, WM_CANCELMODE = #1F, WM_SETCURSOR = #20, WM_MOUSEACTIVATE = #21, WM_CHILDACTIVATE = #22, WM_QUEUESYNC = #23, WM_GETMINMAXINFO = #24, -- NEW! 0.45f WM_NOTIFY = #4E, WM_SETICON = #80, -- nEW! 0.45k WM_DROPFILES = #233, -- NEW! 0.31 added WM_USER messages -- Private Window Messages Start Here: WM_USER = #400, SND_FILENAME = #00020000, SND_ASYNC = #00000001, DT_SINGLELINE = #0020, DT_CENTER = #0001, DT_VCENTER = #0004, -- Window Styles WS_OVERLAPPED = #0, WS_POPUP = #80000000, WS_CHILD = #40000000, WS_MINIMIZE = #20000000, WS_VISIBLE = #10000000, WS_DISABLED = #8000000, WS_CLIPSIBLINGS = #4000000, WS_CLIPCHILDREN = #2000000, WS_MAXIMIZE = #1000000, WS_CAPTION = #C00000, -- WS_BORDER Or WS_DLGFRAME WS_BORDER = #00800000, -- creates border on window WS_DLGFRAME = #400000, WS_HSCROLL = #00100000, -- horizontal scroll bar WS_VSCROLL = #00200000, -- vertical scroll bar WS_SYSMENU = #80000, WS_THICKFRAME = #40000, WS_GROUP = #20000, WS_TABSTOP = #10000, -- use tab stop WS_MINIMIZEBOX = #20000, WS_MAXIMIZEBOX = #10000, WS_TILED = WS_OVERLAPPED, WS_ICONIC = WS_MINIMIZE, WS_SIZEBOX = WS_THICKFRAME, WS_OVERLAPPEDWINDOW = or_all({ WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX}), WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW, -- Common Window Styles WS_POPUPWINDOW = or_all({WS_POPUP, WS_BORDER, WS_SYSMENU}), WS_CHILDWINDOW = WS_CHILD, -- NEW! 0.45e -- Extended styles WS_EX_ACCEPTFILES = #10, -- drag and drop WS_EX_CLIENTEDGE = #200, -- 3D effect -- NEW! 0.40 added all button style flags BS_3STATE = #5, -- tri-state button BS_AUTO3STATE = #6, -- tri-state button, windows toggles BS_AUTOCHECKBOX = #3, -- checkbox, windows toggles BS_AUTORADIOBUTTON = #9, -- radio button, windows toggles BS_BITMAP = #80, BS_BOTTOM = #800, BS_CENTER = #300, BS_CHECKBOX = #2, -- checkbox BS_DEFPUSHBUTTON = #1, -- default pushbutton (heavy border) BS_GROUPBOX = #7, -- group box BS_ICON = #40, BS_LEFT = #100, BS_LEFTTEXT = #20, BS_MULTILINE = #2000, BS_NOTIFY = #4000, BS_OWNERDRAW = #B, -- owner drawn BS_PUSHBUTTON = #0, -- pushbutton BS_PUSHLIKE = #1000, BS_RADIOBUTTON = #4, -- radio button BS_RIGHT = #200, BS_RIGHTBUTTON = #20, BS_TEXT = #0, BS_TOP = #400, BS_USERBUTTON = #8, BS_VCENTER = #C00, ES_LEFT = #0000, -- left justified text ES_CENTER = #0001, -- centered text ES_RIGHT = #0002, -- right justified text ES_MULTILINE = #0004, -- multiline edit ES_AUTOHSCROLL = #0080, -- automatic horizontal scroll ES_AUTOVSCROLL = #0040, -- automatic vertical scroll -- NEW! 0.45m requested by Brian Jackson ES_LOWERCASE = #00000010, ES_NOHIDEEL = #0000100, ES_NUMBER = #00002000, ES_OEMCONVERT = #00000400, ES_PASSWORD = #00000020, ES_READONLY = #00000800, ES_UPPERCASE = #00000008, ES_WANTRETURN = #00001000, LBS_NOTIFY = #0001, -- notify parent on click or double click LBS_SORT = #0002, -- sort strings in box alphabetically LBS_STANDARD = or_all( { LBS_NOTIFY, LBS_SORT, WS_VSCROLL, WS_BORDER} ), LB_ADDSTRING = #180, -- list box: add string LB_INSERTSTRING = #181, -- list box: insert string LB_DELETESTRING = #182, -- list box: delete string LB_RESETCONTENT = #184, -- list box: reset list LB_GETTEXT = #189, -- list box: get text LB_GETTEXTLEN = #18A, -- list box: get length of text LB_GETCOUNT = #18B, -- list box: get length of list LB_GETCURSEL = #188, -- list box: get index of selected item LB_SETCURSEL = #186, -- list box: set index of selected item CB_ADDSTRING = #143, -- combo box: add string CB_DELETESTRING = #144, -- combo box: delete string CB_GETCOUNT = #146, -- combo box: get list count CB_GETLBTEXT = #148, -- combo box: get text CB_GETLBTEXTLEN = #149, -- combo box: get text length CB_INSERTSTRING = #14A, -- combo box: insert string CB_RESETCONTENT = #14B, -- combo box: erase list CB_GETCURSEL = #147, -- combo box: return index of current item CB_SETCURSEL = #14E, -- combo box: set index -- Button Control Messages -- NEW! 0.40 added more messages BM_CLICK = 245, BM_GETCHECK = 240, BM_GETIMAGE = 246, BM_GETSTATE = 242, BM_SETCHECK = 241, BM_SETIMAGE = 247, BM_SETSTATE = 243, BM_SETSTYLE = 244, -- NEW! 0.41 added trackbar styles -- Trackbar Styles TBS_HORZ = 0, TBS_VERT = 2, TBS_AUTOTICKS = 1, TBS_NOTICKS = 16, TBS_TOP = 4, TBS_BOTTOM = 0, TBS_LEFT = 4, TBS_RIGHT = 0, TBS_BOTH = 8, TBS_ENABLESELRANGE = 32, TBS_FIXEDLENGTH = 64, TBS_NOTHUMB = 128, TB_BOTTOM = 7, TB_ENDTRACK = 8, TB_LINEDOWN = 1, TB_LINEUP = 0, TB_PAGEDOWN = 3, TB_PAGEUP = 2, TB_THUMBPOSITION = 4, TB_THUMBTRACK = 5, TB_TOP = 6, -- NEW! 0.45f -- Track bar control TBM_CLEARSEL = 1043, TBM_CLEARTICS = 1033, TBM_GETCHANNELRECT = 1050, TBM_GETLINESIZE = 1048, TBM_GETNUMTICS = 1040, TBM_GETPAGESIZE = 1046, TBM_GETPOS = 1024, TBM_GETPTICS = 1038, TBM_GETRANGEMAX = 1026, TBM_GETRANGEMIN = 1025, TBM_GETSELEND = 1042, TBM_GETSELSTART = 1041, TBM_GETTHUMBLENGTH = 1052, TBM_GETTHUMBRECT = 1049, TBM_GETTIC = 1027, TBM_GETTICPOS = 1039, TBM_SETLINESIZE = 1047, TBM_SETPAGESIZE = 1045, TBM_SETPOS = 1029, TBM_SETRANGE = 1030, TBM_SETRANGEMAX = 1032, TBM_SETRANGEMIN = 1031, TBM_SETSEL = 1034, TBM_SETSELEND = 1036, TBM_SETSELSTART = 1035, TBM_SETTHUMBLENGTH = 1051, TBM_SETTIC = 1028, TBM_SETTICFREQ = 1044, -- NEW! 0.45f -- Tab control TCM_ADJUSTRECT = 4904, TCM_DELETEALLITEMS = 4873, TCM_DELETEITEM = 4872, TCM_GETCURFOCUS = 4911, TCM_GETCURSEL = 4875, TCM_GETIMAGELIST = 4866, TCM_GETITEMW = 4924, TCM_INSERTITEMW = 4926, TCM_SETITEMW = 4925, TCM_GETITEMA = 4869, TCM_INSERTITEMA = 4871, TCM_SETITEMA = 4870, TCM_GETITEM = TCM_GETITEMA, TCM_INSERTITEM = TCM_INSERTITEMA, TCM_SETITEM = TCM_SETITEMA, TCM_GETITEMCOUNT = 4868, TCM_GETITEMRECT = 4874, TCM_GETROWCOUNT = 4908, TCM_GETTOOLTIPS = 4909, TCM_HITTEST = 4877, TCM_REMOVEIMAGE = 4906, TCM_SETCURFOCUS = 4912, TCM_SETCURSEL = 4876, TCM_SETIMAGELIST = 4867, TCM_SETITEMEXTRA = 4878, TCM_SETITEMSIZE = 4905, TCM_SETPADDING = 4907, TCM_SETTOOLTIPS = 4910, -- Tab control notifications TCN_KEYDOWN = -550, TCN_SELCHANGE = -551, TCN_SELCHANGING = -552, -- TC_ITEM structure TCIF_TEXT = 1, -- display text on tabs TCIF_IMAGE = 2, -- display images on tabs TCIF_PARAM = 8, TCIF_RTLREADING = 4, -- key commands WM_KEYDOWN = #100, -- key pressed WM_KEYUP = #101, WM_CHAR = #102, -- NEW! 0.46h -- system key commands WM_SYSCHAR = 262, WM_SYSDEADCHAR = 263, WM_SYSKEYDOWN = 260, WM_SYSKEYUP = 261, -- Virtual Keys, Standard Set VK_LBUTTON = #1, VK_RBUTTON = #2, VK_CANCEL = #3, VK_MBUTTON = #4, -- NOT contiguous with L RBUTTON VK_BACK = #8, VK_TAB = #9, VK_CLEAR = #C, VK_RETURN = #D, VK_SHIFT = #10, VK_CONTROL = #11, VK_MENU = #12, VK_PAUSE = #13, VK_CAPITAL = #14, VK_ESCAPE = #1B, VK_SPACE = #20, VK_PRIOR = #21, VK_NEXT = #22, VK_END = #23, VK_HOME = #24, VK_LEFT = #25, VK_UP = #26, VK_RIGHT = #27, VK_DOWN = #28, VK_SELECT = #29, VK_PRINT = #2A, VK_EXECUTE = #2B, VK_SNAPSHOT = #2C, VK_INSERT = #2D, VK_DELETE = #2E, VK_HELP = #2F, -- VK_A thru VK_Z are the same as their ASCII equivalents: 'A' thru 'Z' -- VK_0 thru VK_9 are the same as their ASCII equivalents: '0' thru '9' VK_NUMPAD0 = #60, VK_NUMPAD1 = #61, VK_NUMPAD2 = #62, VK_NUMPAD3 = #63, VK_NUMPAD4 = #64, VK_NUMPAD5 = #65, VK_NUMPAD6 = #66, VK_NUMPAD7 = #67, VK_NUMPAD8 = #68, VK_NUMPAD9 = #69, VK_MULTIPLY = #6A, VK_ADD = #6B, VK_SEPARATOR = #6C, VK_SUBTRACT = #6D, VK_DECIMAL = #6E, VK_DIVIDE = #6F, VK_F1 = #70, VK_F2 = #71, VK_F3 = #72, VK_F4 = #73, VK_F5 = #74, VK_F6 = #75, VK_F7 = #76, VK_F8 = #77, VK_F9 = #78, VK_F10 = #79, VK_F11 = #7A, VK_F12 = #7B, VK_F13 = #7C, VK_F14 = #7D, VK_F15 = #7E, VK_F16 = #7F, VK_F17 = #80, VK_F18 = #81, VK_F19 = #82, VK_F20 = #83, VK_F21 = #84, VK_F22 = #85, VK_F23 = #86, VK_F24 = #87, VK_NUMLOCK = #90, VK_SCROLL = #91, -- VK_L VK_R - left and right Alt, Ctrl and Shift virtual keys. -- Used only as parameters to GetAsyncKeyState() and GetKeyState(). -- No other API or message will distinguish left and right keys in this way. VK_LSHIFT = #A0, VK_RSHIFT = #A1, VK_LCONTROL = #A2, VK_RCONTROL = #A3, VK_LMENU = #A4, VK_RMENU = #A5, VK_ATTN = #F6, VK_CRSEL = #F7, VK_EXSEL = #F8, VK_EREOF = #F9, VK_PLAY = #FA, VK_ZOOM = #FB, VK_NONAME = #FC, VK_PA1 = #FD, VK_OEM_CLEAR = #FE, -- my additions VK_PAGEUP = VK_PRIOR, VK_PAGEDOWN = VK_NEXT, GWL_WndProc = -4, -- GetWindowLong: ptr to function -- Menu flags for Add/Check/EnableMenuItem() MF_INSERT = #0, MF_CHANGE = #80, MF_APPEND = #100, MF_DELETE = #200, MF_REMOVE = #1000, MF_BYCOMMAND = #0, -- specifies parameter type MF_BYPOSITION = #400, -- specifies parameter type MF_SEPARATOR = #800, -- menu format: seperator MF_ENABLED = #0, -- menu format: enabled MF_GRAYED = #1, -- menu format: grayed MF_DISABLED = #2, -- menu format: disabled MF_UNCHECKED = #0, -- menu format: unchecked MF_CHECKED = #8, -- menu format: checked MF_USECHECKBITMAPS = #200, -- menu format: use check bitmaps MF_STRING = #0, -- menu format: display string MF_BITMAP = #4, -- menu format: display bitmap MF_OWNERDRAW = #100, -- menu format: owner drawn MF_POPUP = #10, -- menu format: popup style MF_MENUBARBREAK = #20, -- menu format: menu bar break style MF_MENUBREAK = #40, -- menu format: menu break style MF_UNHILITE = #0, MF_HILITE = #80, MF_SYSMENU = #2000, MF_HELP = #4000, MF_MOUSESELECT = #8000, -- NOTIFICATIONS (events) -- Button Control Notification Codes -- NEW! 0.40 added more notification codes BN_CLICKED = 0, BN_DBLCLK = 5, BN_DISABLE = 4, BN_DOUBLECLICKED = 5, BN_HILITE = 2, BN_KILLFOCUS = 7, BN_PAINT = 1, BN_PUSHED = 2, BN_SETFOCUS = 6, BN_UNHILITE = 3, BN_UNPUSHED = 3, -- Edit Control Notification Codes EN_SETFOCUS = #100, -- get focus EN_KILLFOCUS = #200, -- lose focus EN_CHANGE = #300, -- change EN_UPDATE = #400, -- update EN_ERRSPACE = #500, -- out of memory EN_MAXTEXT = #501, -- more than allotted text EN_HSCROLL = #601, -- horizontal scroll EN_VSCROLL = #602, -- vertical scroll -- List Box Control Notification Codes LBN_ERRSPACE = (-2), -- out of space LBN_SELCHANGE = 1, -- change selection LBN_DBLCLK = 2, -- double click LBN_SELCANCEL = 3, -- cancel selection LBN_SETFOCUS = 4, -- focus LBN_KILLFOCUS = 5, -- lose focus -- Combo Box Control Notification Codes CBN_ERRSPACE = (-1), -- out of space CBN_SELCHANGE = 1, -- change selection CBN_DBLCLK = 2, -- double click CBN_SETFOCUS = 3, -- set focus CBN_KILLFOCUS = 4, -- lose focus CBN_EDITCHANGE = 5, -- change data CBN_EDITUPDATE = 6, -- update data CBN_DROPDOWN = 7, -- dropdown CBN_CLOSEUP = 8, -- close dropdown CBN_SELENDOK = 9, CBN_SELENDCANCEL = 10, CBS_AUTOHSCROLL = 64, CBS_DISABLENOSCROLL = #800, CBS_DROPDOWN = 2, CBS_DROPDOWNLIST = 3, CBS_HASSTRINGS = 512, CBS_LOWERCASE = #4000, CBS_NOINTEGRALHEIGHT = #400, CBS_OEMCONVERT = 128, CBS_OWNERDRAWFIXED = 16, CBS_OWNERDRAWVARIABLE = 32, CBS_SIMPLE = 1, CBS_SORT = 256, CBS_UPPERCASE = #2000, WM_COMMAND = #0111, -- window message command WM_MENUSELECT = #011F, -- menu item selected -- edit commands WM_CUT = #300, WM_COPY = #301, WM_PASTE = #302, WM_CLEAR = #303, WM_UNDO = #304, -- Edit Control Messages EM_GETSEL = #B0, -- 2 long pointers EM_SETSEL = #B1, -- pass start and end -- EM_GETRECT = #B2, -- EM_SETRECT = #B3, -- EM_SETRECTNP = #B4, EM_SCROLL = #B5, EM_LINESCROLL = #B6, EM_SCROLLCARET = #B7, EM_GETMODIFY = #B8, EM_SETMODIFY = #B9, EM_GETLINECOUNT = #BA, EM_LINEINDEX = #BB, EM_SETHANDLE = #BC, EM_GETHANDLE = #BD, EM_GETTHUMB = #BE, EM_LINELENGTH = #C1, EM_REPLACESEL = #C2, EM_GETLINE = #C4, EM_LIMITTEXT = #C5, EM_CANUNDO = #C6, EM_UNDO = #C7, EM_FMTLINES = #C8, EM_LINEFROMCHAR = #C9, EM_SETTABSTOPS = #CB, EM_SETPASSWORDCHAR = #CC, EM_EMPTYUNDOBUFFER = #CD, EM_GETFIRSTVISIBLELINE = #CE, EM_SETREADONLY = #CF, EM_SETWORDBREAKPROC = #D0, EM_GETWORDBREAKPROC = #D1, EM_GETPASSWORDCHAR = #D2, -- mouse events WM_LBUTTONDBLCLK = 515, -- mouse button double clicked WM_RBUTTONDBLCLK = #206, -- mouse right button double clicked WM_LBUTTONDOWN = 513, -- mouse button down WM_RBUTTONDOWN = #204, -- right button down WM_MBUTTONDOWN = #207, -- middle button down WM_MOUSEMOVE = #200, -- mouse moved WM_LBUTTONUP = #202, -- left button released WM_RBUTTONUP = #205, -- right button released WM_MBUTTONUP = #208, -- middle button released -- NEW! 0.40 -- Status Window SB_GETBORDERS = 1031, SB_GETPARTS = 1030, SB_GETRECT = 1034, SB_GETTEXTW = 1037, SB_GETTEXTLENGTHW = 1036, SB_SETTEXTW = 1035, SB_GETTEXTA = 1026, SB_GETTEXTLENGTHA = 1027, SB_SETTEXTA = 1025, SB_GETTEXT = SB_GETTEXTA, SB_GETTEXTLENGTH = SB_GETTEXTLENGTHA, SB_SETTEXT = SB_SETTEXTA, SB_SETMINHEIGHT = 1032, SB_SETPARTS = 1028, SB_SIMPLE = 1033, -- setting fonts in controls WM_SETFONT = #30, WM_GETFONT = #31, -- Graphics Modes (used by EZ_FONT) GM_ADVANCED = 2, -- Background Modes TRANSPARENT = 1, -- background is not touched OPAQUE = 2, -- background filled before drawing -- xform stuff MWT_IDENTITY = 1, CW_USEDEFAULT = #80000000, -- NEW! 0.44b -- icons and pointers IDC_ARROW = 32512, IDC_IBEAM = 32513, IDC_WAIT = 32514, IDC_CROSS = 32515, IDC_UPARROW = 32516, IDC_SIZENWSE = 32642, IDC_SIZENESW = 32643, IDC_SIZEWE = 32644, IDC_SIZENS = 32645, IDC_SIZEALL = 32646, IDC_NO = 32648, IDC_APPSTARTING = 32650, IDC_HELP = 32651, IDI_APPLICATION = 32512, IDI_HAND = 32513, IDI_QUESTION = 32514, IDI_EXCLAMATION = 32515, IDI_ASTERISK = 32516, IDI_WINLOGO = 32517, IDC_SIZE = 32640, IDC_ICON = 32641, -- Win32Lib's versions ArrowPointer = IDC_ARROW, IBeamPointer = IDC_IBEAM, WaitPointer = IDC_WAIT, CrossPointer = IDC_CROSS, UpArrowPointer = IDC_UPARROW, SizeNWSEPointer = IDC_SIZENWSE, SIZENESWPointer = IDC_SIZENESW, SizeWEPointer = IDC_SIZEWE, SizeNSPointer = IDC_SIZENS, SizeAllPointer = IDC_SIZEALL, NoPointer = IDC_NO, AppStartingPointer = IDC_APPSTARTING, HelpIcon = IDC_HELP, ApplicationIcon = IDI_APPLICATION, HandIcon = IDI_HAND, QuestionIcon = IDI_QUESTION, ExclamationIcon = IDI_EXCLAMATION, AsteriskIcon = IDI_ASTERISK, WinLogoIcon = IDI_WINLOGO, SizePointer = IDC_SIZE, IconIcon = IDC_ICON, -- NEW! 0.44b -- GetSystemMetrics SM_CYMIN = 29, SM_CXMIN = 28, SM_ARRANGE = 56, SM_CLEANBOOT = 67, -- The right value for SM_CEMETRICS for NT 3.5 is 75. For Windows 95 -- and NT 4.0, it is 76. The meaning is undocumented, anyhow. SM_CMETRICS = 76, SM_CMOUSEBUTTONS = 43, SM_CXBORDER = 5, SM_CYBORDER = 6, SM_CXCURSOR = 13, SM_CYCURSOR = 14, SM_CXDLGFRAME = 7, SM_CYDLGFRAME = 8, SM_CXDOUBLECLK = 36, SM_CYDOUBLECLK = 37, SM_CXDRAG = 68, SM_CYDRAG = 69, SM_CXEDGE = 45, SM_CYEDGE = 46, SM_CXFIXEDFRAME = 7, SM_CYFIXEDFRAME = 8, SM_CXFRAME = 32, SM_CYFRAME = 33, SM_CXFULLSCREEN = 16, SM_CYFULLSCREEN = 17, SM_CXHSCROLL = 21, SM_CYHSCROLL = 3, SM_CXHTHUMB = 10, SM_CXICON = 11, SM_CYICON = 12, SM_CXICONSPACING = 38, SM_CYICONSPACING = 39, SM_CXMAXIMIZED = 61, SM_CYMAXIMIZED = 62, SM_CXMAXTRACK = 59, SM_CYMAXTRACK = 60, SM_CXMENUCHECK = 71, SM_CYMENUCHECK = 72, SM_CXMENUSIZE = 54, SM_CYMENUSIZE = 55, SM_CXMINIMIZED = 57, SM_CYMINIMIZED = 58, SM_CXMINSPACING = 47, SM_CYMINSPACING = 48, SM_CXMINTRACK = 34, SM_CYMINTRACK = 35, SM_CXSCREEN = 0, SM_CYSCREEN = 1, SM_CXSIZE = 30, SM_CYSIZE = 31, SM_CXSIZEFRAME = 32, SM_CYSIZEFRAME = 33, SM_CXSMICON = 49, SM_CYSMICON = 50, SM_CXSMSIZE = 52, SM_CYSMSIZE = 53, SM_CXVSCROLL = 2, SM_CYVSCROLL = 20, SM_CYVTHUMB = 9, SM_CYCAPTION = 4, SM_CYKANJIWINDOW = 18, SM_CYMENU = 15, SM_CYSMCAPTION = 51, SM_DBCSENABLED = 42, SM_DEBUG = 22, SM_MENUDROPALIGNMENT= 40, SM_MIDEASTENABLED = 74, SM_MOUSEPRESENT = 19, SM_MOUSEWHEELPRESENT= 75, SM_NETWORK = 63, SM_PENWINDOWS = 41, SM_RESERVED1 = 24, SM_RESERVED2 = 25, SM_RESERVED3 = 26, SM_RESERVED4 = 27, SM_SECURE = 44, SM_SHOWSOUNDS = 70, SM_SLOWMACHINE = 73, SM_SWAPBUTTON = 23, ARW_BOTTOMLEFT = 0, ARW_BOTTOMRIGHT = #1, ARW_HIDE = #8, ARW_TOPLEFT = #2, ARW_TOPRIGHT = #3, ARW_DOWN = #4, ARW_LEFT = 0, ARW_RIGHT = 0, ARW_UP = #4, -- Stock Logical Objects WHITE_BRUSH = 0, LTGRAY_BRUSH = 1, GRAY_BRUSH = 2, DKGRAY_BRUSH = 3, BLACK_BRUSH = 4, NULL_BRUSH = 5, HOLLOW_BRUSH = NULL_BRUSH, WHITE_PEN = 6, BLACK_PEN = 7, NULL_PEN = 8, OEM_FIXED_FONT = 10, ANSI_FIXED_FONT = 11, ANSI_VAR_FONT = 12, SYSTEM_FONT = 13, DEVICE_DEFAULT_FONT = 14, DEFAULT_PALETTE = 15, SYSTEM_FIXED_FONT = 16, STOCK_LAST = 16, -- Scroll bar messages SBM_SETPOS = #E0, -- not in win3.1 SBM_GETPOS = #E1, -- not in win3.1 SBM_SETRANGE = #E2, -- not in win3.1 SBM_SETRANGEREDRAW = #E6, -- not in win3.1 SBM_GETRANGE = #E3, -- not in win3.1 SBM_ENABLE_ARROWS = #E4, -- not in win3.1 -- Scroll Bar Styles SBS_HORZ = #0, SBS_VERT = #1, SBS_TOPALIGN = #2, SBS_LEFTALIGN = #2, SBS_BOTTOMALIGN = #4, SBS_RIGHTALIGN = #4, SBS_SIZEBOXTOPLEFTALIGN = #2, SBS_SIZEBOXBOTTOMRIGHTALIGN = #4, SBS_SIZEBOX = #8, -- scroll bar events WM_HSCROLL = #114, WM_VSCROLL = #115, -- Scroll Bar Constants SB_HORZ = 0, SB_VERT = 1, SB_CTL = 2, SB_BOTH = 3, -- Scroll Bar Commands SB_LINEUP = 0, SB_LINELEFT = 0, SB_LINEDOWN = 1, SB_LINERIGHT = 1, SB_PAGEUP = 2, SB_PAGELEFT = 2, SB_PAGEDOWN = 3, SB_PAGERIGHT = 3, SB_THUMBPOSITION = 4, SB_THUMBTRACK = 5, SB_TOP = 6, SB_LEFT = 6, SB_BOTTOM = 7, SB_RIGHT = 7, SB_ENDSCROLL = 8, -- scroll bar information flags SIF_DISABLENOSCROLL = #8, SIF_PAGE = #2, SIF_POS = #4, SIF_RANGE = #1, SIF_TRACKPOS = #10, SIF_ALL = or_all({SIF_RANGE,SIF_PAGE,SIF_POS,SIF_TRACKPOS}), -- Color hooks - control about to be drawn WM_CTLCOLORMSGBOX = #132, WM_CTLCOLOREDIT = #133, WM_CTLCOLORLISTBOX = #134, WM_CTLCOLORBTN = #135, WM_CTLCOLORDLG = #136, WM_CTLCOLORSCROLLBAR = #137, WM_CTLCOLORSTATIC = #138, -- MessageBox() Flags -- these are found in Euphoria's MESSAGE.E file -- MB_OK = #0, -- MB_OKCANCEL = #1, -- MB_ABORTRETRYIGNORE = #2, -- MB_YESNOCANCEL = #3, -- MB_YESNO = #4, -- MB_RETRYCANCEL = #5, -- MB_ICONHAND = #10, -- MB_ICONQUESTION = #20, -- MB_ICONEXCLAMATION = #30, -- MB_ICONASTERISK = #40, -- MB_ICONINFORMATION = MB_ICONASTERISK, -- MB_ICONSTOP = MB_ICONHAND, -- MB_DEFBUTTON1 = #0, -- MB_DEFBUTTON2 = #100, -- MB_DEFBUTTON3 = #200, -- MB_APPLMODAL = #0, -- MB_SYSTEMMODAL = #1000, -- MB_TASKMODAL = #2000, -- timer WM_TIMER = #113, -- Ternary raster operations SRCCOPY = #CC0020, -- (DWORD) dest = source SRCPAINT = #EE0086, -- (DWORD) dest = source OR dest SRCAND = #8800C6, -- (DWORD) dest = source AND dest SRCINVERT = #660046, -- (DWORD) dest = source XOR dest SRCERASE = #440328, -- (DWORD) dest = source AND (NOT dest ) NOTSRCCOPY = #330008, -- (DWORD) dest = (NOT source) NOTSRCERASE = #1100A6, -- (DWORD) dest = (NOT src) AND (NOT dest) MERGECOPY = #C000CA, -- (DWORD) dest = (source AND pattern) MERGEPAINT = #BB0226, -- (DWORD) dest = (NOT source) OR dest PATCOPY = #F00021, -- (DWORD) dest = pattern PATPAINT = #FB0A09, -- (DWORD) dest = DPSnoo PATINVERT = #5A0049, -- (DWORD) dest = pattern XOR dest DSTINVERT = #550009, -- (DWORD) dest = (NOT dest) BLACKNESS = #42, -- (DWORD) dest = BLACK WHITENESS = #FF0062, -- (DWORD) dest = WHITE -- Ternary raster operations SrcCopy = SRCCOPY, SrcPaint = SRCPAINT, SrcAnd = SRCAND, SrcInvert = SRCINVERT, SrcErase = SRCERASE, NotSrcCopy = NOTSRCCOPY, NotSrcErase = NOTSRCERASE, MergeCopy = MERGECOPY, MergePaint = MERGEPAINT, PatCopy = PATCOPY, PatPaint = PATPAINT, PatInvert = PATINVERT, DstInvert = DSTINVERT, Blackness = BLACKNESS, Whiteness = WHITENESS, -- Binary raster ops R2_BLACK = 1, -- Pixel is always 0. R2_NOTMERGEPEN = 2, -- Pixel is the inverse of the R2_MERGEPEN color. R2_MASKNOTPEN = 3, -- combination common screen and inverse of pen. R2_NOTCOPYPEN = 4, -- Pixel is the inverse of the pen color. R2_MASKPENNOT = 5, -- combination common to pen and inverse of screen. R2_NOT = 6, -- Pixel is the inverse of the screen color. R2_XORPEN = 7, -- Pixel is the inverse of the R2_XORPEN color. R2_NOTMASKPEN = 8, -- Pixel is the inverse of the R2_MASKPEN color. R2_MASKPEN = 9, -- combination common to pen and the screen. R2_NOTXORPEN = 10, -- combination of colors in pen and screen, but not in both. R2_NOP = 11, -- Pixel remains unchanged. R2_MERGENOTPEN = 12, -- combination of screen and inverse of pen. R2_COPYPEN = 13, -- Pixel is the pen color. R2_MERGEPENNOT = 14, -- combination of pen color and inverse of screen color. R2_MERGEPEN = 15, -- combination of pen color and the screen color. R2_WHITE = 16, -- Pixel is always 1. R2_LAST = 16, GDI_ERROR = #FFFF, HGDI_ERROR = #FFFF, -- error with color -- NEW! 0.45l changed value, I'm not sure it's right CLR_INVALID = #FF000000, -- open file name common dialog OFN_READONLY = #1, OFN_OVERWRITEPROMPT = #2, OFN_HIDEREADONLY = #4, OFN_NOCHANGEDIR = #8, OFN_SHOWHELP = #10, OFN_ENABLEHOOK = #20, OFN_ENABLETEMPLATE = #40, OFN_ENABLETEMPLATEHANDLE = #80, OFN_NOVALIDATE = #100, OFN_ALLOWMULTISELECT = #200, OFN_EXTENSIONDIFFERENT = #400, OFN_PATHMUSTEXIST = #800, OFN_FILEMUSTEXIST = #1000, OFN_CREATEPROMPT = #2000, OFN_SHAREAWARE = #4000, OFN_NOREADONLYRETURN = #8000, OFN_NOTESTFILECREATE = #10000, OFN_NONETWORKBUTTON = #20000, OFN_NOLONGNAMES = #40000, -- force no long names for 4.x modules OFN_EXPLORER = #80000, -- new look commdlg OFN_NODEREFERENCELINKS = #100000, OFN_LONGNAMES = #200000, -- force long names for 3.x modules OFN_SHAREFALLTHROUGH = 2, OFN_SHARENOWARN = 1, OFN_SHAREWARN = 0, -- Global Memory Flags GMEM_FIXED = #0, GMEM_MOVEABLE = #2, GMEM_NOCOMPACT = #10, GMEM_NODISCARD = #20, GMEM_ZEROINIT = #40, GMEM_MODIFY = #80, GMEM_DISCARDABLE = #100, GMEM_NOT_BANKED = #1000, GMEM_SHARE = #2000, GMEM_DDESHARE = #2000, GMEM_NOTIFY = #4000, GMEM_LOWER = GMEM_NOT_BANKED, GMEM_VALID_FLAGS = #7F72, GMEM_INVALID_HANDLE = #8000, GHND = or_all({GMEM_MOVEABLE, GMEM_ZEROINIT}), GPTR = or_all({GMEM_FIXED, GMEM_ZEROINIT}), -- PRINTDLG structure PD_ALLPAGES = 0, PD_COLLATE = 16, PD_DISABLEPRINTTOFILE = 524288, PD_ENABLEPRINTHOOK = 4096, PD_ENABLEPRINTTEMPLATE = 16384, PD_ENABLEPRINTTEMPLATEHANDLE = 65536, PD_ENABLESETUPHOOK = 8192, PD_ENABLESETUPTEMPLATE = 32768, PD_ENABLESETUPTEMPLATEHANDLE = 131072, PD_HIDEPRINTTOFILE = 1048576, PD_NOPAGENUMS = 8, PD_NOSELECTION = 4, PD_NOWARNING = 128, PD_PAGENUMS = 2, PD_PRINTSETUP = 64, PD_PRINTTOFILE = 32, PD_RETURNDC = 256, PD_RETURNDEFAULT = 1024, PD_RETURNIC = 512, PD_SELECTION = 1, PD_SHOWHELP = 2048, PD_USEDEVMODECOPIES = 262144, PD_USEDEVMODECOPIESANDCOLLATE = 262144, -- DIB color table identifiers DIB_RGB_COLORS = 0, -- color table in RGBs DIB_PAL_COLORS = 1, -- color table in palette indices DIB_PAL_INDICES = 2, -- No color table indices into surf palette DIB_PAL_PHYSINDICES = 2, -- No color table indices into surf palette DIB_PAL_LOGINDICES = 4, -- No color table indices into DC palette -- Loading Bitmaps STM_SETICON = #170, STM_SETIMAGE = 370, LR_LOADFROMFILE = 16, IMAGE_BITMAP = 0, IMAGE_ICON = 1, SS_ICON = #3, -- static style icon SS_BITMAP = #E, -- static style bitmap -- Class field offsets for GetClassLong() and GetClassWord() GCL_MENUNAME = (-8), GCL_HBRBACKGROUND = (-10), -- background brush GCL_HCURSOR = (-12), GCL_HICON = (-14), GCL_HMODULE = (-16), GCL_CBWNDEXTRA = (-18), GCL_CBCLSEXTRA = (-20), GCL_WNDPROC = (-24), GCL_STYLE = (-26), GCW_ATOM = (-32), -- System Colors -- NEW! 0.41 new constants COLOR_SCROLLBAR = 0, COLOR_BACKGROUND = 1, COLOR_DESKTOP = COLOR_BACKGROUND, COLOR_ACTIVECAPTION = 2, COLOR_INACTIVECAPTION = 3, COLOR_MENU = 4, COLOR_WINDOW = 5, COLOR_WINDOWFRAME = 6, COLOR_MENUTEXT = 7, COLOR_WINDOWTEXT = 8, COLOR_CAPTIONTEXT = 9, COLOR_ACTIVEBORDER = 10, COLOR_INACTIVEBORDER = 11, COLOR_APPWORKSPACE = 12, COLOR_HIGHLIGHT = 13, COLOR_HIGHLIGHTTEXT = 14, COLOR_BTNFACE = 15, COLOR_3DFACE = COLOR_BTNFACE, COLOR_BTNSHADOW = 16, COLOR_3DSHADOW = COLOR_BTNSHADOW, COLOR_GRAYTEXT = 17, COLOR_BTNTEXT = 18, COLOR_INACTIVECAPTIONTEXT = 19, COLOR_BTNHIGHLIGHT = 20, COLOR_3DHILIGHT = COLOR_BTNHIGHLIGHT, COLOR_3DDKSHADOW = 21, COLOR_3DLIGHT = 22, COLOR_INFOBK = 24, COLOR_INFOTEXT = 23, -- Key State Masks for Mouse Messages MK_LBUTTON = #1, -- left button is pressed MK_RBUTTON = #2, -- right button is pressed MK_SHIFT = #4, -- shift key is held down MK_CONTROL = #8, -- control key is held down MK_MBUTTON = #10, -- middle button is pressed -- constants for CreateDIBitmap CBM_CREATEDIB = #2, -- create DIB bitmap CBM_INIT = #4, -- initialize bitmap -- NEW! 0.45k color dialog constants CC_ENABLEHOOK = 16, CC_ENABLETEMPLATE = 32, CC_ENABLETEMPLATEHANDLE = 64, CC_FULLOPEN = 2, CC_PREVENTFULLOPEN = 4, CC_RGBINIT = 1, CC_SHOWHELP = 8, CC_SOLIDCOLOR = 128, -- NEW! 0.45m CHOOSEFONT flags CF_SCREENFONTS = 1, -- get screen fonts CF_PRINTERFONTS = 2, -- get printer fonts CF_EFFECTS = 256, -- get font effects -- constants for onResize -- WM_SIZE message wParam values SIZE_RESTORED = 0, SIZE_MINIMIZED = 1, SIZE_MAXIMIZED = 2, SIZE_MAXSHOW = 3, SIZE_MAXHIDE = 4, -- Obsolete constant names SIZENORMAL = SIZE_RESTORED, SIZEICONIC = SIZE_MINIMIZED, SIZEFULLSCREEN = SIZE_MAXIMIZED, SIZEZOOMSHOW = SIZE_MAXSHOW, SIZEZOOMHIDE = SIZE_MAXHIDE ----------------------------------------------------------------------------- -- Win32 Wrappers for mouse flags global constant -- Visual Basics Names for the buttons: LEFT_BUTTON = MK_LBUTTON, RIGHT_BUTTON = MK_RBUTTON, MIDDLE_BUTTON = MK_MBUTTON, SHIFT_MASK = MK_SHIFT, CTRL_MASK = MK_CONTROL, -- Win32Lib names for mouse events MOUSE_MOVE = WM_MOUSEMOVE, LEFT_DOWN = WM_LBUTTONDOWN, RIGHT_DOWN = WM_RBUTTONDOWN, LEFT_UP = WM_LBUTTONUP, RIGHT_UP = WM_RBUTTONUP, LEFT_DOUBLECLICK = WM_LBUTTONDBLCLK, RIGHT_DOUBLECLICK = WM_RBUTTONDBLCLK, -- NEW! 0.42 In mixed case MouseMove = MOUSE_MOVE, LeftDown = LEFT_DOWN, RightDown = RIGHT_DOWN, LeftUp = LEFT_UP, RightUp = RIGHT_UP, LeftDoubleClick = LEFT_DOUBLECLICK, RightDoubleClick = RIGHT_DOUBLECLICK, ----------------------------------------------------------------------------- -- Window field offsets for GetWindowLong() and GetWindowWord() GWL_WNDPROC = (-4), GWL_HINSTANCE = (-6), GWL_HWNDPARENT = (-8), GWL_STYLE = (-16), GWL_EXSTYLE = (-20), GWL_USERDATA = (-21), GWL_ID = (-12), ----------------------------------------------------------------------------- -- NEW! 0.45r text alignment TA_TOP = 0, TA_LEFT = 0, TA_NOUPDATECP = 0, TA_UPDATECP = 1, TA_RIGHT = 2, TA_CENTER = 6, VTA_CENTER = 6, TA_BOTTOM = 8, TA_BASELINE = 24, VTA_BASELINE = 24, TA_RTLREADING = 256, AlignTop = TA_TOP, AlignBottom = TA_BOTTOM, AlignBaseline = TA_BASELINE, AlignCenter = TA_CENTER, AlignLeft = TA_LEFT, AlignRight = TA_RIGHT, ----------------------------------------------------------------------------- -- common control styles -- NEW! 0.40 CCS_ADJUSTABLE = #20, CCS_BOTTOM = #3, CCS_NODIVIDER = #40, CCS_NOMOVEY = #2, CCS_NOPARENTALIGN = #8, CCS_NORESIZE = #4, CCS_TOP = #1, ANIMATE_CLASSA = "SysAnimate32", HOTKEY_CLASSA = "msctls_hotkey32", PROGRESS_CLASSA = "msctls_progress32", STATUSCLASSNAMEA = "msctls_statusbar32", TOOLBARCLASSNAMEA = "ToolbarWindow32", TOOLTIPS_CLASSA = "tooltips_class32", TRACKBAR_CLASSA = "msctls_trackbar32", UPDOWN_CLASSA = "msctls_updown32", WC_HEADERA = "SysHeader32", WC_LISTVIEWA = "SysListView32", WC_TABCONTROLA = "SysTabControl32", WC_TREEVIEWA = "SysTreeView32", ----------------------------------------------------------------------------- -- attributes for EZ_FONTS Normal = 0, Bold = 1, Italic = 2, Underline = 4, Strikeout = 8, ----------------------------------------------------------------------------- -- NEW! 0.45l changed values of constants -- attributes for showWindow -- Normal = 0, Modal = -1, Minimize = SW_SHOWMINIMIZED, Maximize = SW_SHOWMAXIMIZED, ----------------------------------------------------------------------------- -- NEW! 0.42 -- attributes for shift keys ShiftMask = 1, -- shift key is held down ControlMask = 2, -- control key is held down AltMask = 4 -- alt key is held down ----------------------------------------------------------------------------- -- NEW! 0.45i: Default Window Color -- NEW! 0.45l use COLOR_BTNFACE constant WindowColor = COLOR_BTNFACE ----------------------------------------------------------------------------- -- Classes of Windows: Base Classes ----------------------------------------------------------------------------- constant WINDOW = 0, -- window BUTTON = 1, -- button COMBO = 2, -- combo box EDIT = 3, -- edit LISTBOX = 4, -- list box SCROLLBAR = 5, -- scroll bar STATIC = 6, -- static MENU = 7, -- menu -- NEW! 0.45 added POPUP POPUP = 8, -- popup menu MENUITEM = 9, -- menu item PIXMAP = 10, -- pixmap, COMMON_CONTROL = 11 -- common controls ----------------------------------------------------------------------------- -- Classes of Windows: Used for internal identification of window type ----------------------------------------------------------------------------- -- NEW! 0.45f automatic class count integer classes classes = 0 function newClass() -- increment the count of classes, return count classes += 1 return classes end function global constant Window = newClass(), PushButton = newClass(), DefPushButton = newClass(), CheckBox = newClass(), TriCheckBox = newClass(), Radio = newClass(), Group = newClass(), List = newClass(), SortedList = newClass(), Combo = newClass(), SortedCombo = newClass(), SimpleCombo = newClass(), DropDownList = newClass(), EditText = newClass(), MleText = newClass(), LText = newClass(), RText = newClass(), CText = newClass(), HScroll = newClass(), VScroll = newClass(), Icon = newClass(), Bitmap = newClass(), Menu = newClass(), Popup = newClass(), -- NEW! 0.45 added Popup MenuItem = newClass(), Pixmap = newClass(), ToolBar = newClass(), -- NEW! 0.40 StatusBar = newClass(), -- NEW! 0.40 PictureButton = newClass(), -- NEW! 0.40 ToggleButton = newClass(), -- NEW! 0.41 TogglePicture = newClass(), -- NEW! 0.41 HTrackBar = newClass(), -- NEW! 0.45f VTrackBar = newClass(), -- NEW! 0.45f TabControl = newClass(), -- NEW! 0.45f TabItem = newClass() -- NEW! 0.45f -- NEW! 0.45f adjusted for trackbar -- NEW! 0.43 hid these classes -- hidden classes constant Screen_ = newClass(), -- NEW! 0.41 Printer_ = newClass() -- NEW! 0.43 constant NumClasses = Printer_ global integer Screen, -- id of screen Printer -- id of printer -- Controls that pass bitmaps in the flags -- NEW! 0.41 constant PictureControls = { PictureButton, TogglePicture } ----------------------------------------------------------------------------- -- names of indexes for window_change constant MY_SMALLCHANGE = 1, -- scroll bar line up/down amount MY_LARGECHANGE = 2 -- scroll bar page up/down amount ----------------------------------------------------------------------------- sequence className, -- class name classType, -- message class classStyle, -- attributes -- NEW! 0.45e classStyleEx -- extended class attributes className = repeat( 0, NumClasses ) classType = repeat( 0, NumClasses ) classStyle = repeat( 0, NumClasses ) classStyleEx = repeat( 0, NumClasses ) ----------------------------------------------------------------------------- --/topic Controls --/const Window --/desc A Window is a normal Win32 window. ----------------------------------------------------------------------------- --/topic Controls --/const PushButton --/desc Command button control. -- A PushButton is a normal push button (sometimes called -- /i command /i button). A PushButton has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_PUSHBUTTON: button style is pushbutton -- /li /b WS_TABSTOP: the control can be tabbed to className[ PushButton ] = "button" classType[ PushButton ] = BUTTON classStyle[ PushButton ] = or_all( { WS_CHILD, WS_VISIBLE, BS_PUSHBUTTON, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const DefPushButton --/desc Default command button control. -- A DefPushButton is a /PushButton, but -- is displayed with an extra border indicating that this button -- will automatically be selected if the user presses the Return -- button on the keyboard. -- -- Unfortunately, this behavior is not currently implemented, so it -- simply behaves the same as a normal /PushButton. -- -- A DefPushButton has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_DEFPUSHBUTTON: button style is default pushbutton -- /li /b WS_TABSTOP: the control can be tabbed to className[ DefPushButton ] = "button" classType[ DefPushButton ] = BUTTON classStyle[ DefPushButton ] = or_all( { WS_CHILD, WS_VISIBLE, BS_DEFPUSHBUTTON, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const CheckBox --/desc CheckBox control. -- A CheckBox is a button that can be toggled on or off. -- It appears as a box with a label to the side. Clicking the -- checkbox causes an 'X' to be toggled in the box. -- -- A CheckBox has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_AUTOCHECKBOX: checkbox, default window handling -- /li /b WS_TABSTOP: the control can be tabbed to className[ CheckBox ] = "button" classType[ CheckBox ] = BUTTON classStyle[ CheckBox ] = or_all( { WS_CHILD, WS_VISIBLE, BS_AUTOCHECKBOX, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const TriCheckBox --/desc Three state checkbox control. -- A TriCheckBox is similar to a /CheckBox, but it -- has three states: on, off, or dim. -- -- A TriCheckBox has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_AUTO3STATE: tri-state check box -- /li /b WS_TABSTOP: the control can be tabbed to className[ TriCheckBox ] = "button" classType[ TriCheckBox ] = BUTTON classStyle[ TriCheckBox ] = or_all( { WS_CHILD, WS_VISIBLE, BS_AUTO3STATE, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const Radio --/desc Radio button control. -- A Radio is similar to a /CheckBox, in functionality. -- Like a checkbox, it can be toggled on and off. However, radio buttons -- are grouped controls - if one is toggled on, the rest in the group are -- toggled off. -- -- Win32Lib considers a radio button in a group if they are contained -- by the same /Group control. If there is no /Group control, -- then all the radio buttons are considered to belong to the same -- group. -- -- A Radio has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_AUTORADIOBUTTON: radio button control -- /li /b WS_TABSTOP: the control can be tabbed to className[ Radio ] = "button" classType[ Radio ] = BUTTON classStyle[ Radio ] = or_all( { WS_CHILD, WS_VISIBLE, BS_AUTORADIOBUTTON, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const Group --/desc Group control. -- A Group is a static control, and recieves no events. It's -- main function is to seperate other controls into groups. -- -- In addition to providing a visual cue, the group alters the behavior of -- the /Radio control; all the radio buttons within a single group are -- considered to belong to the same group. -- -- When placing controls in groups, it's a good idea to make them -- children of the Group, instead of children of the Window. If you -- don't, the Group may end up routing events meant for the control to -- itself. For example, /onDragAndDrop events will be routed to the -- Group instead of the child. -- -- A Group has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_GROUPBOX: group box control className[ Group ] = "button" classType[ Group ] = BUTTON classStyle[ Group ] = or_all( { WS_CHILD, WS_VISIBLE, BS_GROUPBOX} ) ----------------------------------------------------------------------------- --/topic Controls --/const SortedList --/desc Sorted list control. -- A SortedList contains a list of items, arranged in alphabetical -- order. To have an unsorted list, use the /List control instead. -- -- A SortedList has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b LBS_NOTIFY: notify parent of events -- /li /b LBS_SORT: sort items in list -- /li /b WS_VSCROLL: attach a vertical scroll bar -- /li /b WS_BORDER: draw a border on the control -- /li /b WS_TABSTOP: the control can be tabbed to -- /li /b WS_EX_CLIENTEDGE: 3D effect -- /li /b WS_EX_ACCEPTFILES: drag and drop support className[ SortedList ] = "listbox" classType[ SortedList ] = LISTBOX classStyle[ SortedList ] = or_all( { WS_CHILD, WS_VISIBLE, LBS_NOTIFY, LBS_SORT, WS_VSCROLL, -- NEW! 0.43 commented out ES_AUTOSCROLL, restored WS_VSCROLL. -- I think this was a typo from a prior version. --ES_AUTOVSCROLL, WS_BORDER, WS_TABSTOP} ) -- NEW! 0.45k added WS_ACCEPTFILES classStyleEx[ SortedList ] = or_all( {WS_EX_CLIENTEDGE, WS_EX_ACCEPTFILES} ) ----------------------------------------------------------------------------- --/topic Controls --/const List --/desc List. -- A List contains a list of items, arranged in the order that -- they were placed into the list. To have a sorted list, either sort -- the items before placing them into the list, or use the /SortedList -- control. -- -- A List has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b LBS_NOTIFY: notify parent of events -- /li /b WS_VSCROLL: attach a vertical scroll bar -- /li /b WS_BORDER: draw a border on the control -- /li /b WS_TABSTOP: the control can be tabbed to -- /li /b WS_EX_CLIENTEDGE: 3D effect -- /li /b WS_EX_ACCEPTFILES: drag and drop support className[ List ] = "listbox" classType[ List ] = LISTBOX classStyle[ List ] = or_all( { WS_CHILD, WS_VISIBLE, LBS_NOTIFY, WS_VSCROLL, WS_BORDER, WS_TABSTOP} ) -- NEW! 0.45k added WS_ACCEPTFILES classStyleEx[ List ] = or_all( {WS_EX_CLIENTEDGE, WS_EX_ACCEPTFILES} ) ----------------------------------------------------------------------------- --/topic Controls --/const Combo --/desc Combo box control. -- A Combo is a combination of an edit control and a list. -- If you need the items in the combo to be sorted, use a /SortedCombo -- instead. In addition to being able to select a value from the combo's -- list, the user can enter their own value as well. -- -- A Combo has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_VSCROLL: attach a vertical scroll bar -- /li /b CBS_DISABLENOSCROLL: allow the user to scroll -- /li /b CBS_DROPDOWN: the list can drop down, like a menu -- /li /b CBS_DROPDOWNLIST: probably shouldn't have this attribute -- /li /b CBS_HASSTRINGS: contains string values -- /li /b WS_TABSTOP: the control can be tabbed to className[ Combo ] = "combobox" classType[ Combo ] = COMBO classStyle[ Combo ] = or_all( { WS_CHILD, WS_VISIBLE, -- NEW! 0.42 restored WS_VSCROLL attribute WS_VSCROLL, --CBS_AUTOHSCROLL, CBS_DISABLENOSCROLL, CBS_DROPDOWN, CBS_DROPDOWNLIST, CBS_HASSTRINGS, --CBS_LOWERCASE, --CBS_NOINTEGRALHEIGHT, --CBS_OEMCONVERT, --CBS_OWNERDRAWFIXED, --CBS_OWNERDRAWVARIABLE, --CBS_SIMPLE, --CBS_SORT, --CBS_UPPERCASE, WS_TABSTOP} ) -- NEW! 0.45e classStyleEx[ Combo ] = WS_EX_CLIENTEDGE ----------------------------------------------------------------------------- --/topic Controls --/const SortedCombo --/desc Sorted combo box control. -- A SortedCombo is a combination of an edit control and a list. -- -- A SortedCombo has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_VSCROLL: attach a vertical scroll bar -- /li /b CBS_DISABLENOSCROLL: allow the user to scroll -- /li /b CBS_DROPDOWN: the list can drop down, like a menu -- /li /b CBS_DROPDOWNLIST: probably shouldn't have this attribute -- /li /b CBS_HASSTRINGS: contains string values -- /li /b CBS_SIMPLE: probably shouldn't have this attribute -- /li /b CBS_SORT: sorted -- /li /b WS_TABSTOP: the control can be tabbed to className[ SortedCombo ] = "combobox" classType[ SortedCombo ] = COMBO classStyle[ SortedCombo ] = or_all( { WS_CHILD, WS_VISIBLE, -- NEW! 0.42 restored WS_VSCROLL attribute WS_VSCROLL, --CBS_AUTOHSCROLL, --CBS_DISABLENOSCROLL, CBS_DROPDOWN, CBS_DROPDOWNLIST, CBS_HASSTRINGS, --CBS_LOWERCASE, --CBS_NOINTEGRALHEIGHT, --CBS_OEMCONVERT, --CBS_OWNERDRAWFIXED, --CBS_OWNERDRAWVARIABLE, CBS_SIMPLE, CBS_SORT, --CBS_UPPERCASE, WS_TABSTOP} ) -- NEW! 0.45e classStyleEx[ SortedCombo ] = WS_EX_CLIENTEDGE ----------------------------------------------------------------------------- --/topic Controls --/const SimpleCombo --/desc Simple combo box control. -- A SimpleCombo is a combo box with no dropdown. The user can -- select from various values by using the cursor keys. -- -- A SimpleCombo has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b CBS_DROPDOWNLIST: has a list of values -- /li /b CBS_HASSTRINGS: contains string values -- /li /b CBS_SIMPLE: probably shouldn't have this attribute -- /li /b WS_TABSTOP: the control can be tabbed to className[ SimpleCombo ] = "combobox" classType[ SimpleCombo ] = COMBO classStyle[ SimpleCombo ] = or_all( { WS_CHILD, WS_VISIBLE, --CBS_AUTOHSCROLL, --CBS_DISABLENOSCROLL, --CBS_DROPDOWN, CBS_DROPDOWNLIST, CBS_HASSTRINGS, --CBS_LOWERCASE, --CBS_NOINTEGRALHEIGHT, --CBS_OEMCONVERT, --CBS_OWNERDRAWFIXED, --CBS_OWNERDRAWVARIABLE, CBS_SIMPLE, --CBS_SORT, --CBS_UPPERCASE, WS_TABSTOP} ) -- NEW! 0.45e classStyleEx[ SimpleCombo ] = WS_EX_CLIENTEDGE ----------------------------------------------------------------------------- --/topic Controls --/const DropDownList --/desc Drop down list control. -- A DropDownList is like a /Combo, but the user can only -- select items on the list, and not enter their own value into the edit -- box. -- -- A DropDownList has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_VSCROLL: attach a vertical scroll bar -- /li /b CBS_DROPDOWN: the list can drop down, like a menu -- /li /b CBS_HASSTRINGS: contains string values -- /li /b WS_TABSTOP: the control can be tabbed to className[ DropDownList ] = "combobox" classType[ DropDownList ] = COMBO classStyle[ DropDownList ] = or_all( { WS_CHILD, WS_VISIBLE, -- NEW! 0.42 restored WS_VSCROLL attribute WS_VSCROLL, --CBS_AUTOHSCROLL, --CBS_DISABLENOSCROLL, --CBS_DROPDOWN, CBS_DROPDOWNLIST, CBS_HASSTRINGS, --CBS_LOWERCASE, --CBS_NOINTEGRALHEIGHT, --CBS_OEMCONVERT, --CBS_OWNERDRAWFIXED, --CBS_OWNERDRAWVARIABLE, --CBS_SIMPLE, --CBS_SORT, --CBS_UPPERCASE, WS_TABSTOP} ) -- NEW! 0.45e classStyleEx[ DropDownList ] = WS_EX_CLIENTEDGE ----------------------------------------------------------------------------- --/topic Controls --/const EditText --/desc Text edit control control. -- An EditText allows the user to enter text values into the -- control. -- -- A EditText has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b ES_AUTOHSCROLL: automatic vertical scrollbar, if needed -- /li /b ES_LEFT: left justify the text -- /li /b WS_BORDER: draw with a border -- /li /b WS_TABSTOP: the control can be tabbed to -- /li /b WS_EX_CLIENTEDGE: 3D effect -- /li /b WS_EX_ACCEPTFILES: drag and drop support -- single line edit, left justified className[ EditText ] = "edit" classType[ EditText ] = EDIT classStyle[ EditText ] = or_all( { WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, --ES_MULTILINE = #0004, -- multiline edit ES_AUTOHSCROLL, --ES_AUTOVSCROLL = #0040, -- automatic vertical scroll ES_LEFT} ) -- NEW! 0.45k added WS_ACCEPTFILES classStyleEx[ EditText ] = or_all( {WS_EX_CLIENTEDGE, WS_EX_ACCEPTFILES} ) ----------------------------------------------------------------------------- --/topic Controls --/const MleEdit --/desc Multi-line edit control. -- An MleEdit (multi-line edit) control is like a mini-text editor. -- The user can enter in multiple lines of text. -- -- Since the Tab key is accepted as input into the MLE, the user has to -- press Control+Tab to move to the next control, instead of the standard -- Tab key. -- -- A MleEdit has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_HSCROLL: horizontal scroll bar -- /li /b WS_VSCROLL: vertical scroll bar -- /li /b ES_LEFT: left justify the text -- /li /b WS_BORDER: draw with a border -- /li /b ES_MULTILINE: allow multiple lines of text -- /li /b WS_TABSTOP: the control can be tabbed to -- /li /b WS_EX_CLIENTEDGE: 3D effect -- /li /b WS_EX_ACCEPTFILES: drag and drop support className[ MleText ] = "edit" classType[ MleText ] = EDIT classStyle[ MleText ] = or_all( { WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_HSCROLL, WS_VSCROLL, WS_BORDER, ES_LEFT, ES_MULTILINE} ) -- ES_AUTOHSCROLL, -- ES_AUTOVSCROLL} ) -- NEW! 0.45k added WS_ACCEPTFILES classStyleEx[ MleText ] = or_all( {WS_EX_CLIENTEDGE, WS_EX_ACCEPTFILES} ) ----------------------------------------------------------------------------- --/topic Controls --/const LText --/desc Left-justified label control. -- An LText control does not respond to events. -- -- An LText has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b ES_LEFT: left justify the text className[ LText ] = "static" classType[ LText ] = STATIC classStyle[ LText ] = or_all( { WS_CHILD, WS_VISIBLE, ES_LEFT} ) ----------------------------------------------------------------------------- --/topic Controls --/const RText --/desc Right-justified label control. -- An RText control does not respond to events. -- -- An RText has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b ES_RIGHT: right justify the text className[ RText ] = "static" classType[ RText ] = STATIC classStyle[ RText ] = or_all( { WS_CHILD, WS_VISIBLE, ES_RIGHT} ) ----------------------------------------------------------------------------- --/topic Controls --/const CText --/desc Center-justified label control. -- A CText control does not respond to events. -- -- A CText has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b ES_CENTER: center justify the text className[ CText ] = "static" classType[ CText ] = STATIC classStyle[ CText ] = or_all( { WS_CHILD, WS_VISIBLE, ES_CENTER} ) ----------------------------------------------------------------------------- --/topic Controls --/const HScroll --/desc Horizontal scrollbar control. -- An HScroll has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b SBS_HORZ: horizontal scroll bar -- /li /b WS_TABSTOP: the control can be tabbed to -- horizontal scroll bar className[ HScroll ] = "scrollbar" classType[ HScroll ] = SCROLLBAR classStyle[ HScroll ] = or_all( { WS_CHILD, WS_VISIBLE, SBS_HORZ, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const VScroll --/desc Vertical scrollbar control. -- -- A VScroll has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b SBS_VERT: vertical scroll bar -- /li /b WS_TABSTOP: the control can be tabbed to className[ VScroll ] = "scrollbar" classType[ VScroll ] = SCROLLBAR classStyle[ VScroll ] = or_all( { WS_CHILD, WS_VISIBLE, SBS_VERT, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const Icon -- Icon control. -- An Icon is a static small graphic. As a static control, it does -- not respond to events. -- -- An Icon has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b SS_ICON: icon className[ Icon ] = "static" classType[ Icon ] = STATIC classStyle[ Icon ] = or_all( { WS_CHILD, WS_VISIBLE, SS_ICON} ) ----------------------------------------------------------------------------- --/topic Controls --/const Bitmap --/desc Static bitmap control. -- A Bitmap does not respond to events. -- -- A Bitmap has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b SS_BITMAP: bitmap className[ Bitmap ] = "static" classType[ Bitmap ] = STATIC classStyle[ Bitmap ] = or_all( { WS_CHILD, WS_VISIBLE, SS_BITMAP} ) ----------------------------------------------------------------------------- --/topic Controls --/const Menu --/desc Menu bar item control. -- A Menu is an item in a window's menubar. There is no need to -- declare a menubar for a window; if a Menu is created, the menubar -- will automatically be created for it. -- menu bar item className[ Menu ] = "" classType[ Menu ] = MENU -- NEW! 0.45 ----------------------------------------------------------------------------- --/topic Controls --/const Popup --/desc Popup menu control. -- A Popup is a menu not attached to a window. To display a popup, -- use /popup(). className[ Popup ] = "" classType[ Popup ] = POPUP ----------------------------------------------------------------------------- --/topic Controls --/const MenuItem --/desc Dropdown menu item control. -- A MenuItem is an item in a window's Menu. Menu items are -- placed sequentially into menus. -- -- There is currently no way to remove menu items. className[ MenuItem ] = "" classType[ MenuItem ] = MENUITEM ----------------------------------------------------------------------------- --/topic Controls --/const Pixmap --/desc Color bitmap. -- A Pixmap is an off-screen color bitmap. It can be displayed -- in a window by using one of the /i bitblt functions (see -- Graphics for details). className[ Pixmap ] = "" classType[ Pixmap ] = PIXMAP ----------------------------------------------------------------------------- --/topic Controls --/const ToolBar --/desc Window toolbar control. -- A ToolBar is a container at the top of a window that can hold -- other controls - typically /PushButtons or /ToggleButtons. -- Toolbars are implemented using the Win32 common control toolbar. -- -- When the parent window is resized, Win32Lib automatically repositions -- the ToolBar. -- -- Note that the toolbar occupies space like any other control. To determine -- what portion of the window's client area is not occupied by the toolbar -- (and statusbar), use the /getClientRect function. -- -- A ToolBar has the following attributes: -- -- /li /b CCS_TOP: place on top of the window -- /li /b CCS_NORESIZE: don't automatically resize (Win32Lib does it) -- /li /b WS_CHILD: child control of parent -- /li /b WS_BORDER: draw a border -- /li /b WS_CLIPSIBLINGS: clip child controls className[ ToolBar ] = TOOLBARCLASSNAMEA classType[ ToolBar ] = COMMON_CONTROL classStyle[ ToolBar ] = or_all( { CCS_TOP, CCS_NORESIZE, WS_CHILD, WS_VISIBLE, WS_BORDER, WS_CLIPSIBLINGS} ) ----------------------------------------------------------------------------- --/topic Controls --/const StatusBar --/desc Window status bar control. -- A StatusBar is a control placed at the bottom of the window -- that status messages can be written into. -- The status bar is implemented using the Win32 common control toolbar. -- -- When the parent window is resized, Win32Lib automatically repositions -- the StatusBar. -- -- Note that the status bar occupies space like any other control. To -- determine what portion of the window's client area is not occupied by -- the statusbar (and toolbar), use the /getClientRect function. -- -- A StatusBar has the following attributes: -- -- /li /b CCS_BOTTOM: place on bottom of the window -- /li /b WS_CHILD: child control of parent -- /li /b WS_BORDER: draw a border -- /li /b WS_CLIPSIBLINGS: clip child controls className[ StatusBar ] = STATUSCLASSNAMEA classType[ StatusBar ] = COMMON_CONTROL classStyle[ StatusBar ] = or_all( { WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS, CCS_BOTTOM} ) ----------------------------------------------------------------------------- --/topic Controls --/const PictureButton --/desc Command button with graphic control. -- A PictureButton is a /PushButton with a graphic instead -- of text. The graphic can be specified by passing the name or address of -- a bitmap control in the /i flags parameter, or with /setBitmap, -- /setIcon or /setPixmap. -- -- A PictureButton is typically used in a /ToolBar. -- -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_PUSHBUTTON: button style is pushbutton -- /li /b BS_BITMAP: displays a bitmap -- /li /b WS_TABSTOP: the control can be tabbed to className[ PictureButton ] = "button" classType[ PictureButton ] = BUTTON classStyle[ PictureButton ] = or_all( { WS_CHILD, WS_VISIBLE, BS_PUSHBUTTON, BS_BITMAP, -- NEW! 0.41 removed bogus flag WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const ToggleButton --/desc Toggle button control. -- A ToggleButton is a /PushButton that behaves like a -- /CheckBox - clicking it toggles it down, clicking again toggles -- it back up. It is typically used in a /ToolBar. -- -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_PUSHBUTTON: button style is pushbutton -- /li /b BS_BITMAP: displays a bitmap -- /li /b WS_TABSTOP: the control can be tabbed to className[ ToggleButton ] = "button" classType[ ToggleButton ] = BUTTON classStyle[ ToggleButton ] = or_all( { WS_CHILD, WS_VISIBLE, BS_PUSHLIKE, BS_AUTOCHECKBOX, WS_TABSTOP} ) ----------------------------------------------------------------------------- --/topic Controls --/const TogglePicture --/desc Toggle button with graphic control. -- A TogglePicture is a combination of a /ToggleButton -- and a /PictureButton. The graphic can be specified by passing the -- name or address of a bitmap in the /i flags parameter, or with -- /setBitmap, /setIcon or /setPixmap. -- -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b BS_PUSHBUTTON: button style is pushbutton -- /li /b BS_BITMAP: displays a bitmap -- /li /b WS_TABSTOP: the control can be tabbed to className[ TogglePicture ] = "button" classType[ TogglePicture ] = BUTTON classStyle[ TogglePicture ] = or_all( { WS_CHILD, WS_VISIBLE, BS_PUSHLIKE, BS_AUTOCHECKBOX, BS_BITMAP, WS_TABSTOP} ) -- NEW! 0.45f changed TrackBar to HTrackBar ----------------------------------------------------------------------------- --/topic Controls --/const HTrackBar --/desc Horizontal track bar control. -- An HTrackBar has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b TBS_VERT: vertical scrollbar -- /li /b TBS_AUTOTICKS: ticks automatically created -- /li /b TBS_ENABLESELRANGE: range highlighted, triangles at end of range -- /li /b WS_TABSTOP: the control can be tabbed to className[ HTrackBar ] = TRACKBAR_CLASSA classType[ HTrackBar ] = COMMON_CONTROL classStyle[ HTrackBar ] = or_all( { WS_CHILD, WS_VISIBLE, TBS_HORZ, TBS_AUTOTICKS, TBS_ENABLESELRANGE, WS_TABSTOP} ) -- NEW! 0.45f added horizontal track bar ----------------------------------------------------------------------------- --/topic Controls --/const HTrackBar --/desc Vertical track bar control. -- A VTrackBar has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b TBS_VERT: vertical scrollbar -- /li /b TBS_AUTOTICKS: ticks automatically created -- /li /b TBS_ENABLESELRANGE: range highlighted, triangles at end of range -- /li /b WS_TABSTOP: the control can be tabbed to className[ VTrackBar ] = TRACKBAR_CLASSA classType[ VTrackBar ] = COMMON_CONTROL classStyle[ VTrackBar ] = or_all( { WS_CHILD, WS_VISIBLE, TBS_VERT, TBS_AUTOTICKS, TBS_ENABLESELRANGE, WS_TABSTOP} ) -- NEW! 0.45f tab control ----------------------------------------------------------------------------- --/topic Controls --/const TabControl --/desc Tab Control. -- A TabControl is a container control. It can have one or more /TabItems. -- Selecting a /TabItem in a TabControl activates it, and displays any -- controls that are associated with it. -- -- Since the TabControl is a container, controls can be placed into it, -- just like placing them into a window. However, it becomes the coder's -- responsibility to show and hide various controls as different /TabItems -- are selected. It is easier to associate controls with /TabItems, since -- Win32Lib will automatically take care of those details. -- -- The TabControl has the following attributes: -- -- /li /b WS_CHILD: child control of the parent -- /li /b WS_VISIBLE: it is visible -- /li /b WS_CLIPCHILDEN: controls not fitting on the TabControl are clipped. -- /li /b WS_TABSTOP: the control can be tabbed to className[ TabControl ] = WC_TABCONTROLA classType[ TabControl ] = COMMON_CONTROL classStyle[ TabControl ] = or_all( { WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN, WS_TABSTOP} ) -- NEW! 0.45g tab item ----------------------------------------------------------------------------- --/topic Controls --/const TabItem --/desc Tab on a TabControl. -- A TabItem is a tab attached to the top of a /TabControl. TabItems respond -- to being selected by triggering an /onClick event. -- -- Items can be automatically displayed in a /TabControl by setting their -- owner to the TabItem instead of the /TabControl. Win32Lib will -- automatically reparent controls with TabItems to the TabControl, and -- maintain a logical association between them. For example: -- --/code -- constant -- Win = create( Window, "Testing", 0, Default, Default, 100, 100, 0 ), -- Tabs = create( TabControl, "", Win, 10, 10, 80, 80, 0 ), -- Tab1 = create( TabItem, "Tab Number &1", Tabs, 0, 0, 0, 0, 0 ), -- Tab2 = create( TabItem, "Tab Number &2", Tabs, 0, 0, 0, 0, 0 ), -- Button1 = create( PushButton, "Button 1", Tab2, 10, 60, 80, 40, 0 ) -- --/endcode -- -- In the example above, Button1 is created in Tabs (the parent of Tab2). -- When Tab2 is clicked, it will appear in Tabs at {10,60}. When Tab1 is -- clicked, it will disappear from Tabs. ----------------------------------------------------------------------------- --/topic Controls --/const Screen --/desc Identifes the screen. -- The /Screen refers to the computer screen. It is automatically created, -- and it most graphic methods that work in /Windows will also work with -- the screen. -- -- Example: --/code -- -- Draw an 'x' across the screen -- sequence extent -- -- -- get the screen extent -- extent = /getExtent( /Screen ) -- -- -- set the pen color to red -- /setPenColor( /Screen, Red ) -- -- -- draw the lines -- /drawLine( /Screen, 0, 0, extent[1], extent[2] ) -- /drawLine( /Screen, extent[1], 0, extent[2], 0 ) --/endcode ----------------------------------------------------------------------------- --/topic Controls --/const Printer --/desc Handle to the printer. -- The /Printer refers to the selected printer. Before it can be used, -- you must first select a printer using /getPrinter. After you are done -- printing, you should release the /Printer with /releasePrinter. -- -- Each document should be begin and end with a /startDoc and /endDoc -- pair. Likewise, each page should begin and end with a /startPage and -- /endPage pair. -- -- For the sake of space, the example doesn't use the values returned -- by /getPrinter. -- -- Example: -- --/code -- -- example of using printer -- sequence result -- atom ok -- -- -- select the printer -- result = /getPrinter() -- -- -- did the user select a printer? -- if length( result ) then -- -- -- start a new document -- if not /startDoc( sprintf( "My Job, Copy %s", {i} ) ) then -- exit -- end if -- -- -- start a new page -- if not /startPage() then -- exit -- end if -- -- -- print on the page -- /wPuts( /Printer, "Hello, Printer!" ) -- -- -- close the page -- if not /endPage() then -- exit -- end if -- -- -- close the document -- if not /endDoc() then -- exit -- end if -- -- -- release the printer -- /releasePrinter() -- -- end if -- --/endcode ----------------------------------------------------------------------------- -- NEW! 0.45l added SubProcAddress atom WndProcAddress, -- 32 bit address of Window callback SubProcAddress -- 32 bit address of Controll callback constant AppName = "Win32Lib Application" -- registered name ----------------------------------------------------------------------------- -- vectors ----------------------------------------------------------------------------- --/topic Events --/const onMouse( event, x, y, shift ) --/desc Event triggered when a mouse action takes place. -- The /i event parameter will be one of the following values: -- -- /li /b MouseMove: the mouse was moved -- /li /b LeftDown: the left mouse button was pressed -- /li /b RightDown: the right mouse button was pressed -- /li /b LeftUp: the left mouse button was released -- /li /b RightUp: the right mouse button was released -- /li /b LeftDoubleClick: the left mouse button was double clicked -- /li /b RightDoubleClick: the right mouse button was double clicked -- -- The /i x and /i y parameters specify where the mouse is located. -- If the mouse has been /i grabbed (see /captureMouse), the values -- of /i x and /i y can be negative if the mouse is outside the -- client area. -- -- The /i shift parameter has bits set indicating the if the shift, -- control, and alt keys are pressed. The masks for each key are: -- -- /li /b ShiftMask -- /li /b ControlMask -- /li /b AltMask -- -- For example, to see if the shift key is held down, you could write: -- -- /code -- if and_bits( shift, ShiftMask ) then -- -- shift is held down -- end if -- /endcode ----------------------------------------------------------------------------- --/const onClick() --/desc Mouse is clicked. -- It is issued along with and /onMouse event. -- -- This event is typically used when a control such as a /PushButton or -- /CheckBox is clicked. ----------------------------------------------------------------------------- --/const onKeyPress( keyCode, shift ) --/desc "Printable" key is pressed. -- The /i keyCode is ANSII value of the key. Only "visible" keys are -- reported with this function. To trap "special" keys (such as the -- cursor keys), use /onKeyDown. For example: -- --/code -- -- is it the letter 'a'? -- if keyCode = 'a' then -- -- it's the letter a -- end if --/endcode -- -- The /i shift parameter has bits set indicating the if the shift, -- control, and alt keys are pressed. The masks for each key are: -- -- /li /b ShiftMask -- /li /b ControlMask -- /li /b AltMask -- -- For example, to see if the control key is held down, you could write: -- -- /code -- -- control key held down? -- if and_bits( shift, ControlMask ) then -- -- control key is held down -- end if -- /endcode ----------------------------------------------------------------------------- --/const onKeyUp( scanCode, shift ) --/desc Key is released. -- The /i scanCode is the raw scan code value of the key. Use the -- /b VK_ constants to determine the value of the key. -- -- The /i shift parameter has bits set indicating the if the shift, -- control, and alt keys are pressed. -- --See /onKeyDown for details. ----------------------------------------------------------------------------- --/const onKeyDown( scanCode, shift ) --/desc Key is pressed. -- The /i scanCode is "raw" value of the key. The primary purpose -- of onKeyDown is to trap "special" keys not reported by /onKeyPress. -- -- The /i shift parameter has bits set indicating the if the shift, -- control, and alt keys are pressed. The masks for each key are: -- -- /li /b ShiftMask -- /li /b ControlMask -- /li /b AltMask -- -- For example, to see if the Shift+Backspace key was pressed, you could -- write: -- -- /code -- -- shift+backspace? -- if and_bits( shift, ControlMask ) -- and scanCode = VK_BACK then -- -- shift+backspace held -- end if -- /endcode ----------------------------------------------------------------------------- --/const onResize( style, x, y ) --/desc A /Window is resized. -- The /i style is one of the following: -- -- /li /b SIZE_RESTORED: Window was restored -- /li /b SIZE_MINIMIZED: Window was minimized -- /li /b SIZE_MAXIMIZED: Window was maximized -- -- Expect the /i style parameters to change to system-independant -- constants at some point in time. -- -- The /i x and /i y parameters are the size of the client area. ----------------------------------------------------------------------------- --/const onChange() --/desc Value in a control is changed. -- To determine the new value of the control, use the appropriate -- function - /getText, /isChecked, etc. ----------------------------------------------------------------------------- --/const onGotFocus() --/desc A /control (or /Window) receives focus. -- /i Focus means that keyboard events are directed to that control. -- Static controls (such as /LText) cannot get focus. -- -- When a Win32Lib window gets focus, it will give focus back to the -- last control in the window that had focus. If there are no controls in -- the window that can recieve focus, the focus will remain with the -- window. ----------------------------------------------------------------------------- --/const onLostFocus() --/desc A /Window or /control loses focus. -- /i Focus means that keyboard events are directed to that control. See -- /onGotFocus. ----------------------------------------------------------------------------- --/const onScroll( position ) --/desc Scrollbar value has changed. -- The /i position parameter indicates the new value of a scrollbar or -- trackbar. -- -- This event is only triggered for /HScroll and /VScroll controls. ----------------------------------------------------------------------------- --/const onOpen() --/desc A /Window is opened. -- This is typically triggered by /WinMain, or /openWindow, -- before the window is visible by the user. -- -- Typically, code that is run at this point does some sort of -- initialization. -- -- This event is only triggered for a /Window. ----------------------------------------------------------------------------- --/const onClose() --/desc A /Window is closed. -- This typically occurs via /closeWindow, although the user can select -- the /i close control on the window as well. -- -- Closing a window does not actually destroy it (unless it is the -- main window; the window is merely hidden. Refer to /closeWindow for -- more details. -- -- This event is only triggered for a /Window. ----------------------------------------------------------------------------- --/const onDestroy() --/desc The application is being closed. -- This is triggered when a the main window is closed. -- -- This event is only triggered for the main window. ----------------------------------------------------------------------------- --/const onTimer() --/desc A timer is triggered. -- Timers are clocks that are maintained by Windows, and trigger onTimer -- events at a user-specified interval, measured in milliseconds. -- -- They are created and removed with the calls: -- -- /li /setTimer( window, timer id, milliseconds ) -- /li /killTimer( window, timer id ) -- -- A timer is not treated as an actual control. Rather, the event is sent -- to the window that the timer is associated with. -- ----------------------------------------------------------------------------- --/const onPaint( x1, y1, x2, y2 ) --/desc A portion or all of a /Window needs to be redrawn. -- The parameters indicate the portion of the window that needs -- to be updated. -- -- Not only does {x1,y1,x2,y2} define the area that needs to be redrawn, -- Windows restricts your application to only being able to draw in those -- areas! If your application tries to write outside this rectangle on an -- onPaint event, nothing will be drawn there. -- -- Since Windows expects you application to be able to redraw any part -- of the application's window when responding to an onPaint event, this -- means that the onPaint routine must know how to render any part of the -- window. -- -- For programs without any graphics and text drawn on the window, there -- is no problem - since there are no graphics, there is nothing to update. -- -- If the application is fairly lightweight (such as a tic-tac-toe game), -- you simply choose to ignore the parameters passed to onPaint, and redraw -- the entire window with each onPaint event. -- -- If there is sufficient graphics to make the task of repainting the -- window complex, the best approach is probably to do double-buffering -- with a /Pixmap. ----------------------------------------------------------------------------- --/const onDragAndDrop( file name ) --/desc A file has been dragged onto the control or window. -- This is triggered by the user dragging and dropping a file onto a -- control or window. If more than one file is dropped, each file name -- triggers a seperate onDragAndDrop event. The following controls respond to -- onDragAndDrop: -- -- /li /Window -- /li /List -- /li /SortedList -- /li /EditText -- /li /MleText -- -- For example, the following code adds the name of the file to TheList -- when a file is dragged and dropped on it: -- --/code -- procedure dropped( fileName ) -- -- add the file name to the list -- /addItem( TheList, fileName ) -- end procedure -- onDragAndDrop[ TheList ] = routine_id("dropped") --/endcode ----------------------------------------------------------------------------- --/const onEvent( event, wParam, lParam ) --/desc An event (any type) has occured. -- Before the events are processed by any of the trap routines or -- default Windows routines, the /onEvent trap is processed. -- -- If you want to skip the default Windows processing of the event, -- pass a non-zero value to the /returnValue routine. global sequence onMouse, onClick, onKeyPress, onKeyUp, onKeyDown, onResize, onChange, onGotFocus, onLostFocus, onScroll, onOpen, onClose, onDestroy, onTimer, onPaint, -- NEW! 0.45k onDragAndDrop, onEvent onMouse = {} onClick = {} onKeyPress = {} onKeyUp = {} onKeyDown = {} onResize = {} onChange = {} onGotFocus = {} onLostFocus = {} onScroll = {} onOpen = {} onClose = {} onDestroy = {} onTimer = {} onPaint = {} -- NEW! 0.45k onDragAndDrop = {} onEvent = {} integer -- NEW! 0.41 renamed defaultWindow to mainWindow mainWindow, modalWindow -- NEW! 0.43d used paintDC stack to track onPaint's DC sequence modalStack, paintDC mainWindow = 0 -- no main window set yet modalStack = {} -- modals under modal window modalWindow = 0 -- no modal windows paintDC = {} -- no paint dc's held -- NEW! 0.41 track current self and return value in stack -- current id and return value sequence myId, myReturn myId = {} myReturn = {} -- controls sequence -- NEW! 0.45f removed window window_handle, -- hwnd of controls window_func, -- Long pointer to function window_class, -- control class -- NEW! 0.31 added window_type window_type, -- win32lib type -- NEW! 0.45g changed tab to focus_order window_focus_order, -- focus order of controls window_focus, -- current focus window_owner, -- owner window_menu, -- menu in window -- NEW! 0.40 added toolbar and statusbar window_toolbar, -- toolbar in window window_statusbar, -- statusbar in window -- NEW! 0.41 added window tooltip window_tooltip, -- handle to tooltip control window_font, -- font resource window_fcolor, -- foreground color window_bcolor, -- background color window_pen, -- pen: { id, color, style } window_x, -- x position window_y, -- y position window_scroll, -- scroll: { small change, large change } -- NEW! 0.45f window_range, -- scroll range { low, high } -- NEW! 0.45f window_tabitems, -- tabs in tab control -- NEW! 0.45g added window_group window_group, -- items grouped with window, but not owned -- NEW! 0.44b window_cursor, -- cursor associated with window -- NEW! 0.44h added hotkeys window_hotkeys, -- NEW! 0.45r added textalign window_textalign -- alignment of text -- initialize window_handle = {} window_func = {} window_class = {} -- NEW! 0.31 added window_type window_type = {} -- NEW! 0.45g changed tab to focus_order window_focus_order = {} window_focus = {} window_owner = {} window_menu = {} -- NEW! 0.4x added toolbar and statusbar window_toolbar = {} window_statusbar = {} -- NEW! 0.41 added tooltip window_tooltip = {} window_font = {} window_fcolor = {} window_bcolor = {} window_pen = {} window_x = {} window_y = {} window_scroll = {} -- NEW! 0.45f added range window_range = {} -- NEW! 0.45f added tabitems window_tabitems = {} -- NEW! 0.45g added group window_group = {} -- NEW! 0.44b added cursor window_cursor = {} -- NEW! 0.44h window_hotkeys = {} -- NEW! 0.45r added textalign window_textalign = {} ----------------------------------------------------------------------------- -- Tool tip emulation -- NEW! 0.41 constant TooltipTimerId = 2000, -- timer id of tooltip TooltipInactive = 0, -- tooltip not running TooltipArmed = 1, -- tooltip ticking TooltipShown = 2 -- tooltip shown -- NEW! 0.45j added tooltipWindow integer tooltipControl, -- control mouse was last over tooltipWindow, -- window the tooltip is in tooltipState, -- state of tooltips tooltipMouseX, -- position of mouse when arming tooltip tooltipMouseY, tooltipX, -- position of tooltip tooltipY, -- NEW! 0.45f tooltipShow -- if false, don't display atom tooltipCovers -- copy of screen area covered by tooltip -- NEW! 0.45j added tooltipWindow -- defaults tooltipControl = 0 tooltipWindow = 0 tooltipState = TooltipInactive tooltipX = 0 tooltipY = 0 -- NEW! 0.45f tooltipMouseX = -1 tooltipMouseY = -1 tooltipShow = True -- display tooltipCovers = 0 ----------------------------------------------------------------------------- --/topic Graphics --/func rgb( red, green, blue ) --/desc Convert a {red, green, blue} tuple into a color. --/ret Atom representing the color tuple. -- Converts the /i red, /i green and /i blue values (ranging from 0-255) -- into an atom representing that color tuple. Each value represents the -- relative brightness of each primary color element. -- -- Example: -- /code -- -- set the pen color to a random green -- /setPenColor( MyControl, /rgb( 0, 0, rand( 255 ) -- /endcode global function rgb( integer r, integer g, integer b ) -- return RGB value of triad return r + ( g * 256 ) + ( b * 256 * 256 ) end function ----------------------------------------------------------------------------- -- Pen Colors global constant Black = rgb( 0, 0, 0 ), Blue = rgb( 0, 0, 127 ), Green = rgb( 0, 127, 0 ), Cyan = rgb( 0, 127, 127 ), Red = rgb( 127, 0, 0 ), Magenta = rgb( 127, 0, 127 ), Brown = rgb( 127, 127, 0 ), White = rgb( 127, 127, 127 ), Gray = rgb( 127, 127, 127 ), BrightBlue = rgb( 0, 0, 255 ), BrightGreen = rgb( 0, 255, 0 ), BrightCyan = rgb( 0, 255, 255 ), BrightRed = rgb( 255, 0, 0 ), BrightMagenta = rgb( 255, 0, 255 ), Yellow = rgb( 255, 255, 0 ), BrightWhite = rgb( 255, 255, 255 ) -- Pen Styles global constant Solid = 0, Dash = 1, -- ------- Dot = 2, -- ....... DashDot = 3, -- _._._._ DashDotDot = 4 -- _.._.._ -- NEW! 0.42 transparency color atom transColor -- NEW! 0.45r system font ANSI_VAR_FONT instead of SYSTEM_FONT -- NEW! 0.45l added NullBrushID constant -- null brush NullBrushID = c_func( xGetStockObject, { NULL_BRUSH } ), -- default font DefaultFontID = c_func( xGetStockObject, { ANSI_VAR_FONT } ), -- default pen DefaultPenID = c_func( xGetStockObject, {BLACK_PEN}), -- NEW! 0.45j added PenWidth -- pen attributes PenValid = 1, PenColor = 2, PenStyle = 3, PenROP2 = 4, PenBkMode = 5, PenWidth = 6, PenDefault = { 0, Black, Solid, R2_COPYPEN, TRANSPARENT, 1 }, -- font attributes FontName = 1, FontSize = 2, FontAttrib = 3, FontColor = 4, FontDefault = { "", 0, 0, Black } global constant Default = CW_USEDEFAULT ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- RESOURCE TRACKING -- -- This is used to track GDI resources held by the application. -- This module is defined early on so that on an abortErr, the -- code can still run the cleanup. global constant ForPaint = 0, -- resource lives until end of onPaint ForProgram = 1 -- resource lived until end of program constant ResHandle = 1, -- Win32 handle (primary key) ResOwner = 2, -- the resource WinLib id ResLife = 3, -- how long the resource lives NewRes = repeat( 0, 3 ) -- NEW! 0.30 removed stockResource -- NEW! 0.44b added held cursor sequence heldResource, -- list of held resources, and their scope heldCursor -- list of held cursors -- initialize heldResource = {} heldCursor = {} -- NEW! 0.30 added test -- NEW! 0.45l changed logic ----------------------------------------------------------------------------- function isStockResource( atom a ) -- returns true if a is a stock object -- any resource created with GetStockObject should be added here -- NEW! 0.45o added STOCK_LAST test back return a = DefaultFontID or a = DefaultPenID or a = NullBrushID or ( a > 0 and a <= STOCK_LAST ) end function ----------------------------------------------------------------------------- global procedure deleteObject( atom handle ) -- deletes an object if not a stock resource -- removes it from the tracking list integer at -- NEW! 0.45l check for null if handle = NULL then return end if -- NEW! 0.30 changed stock resource test -- stock resource? if isStockResource( handle ) then -- do nothing return end if -- NEW! 0.45o only release if one of mine -- is this a known resource? at = findKey( handle, heldResource ) if at then -- try to release it if c_func( xDeleteObject, {handle} ) then -- remove from list heldResource = removeIndex( at, heldResource ) end if end if end procedure ----------------------------------------------------------------------------- global procedure trackObject( integer owner, atom hResource, integer lifetime ) -- tracks object as held resource sequence res -- NEW! 0.30 changed stock resource test -- NEW! 0,45l added NULL test (probably not needed) -- don't add to list if it's a stock resource, or already there if not hResource = NULL and not isStockResource( hResource ) and not findKey( hResource, heldResource ) then -- create a resource res = NewRes -- assign values res[ResHandle] = hResource res[ResOwner] = owner res[ResLife] = lifetime -- add the resource to the resource list heldResource = append( heldResource, res ) end if end procedure ----------------------------------------------------------------------------- global procedure replaceObject( integer owner, atom hdc, atom hResource, integer lifetime ) -- adds resource tracking to selectObject -- track the object trackObject( owner, hResource, lifetime ) -- select current, replace prior deleteObject( c_func( xSelectObject, {hdc, hResource} ) ) end procedure -- NEW! 0.44b track mouse pointers ----------------------------------------------------------------------------- global procedure trackCursor( atom hCursor ) -- tracks cursors as resources -- don't add to list if already there if not find( hCursor, heldCursor ) then -- add to list heldCursor &= hCursor end if end procedure ----------------------------------------------------------------------------- procedure releasePaintResources() -- free resources created during onPaint event integer id sequence held -- copy, because list shrinks held = heldResource -- for each resource for i = 1 to length( held ) do -- if only lives for paint event if held[i][ResLife] = ForPaint then -- get the id id = held[i][ResOwner] -- flag that the pen needs to be recreated window_pen[id][PenValid] = 0 -- release the object deleteObject( held[i][ResHandle] ) end if end for end procedure ----------------------------------------------------------------------------- procedure releaseResourcesForID( integer id ) -- free resources associated with a particular resource sequence held -- copy, because list shrinks held = heldResource -- for each resource for i = 1 to length( held ) do -- if only lives for paint event if held[i][ResLife] = ForPaint and held[i][ResOwner] = id then -- release the object deleteObject( held[i][ResHandle] ) end if end for -- flag that the pen needs to be recreated window_pen[id][PenValid] = 0 end procedure ----------------------------------------------------------------------------- procedure releaseAllResources() -- frees all resources sequence held atom result -- copy, because list shrinks held = heldResource -- for each resource for i = 1 to length( held ) do -- release the object deleteObject( held[i][ResHandle] ) end for -- NEW! 0.44b -- release the cursors for i = 1 to length( heldCursor ) do result = c_func( xDestroyCursor, { heldCursor[i] } ) end for heldCursor = {} end procedure ----------------------------------------------------------------------------- function to_flag( atom a ) -- return value based on truth of first arg if a then return 1 else return 0 end if end function ----------------------------------------------------------------------------- -- -- GLOBAL PROCEDURES -- ----------------------------------------------------------------------------- --/topic Low Level Routines --/func sendMessage( control, command, wParam, lParam ) --/desc Send a Win32 message to the requested control. --/ret Win32 result code. -- -- This just converts the control id into a handle and calls -- /b SendMessage. global function sendMessage( integer id, atom cmd, atom wParm, atom lParm ) -- send a command to a control return c_func( xSendMessage, { window_handle[id], cmd, wParm, lParm } ) end function ----------------------------------------------------------------------------- procedure setId( atom hWnd, integer id ) atom ok ok = c_func( xSetWindowLong, { hWnd, GWL_USERDATA, id } ) end procedure ----------------------------------------------------------------------------- function getId( atom hWnd ) return c_func( xGetWindowLong, { hWnd, GWL_USERDATA } ) end function ----------------------------------------------------------------------------- function validId( atom id ) -- NEW! 0.45f uses length of window_handle instead of window -- returns true if a is a valid it return ( id > 0 and id <= length( window_handle ) ) end function -- NEW! 0.43 ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Printer Support atom printerDC printerDC = 0 ----------------------------------------------------------------------------- --/topic Printing --/proc releasePrinter() --/desc Release the /Printer, freeing it up for others to use. -- The /Printer must first be grabbed with /getPrinter. -- -- Refer to /Printer for details. global procedure releasePrinter() -- is there a dc to delete? if printerDC then -- NEW! 0.45l -- release resources releaseResourcesForID( Printer ) -- attempt to delete it if not c_func( xDeleteDC, {printerDC} ) then warnErr( "releasePrinter:DeleteDC failed." ) end if -- clear the handle printerDC = 0 end if end procedure ----------------------------------------------------------------------------- --/topic Printing --/func getPrinter() --/desc Get the /Printer. --/ret { start page, end page, copies }, or False if user aborted. -- This pops up the "Select Printer" dialog for the -- user to select a printer from. -- -- Refer to /Printer for details. global function getPrinter() integer result, fromPage, toPage, copies atom mem, flags -- allocate memory for the dialog mem = allocate_struct( SIZEOF_PRINTDLG ) -- default flags flags = PD_HIDEPRINTTOFILE + -- no print to file option PD_PAGENUMS + -- allow page numbers to be selected PD_RETURNDC -- returns dc -- set up store( mem, PRINTDLG_lStructSize, SIZEOF_PRINTDLG ) store( mem, PRINTDLG_flags, flags ) store( mem, PRINTDLG_nMinPage, 1 ) store( mem, PRINTDLG_nMaxPage, 999 ) -- need to release? releasePrinter() -- call the routine result = c_func(xPrintDlg, {mem}) if result then -- store the new dc printerDC = fetch( mem, PRINTDLG_hdc ) -- fetch values fromPage = fetch( mem, PRINTDLG_nMinPage ) toPage = fetch( mem, PRINTDLG_nMaxPage ) copies = fetch( mem, PRINTDLG_nCopies ) else -- clear it to zero printerDC = 0 end if -- release the memory free( mem ) -- what to return? if printerDC then -- information the user selected return { fromPage, toPage, copies } else -- failed return {} end if end function ----------------------------------------------------------------------------- --/topic Printing --/func startDoc( job name ) --/desc Starts a new document on /Printer. --/ret True if succeeds. -- Start a new document on the /Printer. The /i job /i name is the name -- of the job as seen by the system. -- -- Refer to /Printer for details. global function startDoc( sequence job ) -- start the document atom di, result -- allocate the structure di = allocate_struct( SIZEOF_DOCINFO ) -- store the values store( di, DOCINFO_cbSize, SIZEOF_DOCINFO ) store( di, DOCINFO_lpszDocName, job ) store( di, DOCINFO_lpszOutput, NULL ) store( di, DOCINFO_lpszDatatype, NULL ) store( di, DOCINFO_fwType, NULL ) result = c_func( xStartDoc, { printerDC, di } ) -- free the structure free( di ) free_strings() -- returns true if succeeds return (result > 0) end function ----------------------------------------------------------------------------- --/topic Printing --/func endDoc() --/desc Ends the print job. --/ret True if succeeds. -- Applications should call /endDoc when finished printing. -- -- Refer to /Printer for details. global function endDoc() -- end the document return c_func( xEndDoc, {printerDC} ) >= 0 end function ----------------------------------------------------------------------------- --/topic Printing --/func startPage() --/desc Prepares the printer to begin a new page. --/ret True if succeeds. -- -- Refer to /Printer for details. global function startPage() -- start the document return c_func( xStartPage, {printerDC} ) >= 0 end function ----------------------------------------------------------------------------- --/topic Printing --/func endPage() --/desc Ends the printing of the current page. --/ret True if succeeds. -- -- Refer to /Printer for details. global function endPage() -- end the document return c_func( xEndPage, {printerDC} ) >= 0 end function -- NEW! 0.45o moved ----------------------------------------------------------------------------- global function getHandle( atom id ) -- return the handle for the window -- generates warning if not a valid id or handle atom handle -- in range? if validId( id ) then -- get handle handle = window_handle[ id ] if handle = 0 then -- fatal abortErr( "getHandle returned Null handle." ) else return handle end if else -- NEW! 0.45o added warning -- warning abortErr( "getHandle failed." ) -- error. return false return 0 end if end function ----------------------------------------------------------------------------- global function getSelf() -- NEW! 0.41 -- return id of current active control return myId[ length(myId) ] end function ----------------------------------------------------------------------------- sequence grabbedHDC grabbedHDC = {} ----------------------------------------------------------------------------- --/topic Low Level Routines --/func getDC( control ) --/desc Get the DC (device context) of a control. --/ret Device Context (DC) of control. -- If the DC is already grabbed, the value is simply returned without -- grabbing it again. -- -- There are four special cases that are handled: -- -- /li Normal controls: This includes any control that is normally -- visible on the screen. This performs a normal /b GetDC. -- /li /Screen: Passing the parameter of /Screen returns the -- DC of the monitor. -- /li /Printer: Passing the parameter of /Printer returns the -- printer's DC, assuming that one has been selected with -- /getPrinter. -- /li /b Pixmaps: This causes a DC compatible with the screen resolution -- to be created with the pixmap selected into it. -- /li /b Other: If the value passed is not identifiable as a valid -- Win32Lib control, it is assumed to be a DIB. A compatible DC -- is created, and the DIB is selected into it. -- -- When you are done with the DC, it should be released with /releaseDC -- unless the DC was obtained during an /onPaint event, since the DC -- will be released automatically. global function getDC( atom id ) -- get device context. integer at atom hdc, savedDC -- get the device context if id = Screen then hdc = c_func( xGetDC, {0} ) if hdc = NULL then abortErr( "getDC:GetDC failed." ) end if -- NEW! 0.45j saved dc on stack -- save the current device context savedDC = c_func( xSaveDC, {hdc} ) if savedDC = 0 then abortErr( "getDC:SaveDC failed." ) else -- push on stack grabbedHDC = prepend( grabbedHDC, savedDC ) end if -- NEW! 0.43b puts on stack for consistancy elsif id = Printer then -- the printer dc hdc = printerDC elsif not validId( id ) then -- the id isn't a valid handle, so it must be a bitmap. -- create a memory device context compatible with the screen hdc = c_func( xCreateCompatibleDC, {NULL} ) if hdc = NULL then warnErr( "getDC( bitmap ):CreateCompatibleDC failed." ) end if -- select the bitmap into it if not c_func( xSelectObject, {hdc, id} ) then warnErr( "getDC:SelectObject failed." ) end if elsif window_class[ id ] = PIXMAP then -- pixmap class -- create a memory device context compatible with the screen hdc = c_func( xCreateCompatibleDC, {NULL} ) if hdc = NULL then warnErr( "getDC(pixmap):CreateCompatibleDC failed." ) end if -- select the bitmap into it -- NEW! 0.45o replace window_handle with getHandle if not c_func( xSelectObject, {hdc, getHandle(id)} ) then warnErr( "getDC:SelectObject failed." ) end if -- NEW! 0.43d uses paintDC stack elsif findKey( id, paintDC ) then -- get the index at = findKey( id, paintDC ) -- get from the paintDC stack hdc = paintDC[at][2] else -- NEW! 0.45o replace window_handle with getHandle hdc = c_func( xGetDC, {getHandle( id )} ) if hdc = NULL then abortErr( "getDC:GetDC failed." ) end if end if -- add to list grabbedHDC = prepend( grabbedHDC, hdc ) return hdc end function ----------------------------------------------------------------------------- --/topic Low Level Routines --/proc releaseDC( control ) --/desc Release the device context of the control. -- The DC should have been obtained with /getDC. -- -- If the control is not a Pixmap or DIB, and the DC was obtained during an -- /onPaint event, there is no need to release the DC. Win32Lib will -- automatically release all DCs obtained during an /onPaint -- there is no need to release the DC, since -- Win32Lib will release all the DCs at the end of -- supposed to have the DC, there is no need to release it. -- -- If the control is the /Printer, there is no need to release the -- DC using /releaseDC. Instead, use /releasePrinter global procedure releaseDC( atom id ) atom hdc, savedDC -- NEW! 0.43 -- pop the hdc if length( grabbedHDC ) = 0 then warnErr( "ReleaseDC without matching GetDC." ) return else -- get the hdc from the top of the stack hdc = grabbedHDC[1] -- remove from grabbed list list grabbedHDC = grabbedHDC[2..length(grabbedHDC)] end if -- release? if id = Screen then -- NEW! 0.43 -- NEW! 0.45j get saved DC from stack -- pop the saved context from the stack savedDC = grabbedHDC[1] grabbedHDC = grabbedHDC[2..length(grabbedHDC)] -- restore the device context if not c_func( xRestoreDC, {hdc, savedDC} ) then abortErr( "releaseDC:RestoreDC failed." ) end if -- release screen if c_func( xReleaseDC, {0, hdc} ) = 0 then warnErr( "releaseDC:ReleaseDC (screen) failed." ) else -- NEW! 0.45l fix resource leak with tooltips -- release resources releaseResourcesForID( id ) end if -- NEW! 0.43 elsif id = Printer then -- does nothing; use releasePrinter instead. elsif not validId( id ) then -- release the device context if not c_func( xDeleteDC, {hdc} ) then warnErr( "releaseDC:DeleteDC (bitmap) failed." ) end if elsif window_class[id] = PIXMAP then -- release the device context if not c_func( xDeleteDC, {hdc} ) then warnErr( "releaseDC:DeleteDC (Pixmap) failed." ) end if -- release the resources. the next getDC will create a new -- DC for the pixmap, invalidating the resources anyway. releaseResourcesForID( id ) -- NEW! 0.43d uses paintDC stack elsif not findKey( id, paintDC ) then -- release, not held by paint -- NEW! 0.45o replace window_handle with getHandle if c_func( xReleaseDC, {getHandle( id ), hdc} ) = 0 then warnErr( "releaseDC:ReleaseDC failed." ) end if -- release resources releaseResourcesForID( id ) end if end procedure -- NEW! 0.45f moved routines ----------------------------------------------------------------------------- -- FONTS -- ----------------------------------------------------------------------------- -- NEW! 0.43 removed global function EzCreateFont( integer id, atom hdc, sequence faceName, integer iDeciPtHeight, integer iDeciPtWidth, integer iAttributes, integer fLogRes ) -- faceName : font name -- iDeciPtHeight: font size, * 10 (i.e.: 125 = 12.5 points -- iDeciPtWidth : typically zero, but allows altering width -- iAttributes : flags for attributes, see Bold, etc. -- fLogRes : if true, uses logical resolution instead of screen res. atom cxDpi, cyDpi atom hFont atom lf atom pt atom tm atom savedDC integer boldFlag, italicFlag, underlineFlag, strikeOutFlag -- allot topic Low Level Routines -- logical font lf = allocate_struct( SIZEOF_LOGFONT ) -- point pt = allocate_struct( SIZEOF_POINT ) -- text metric tm = allocate_struct( SIZEOF_TEXTMETRIC ) -- NEW! 0.45j keeps track of savedDC -- save the current device context savedDC = c_func( xSaveDC, {hdc} ) if savedDC = 0 then abortErr( "ezCreateFont:SaveDC failed." ) end if -- these are NT specific. they should have no effect in Win95 ok = c_func( xSetGraphicsMode, {hdc, GM_ADVANCED} ) ok = c_func( xModifyWorldTransform, {hdc, NULL, MWT_IDENTITY} ) if not c_func( xSetViewportOrgEx, {hdc, 0, 0, NULL} ) then abortErr( "ezCreateFont:SetViewportOrgEx failed." ) end if if not c_func( xSetWindowOrgEx, {hdc, 0, 0, NULL} ) then abortErr( "ezCreateFont:SetWindowOrgEx failed." ) end if if ( fLogRes ) then cxDpi = c_func( xGetDeviceCaps, {hdc, LOGPIXELSX} ) cyDpi = c_func( xGetDeviceCaps, {hdc, LOGPIXELSY} ) else cxDpi = (25.4 * c_func( xGetDeviceCaps, {hdc, HORZRES} ) / c_func( xGetDeviceCaps, {hdc, HORZSIZE} ) ) cyDpi = (25.4 * c_func( xGetDeviceCaps, {hdc, VERTRES} ) / c_func( xGetDeviceCaps, {hdc, VERTSIZE} ) ) end if store( pt,ptX, iDeciPtWidth * cxDpi / 72 ) store( pt,ptY, iDeciPtHeight * cyDpi / 72 ) if not c_func( xDPtoLP, {hdc, pt, 1} ) then abortErr( "ezCreateFont:DPtoLP failed." ) end if -- check flags boldFlag = to_flag( and_bits( iAttributes, Bold) ) * 700 italicFlag = to_flag( and_bits( iAttributes, Italic) ) underlineFlag = to_flag( and_bits( iAttributes, Underline) ) strikeOutFlag = to_flag( and_bits( iAttributes, Strikeout) ) -- populate the structure store( lf, lfHeight, -floor(abs( fetch( pt,ptY ) / 10.0 + 0.5 ))) store( lf, lfWidth, 0 ) store( lf, lfEscapement, 0 ) store( lf, lfOrientation, 0 ) store( lf, lfWeight, boldFlag ) store( lf, lfItalic, italicFlag ) store( lf, lfUnderline, underlineFlag ) store( lf, lfStrikeOut, strikeOutFlag ) store( lf, lfCharSet, 0 ) store( lf, lfOutPrecision, 0 ) store( lf, lfClipPrecision, 0 ) store( lf, lfQuality, 0 ) store( lf, lfPitchAndFamily, 0 ) store( lf, lfFaceName, faceName & 0 ) -- create the font hFont = c_func( xCreateFontIndirect, {lf} ) if (iDeciPtWidth != 0 ) then -- replace the current font replaceObject( id, hdc, hFont, ForProgram ) -- get the text metrics on the font if not c_func( xGetTextMetrics, {hdc, tm} ) then abortErr( "ezCreateFont:SetTextMetrics failed." ) end if -- calculate the new size store( lf, lfWidth, floor( fetch(tm,tmAveCharWidth) * abs( fetch(pt,ptX) ) / abs( fetch(pt,ptY) ) + 0.5 ) ) -- build the font hFont = c_func( xCreateFontIndirect, {lf} ) end if -- restore the device context if not c_func( xRestoreDC, {hdc, savedDC} ) then abortErr( "ezCreateFont:RestoreDC failed." ) end if -- release topic Low Level Routines free( lf ) free( pt ) free( tm ) -- return handle to font return hFont end function ----------------------------------------------------------------------------- procedure putFontIntoHDC( atom hdc, integer id ) -- set font into the hdc, using the attributes of the font -- interfaces to EzCreateFont -- this is shared by wPuts, getFontSize and getTextExtent atom fontID object result -- need to create a font based on the attributes? if length( window_font[id][FontName] ) then -- call EzCreateFont to build the font fontID = EzCreateFont( id, hdc, -- create font window_font[id][FontName], -- font name window_font[id][FontSize]*10, -- points 0, window_font[id][FontAttrib], -- attributes 0 ) -- NEW! 0.43 elsif id = Printer then -- set to hard-coded values fontID = EzCreateFont( id, hdc, "Times New Roman", 100, 0, 0, 0 ) else -- get the stock system font object fontID = DefaultFontID end if -- replace the font replaceObject( id, hdc, fontID, ForProgram ) -- use the pen color? if c_func(xSetTextColor, {hdc, window_font[id][FontColor]} ) = CLR_INVALID then -- unable to set color warnErr( "SetTextColor in putFontIntoHDC failed." ) end if -- set transparent or opaque if not c_func(xSetBkMode, {hdc, window_pen[id][PenBkMode]} ) then -- unable to set mode warnErr( "SetBkMode in putFontIntoHDC failed." ) end if end procedure ----------------------------------------------------------------------------- --/topic Fonts --/proc wPuts( window, text ) --/desc Equivalent to Euphoria's /i puts() function. -- The /i window parameter determines what /Window will be written to. -- -- Example: --/code -- -- put text in a window -- /wPuts( MyWindow, "Hello, World!" ) --/endcode global procedure wPuts( integer id, object s ) atom hdc, result -- if the parameter is a byte, convert it to a sequence if integer( s ) then -- convert it to a string s = {s} end if -- NEW! 0.41 early out test if length( s ) = 0 then return end if -- get the device context hdc = getDC( id ) -- set the font putFontIntoHDC( hdc, id ) -- NEW! 0.45r -- align the text result = c_func( xSetTextAlign, { hdc, window_textalign[id] } ) -- display the text in the buffer c_proc( xTextOut, { hdc, window_x[id], window_y[id], allot_string( s ), length( s ) } ) -- free the string free_strings() -- replace the font with the default again replaceObject( id, hdc, DefaultFontID, ForProgram ) -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Fonts --/proc wPrintf( window, format, data ) --/desc Equivalent to Euphoria's /i printf() routine. -- /i window specifies the /Window to receive the text. -- -- For example: --/code -- -- show value of a -- /wPrintf( MyWindow, "the value of a is %d", {a} ) --/endcode global procedure wPrintf( integer id, sequence s1, sequence s2 ) -- use wPuts to display message wPuts( id, sprintf( s1, s2 ) ) end procedure ----------------------------------------------------------------------------- function print_format( object o ) -- returns object formatted for wPrint sequence s if atom( o ) then -- number return sprintf( "%d", o ) else -- list s = "{" for i = 1 to length( o ) do s = s & print_format( o[i] ) if i < length( o ) then s = s & "," end if end for s = s & "}" return s end if end function ----------------------------------------------------------------------------- --/topic Fonts --/proc wPrint( window, object ) --/desc Equivalent to Euphoria's /i print() routine. -- /i window specifies the /Window to receive the data. -- -- For example: --/code -- -- dump s to the window -- /wPrint( MyWindow, s ) --/endcode global procedure wPrint( integer id, object o ) -- win32 version of Euphoria's print statement -- use wPuts to display message wPuts( id, print_format( o ) ) end procedure ----------------------------------------------------------------------------- --/topic Fonts --/proc setFont( object, font name, point size, attributes ) --/desc Set the font for a control or window. -- -- The /i attributes flag can be a combination of the following: -- -- /li /b Normal -- /li /b Bold -- /li /b Italic -- /li /b Underline -- /li /b Strikeout -- -- For example: -- --/code -- -- change the font in MyWindow -- /setFont( MyWindow, "Arial", 10, Bold+Italic ) -- /wPuts( MyWindow, "This is Arial 10 point bold italic." ) --/endcode global procedure setFont( integer id, sequence faceName, integer points, integer attrib ) -- set the current font attributes -- Window fonts are set as attributes for later assignment -- Control fonts assign fonts with WM_SETFONT atom hFont, hdc -- NEW! 0.41 font information saved for all controls and windows window_font[id][FontName] = faceName window_font[id][FontSize] = points window_font[id][FontAttrib] = attrib -- NEW! 0.43c checks for printer and screen if id = Printer or id = Screen or window_class[id] = WINDOW or window_class[id] = PIXMAP then -- defer creation until print event else -- get the DC hdc = getDC( id ) -- create now hFont = EzCreateFont( id, hdc, faceName, points * 10, 0, attrib, 0 ) -- release the dc releaseDC( id ) -- update immediately ok = sendMessage( id, WM_SETFONT, hFont, -1 ) -- track it trackObject( id, hFont, ForProgram ) end if end procedure ----------------------------------------------------------------------------- --/topic Fonts --/proc setDefaultFont( id ) --/desc Set the font to default system font. -- -- Example: -- --/code -- -- restore MyWindow to the default font -- /setDefaultFont( MyWindow ) --/endcode global procedure setDefaultFont( integer id ) -- Window fonts are set as attributes for later assignment -- Control fonts assign fonts with WM_SETFONT -- NEW! 0.41 save font info for controls also -- empty name indicates default font window_font[id][FontName] = "" -- NEW! 0.20a pixmap support if window_class[id] = WINDOW or window_class[id] = PIXMAP then -- defer creation until print event else -- replace the current font with the default replaceObject( id, getHandle( id ), DefaultFontID, ForProgram ) -- update immediately ok = sendMessage( id, WM_SETFONT, DefaultFontID, -1 ) end if end procedure ----------------------------------------------------------------------------- -- NEW! 0.43 function queryFont( integer id, atom request, sequence args ) -- this runs a query about font attributes. because the query -- can run against controls (which have no obtainable DC), the -- queries are performed on the mainWindow. The exception is -- the Printer, which uses it's own DC. -- -- The DC is automatically prepended to the arg list. -- -- Since the mainWindow is used, it has to be restored to it's -- prior state when the query is complete. integer useId atom hdc, result sequence saved -- using the Printer? if id = Printer then -- use the printer's dc useId = Printer else -- NEW! 0.45q added warning -- perhaps I should use the screen instead... if mainWindow = 0 then abortErr( "queryFont: no windows defined" ) end if -- save the mainWindow, since it's dc will be used saved = window_font[mainWindow] window_font[mainWindow] = window_font[id] -- use the main window useId = mainWindow end if -- get the dc hdc = getDC( useId ) -- set the font putFontIntoHDC( hdc, useId ) -- perform the requested function result = c_func( request, hdc & args ) -- replace the font with the default again replaceObject( useId, hdc, DefaultFontID, ForProgram ) -- used the main window? if useId = mainWindow then -- restore the main window's font attributes window_font[mainWindow] = saved end if -- NEW! 0.45j releaseDC added -- release the DC releaseDC( useId ) return result end function -- NEW 0.45r ----------------------------------------------------------------------------- --/topic Fonts --/func getFontMetric( id, field ) --/desc Gets font metric field value for /i id's current font. --/ret field's value -- -- Example: -- --/code -- -- get the descent for the default font -- integer descent -- -- /setDefaultFont( MyWindow ) -- descent = /getFontMetric( MyWindow, tmDescent ) -- /wPrintf( MyWindow, "The default font's descent is %", descent ) --/endcode global function getFontMetric( integer id, sequence field ) -- get metrics for current font -- because this needs a DC to work, the mainWindow is used -- NEW! 0.43 uses queryFont integer result atom tm -- text metric structure tm = allocate_struct( SIZEOF_TEXTMETRIC ) -- get the metrics of the font (queryFont will prepend the DC) if not queryFont( id, xGetTextMetrics, {tm} ) then warnErr( "GetTextMetrics in getFontSize failed." ) end if -- fetch field result = fetch(tm, field) -- release topic Low Level Routines free( tm ) return result end function ----------------------------------------------------------------------------- --/topic Fonts --/proc getFontSize( id ) --/desc Gets font metrics for /i id's current font. --/ret { width, height } of average character. -- -- Example: -- --/code -- -- show the metrics of the default font -- sequence size -- -- /setDefaultFont( MyWindow ) -- size = /getFontSize( MyWindow ) -- /wPrintf( MyWindow, "The default font is %d by %d", size ) --/endcode -- NEW! 0.41 sets fonts in mainWindow global function getFontSize( integer id ) -- get metrics for current font -- because this needs a DC to work, the mainWindow is used -- NEW! 0.43 uses queryFont integer width, height atom tm -- text metric structure tm = allocate_struct( SIZEOF_TEXTMETRIC ) -- get the metrics of the font (queryFont will prepend the DC) if not queryFont( id, xGetTextMetrics, {tm} ) then warnErr( "GetTextMetrics in getFontSize failed." ) end if -- assign values width = fetch(tm,tmAveCharWidth) height = fetch(tm,tmHeight) -- release topic Low Level Routines free( tm ) -- return results return { width, height } end function ----------------------------------------------------------------------------- --/topic Fonts --/proc getTextExtent( object, text ) --/short Gets the metrics of the /i text string, using /i object's current font. --/ret { width, height } of /i text. -- -- Example: -- --/code -- -- show the metrics of the string -- sequence text, extent -- -- -- the string to measure -- text = "Hi, there!" -- -- -- measure the string -- extent = /getTextExtent( MyWindow, text ) -- -- -- show results -- /wPrintf( MyWindow, "The string %s is %d by %d", {string, extent[1], extent[2]} ) --/endcode global function getTextExtent( integer id, sequence text ) -- get metrics for current font integer width, height atom size, string -- NEW! 0.43 uses queryFont -- allocate topic Low Level Routines size = allocate_struct( SIZEOF_SIZE ) string = allocate_string( text ) -- get the metrics of the font (queryFont will prepend the DC) if not queryFont( id, xGetTextExtentPoint, {string, length(text), size} ) then abortErr( "getTextExtent:GetTextExtentPoint failed." ) end if -- assign values width = fetch(size,sizX ) height = fetch(size,sizY) -- release topic Low Level Routines free( size ) free( string ) -- return results return { width, height } end function -- NEW 0.45r ----------------------------------------------------------------------------- --/topic Fonts --/proc setTextAlign( id, style ) --/desc Set the font alignment to use when printing text. -- -- The default option is AlignTop. Options include: -- -- /li /b AlignTop: Text is displayed below {x,y} -- /li /b AlignBottom: Text is displayed above {x,y} -- /li /b AlignBaseline: Text is displayed on baseline {x,y} -- -- Example: -- --/code -- -- draw a line -- drawLine( Win, 10, 100, 100, 100 ) -- -- -- top alignment (default) -- setTextAlign( Win, AlignTop ) -- setPosition( Win, 10, 100 ) -- wPuts( Win, "AlignTop" ) -- -- -- bottom alignment -- setTextAlign( Win, AlignBottom ) -- setPosition( Win, 10, 100 ) -- wPuts( Win, "AlignBottom" ) -- --/endcode -- NEW! 0.41 sets fonts in mainWindow global procedure setTextAlign( integer id, integer flag ) window_textalign[id] = flag end procedure ----------------------------------------------------------------------------- -- CREATING CONTROLS -- ----------------------------------------------------------------------------- procedure createMenu( integer class, integer id, sequence mText, integer owner ) -- used to assign a menu to a window -- the structure is already created by create() -- set the class to menu object attachTo window_class[ id ] = class -- NEW! 0.45 -- if menu and there is no menu for this window, create one if class = MENU and window_menu[ owner ] = 0 and window_class[owner] = WINDOW then -- create a menu window_menu[ owner ] = c_func( xCreateMenu, {} ) if window_handle[ id ] = NULL then -- couldn't create it warnErr( "CreateMenu in createMenu failed." ) end if -- attach the menu to the window if not c_func( xSetMenu, { getHandle( owner ), window_menu[ owner ] } ) then warnErr( "SetMenu in createMenu failed." ) end if end if -- where does this attach to? if window_class[owner] = MENU or window_class[owner] = MENUITEM then -- NEW! 0.45o replace window_handle with getHandle attachTo = getHandle( owner ) elsif window_class[owner] = WINDOW then attachTo = window_menu[owner] end if -- create popup menu for this item window_handle[ id ] = c_func( xCreatePopupMenu, {} ) if window_handle[ id ] = NULL then warnErr( "CreatePopupMenu in CreateMenu failed." ) end if -- attach a menu item if it's not a popup -- NEW! 0.45o replaced window_handle with getHandle if class = MENU then if not c_func( xAppendMenu, { attachTo, MF_POPUP, getHandle( id ), allot_string( mText )} ) then -- error warnErr( "AppendMenu in createMenu failed." ) end if end if -- free the string free_strings() end procedure ----------------------------------------------------------------------------- procedure createMenuItem( integer id, sequence mText, integer owner ) integer flag -- set the class to menu item window_class[ id ] = MENUITEM -- NEW! 0.45o replaced window_handle with getHandle -- store owner's handle window_handle[ id ] = getHandle( owner ) -- string, or seperator? flag = iif( equal( mText, "-" ), MF_SEPARATOR, MF_STRING ) -- NEW! 0.45o replaced window_handle with getHandle -- create a menu item if not c_func( xAppendMenu, { getHandle( owner ), -- menu to attach to flag, -- string or seperator id, -- id allot_string( mText )} ) -- text then -- error warnErr( "AppendMenu in createMenuItem failed." ) end if -- free the string free_strings() end procedure ----------------------------------------------------------------------------- -- NEW! 0.41 removed from createWindow -- NEW! 0.41a pass class name procedure registerClass( atom szClassName ) -- register the application class atom wndClassEx -- allocate window class structure wndClassEx = allocate_struct(SIZEOF_WNDCLASSEX) -- NEW! 0.45q added instance as parameter -- build the structure store( wndClassEx, winExSize, SIZEOF_WNDCLASSEX) store( wndClassEx, winExStyle, or_all({CS_HREDRAW, CS_VREDRAW })) store( wndClassEx, winExProc, WndProcAddress) store( wndClassEx, winExClsExtra, 0) store( wndClassEx, winExExtra, 0) store( wndClassEx, winExInstance, instance()) store( wndClassEx, winExIcon, c_func( xLoadIcon, { NULL, IDI_APPLICATION } ) ) store( wndClassEx, winExCursor, c_func( xLoadCursor, { NULL, IDC_ARROW } ) ) store( wndClassEx, winExBackground, WindowColor+1 ) store( wndClassEx, winExMenuName, NULL) store( wndClassEx, winExClassName, szClassName ) store( wndClassEx, winExIconSm, c_func( xLoadIcon, { NULL, IDI_APPLICATION } ) ) if c_func( xRegisterClassEx, { wndClassEx } ) = 0 then abortErr( "RegisterClassEx failed." ) end if -- free structure free( wndClassEx ) end procedure -- NEW! 0.41a each window is registered integer regCount regCount = 0 ----------------------------------------------------------------------------- -- NEW! 0.45f pass parameters, removed global 'window' -- NEW! 0.43 procedure no longer global procedure createWindow( integer id, integer class, sequence caption, atom owner, atom x, atom y, atom xSize, atom ySize, atom flags ) -- create a window -- main routine atom szClassName atom hWnd, hParent, result -- NEW! 0.41a each Window is registered with to a new class -- need to register each window, so each has seperate background -- color attributes, etc. regCount += 1 szClassName = allot_string( sprintf( "Win32Lib AppWindow %d", {regCount} ) ) registerClass( szClassName ) -- if flags not specified, use WS_OVERLAPPEDWINDOW as default if flags = 0 then flags = or_bits( flags, WS_OVERLAPPEDWINDOW ) end if -- NEW! 0.45o check handle of parent if owner then hParent = getHandle( owner ) else hParent = NULL end if -- NEW! 0.45k added WS_EX_ACCEPTFILES -- NEW! 0.45l pass handle of parent -- NEW! 0.45q pass instance as a parameter hWnd = c_func( xCreateWindow, { WS_EX_ACCEPTFILES, -- extended style szClassName, -- window class name allot_string(caption), -- window caption flags, -- window style x, -- initial x position y, -- initial y position xSize, -- initial x size ySize, -- initial y size hParent, -- parent window handle NULL, -- window menu handle instance(), -- program instance handle NULL } ) -- creation parameters if hWnd = 0 then abortErr( "CreateWindow in createWindow failed." ) end if -- save attributes setId( hWnd, id ) window_handle[ id ] = hWnd window_class[ id ] = WINDOW window_owner[ id ] = 0 -- free the strings used in the structure free_strings() -- NEW! 0.47l set default window back color -- create a new brush result = c_func( xCreateSolidBrush, {window_bcolor[id]} ) -- NEW! 0.45o replaced window_handle with getHandle -- set that as the background color result = c_func( xSetClassLong, {getHandle(id), GCL_HBRBACKGROUND, result} ) -- delete the prior brush, if Win32Lib created it deleteObject( result ) -- NEW! 0.41 set mainWindow, so getFontExtent will work if mainWindow = 0 then mainWindow = id end if end procedure ----------------------------------------------------------------------------- procedure createPixmap( integer id, integer x, integer y ) atom hdc, handle -- store class window_class[ id ] = PIXMAP -- need to initialize pixmap? if x != 0 and y != 0 then -- get the dc of the screen hdc = getDC( Screen ) -- create a window sized bitmap compatible with the screen handle = c_func( xCreateCompatibleBitmap, { hdc, x, y } ) if handle = NULL then warnErr( "createPixmap:CreateCompatibleBitmap failed" ) end if -- release the dc releaseDC( Screen ) -- store the handle window_handle[ id ] = handle -- track the bitmap as a resource trackObject( id, handle, ForProgram ) else -- store zero window_handle[ id ] = 0 end if end procedure -- NEW! 0.45f ----------------------------------------------------------------------------- procedure createTabItem( integer id, sequence caption, integer owner ) -- insert a tab into a tab control integer tabNumber atom hTabData, hTabItem -- add id to owner's tab list window_tabitems[ owner ] &= id -- get tab index tabNumber = length( window_tabitems[ owner ] ) -- allocate a tab structure hTabData = allocate_struct( SIZEOF_TC_ITEM ) -- set the items store( hTabData, TC_ITEM_mask, TCIF_TEXT ) store( hTabData, TC_ITEM_iImage, -1 ) store( hTabData, TC_ITEM_pszText, caption ) store( hTabData, TC_ITEM_cchTextMax, length(caption) ) -- insert into tab list hTabItem = sendMessage( owner, TCM_INSERTITEM, tabNumber, hTabData ) if hTabItem = -1 then abortErr( "Failed to create a TabItem in create:createTabItem." ) end if -- store the handle window_handle[ id ] = hTabItem -- free the structure free( hTabData ) -- free caption string free_strings() end procedure -- NEW! 0.46h ----------------------------------------------------------------------------- procedure registerHotKey( integer id, sequence caption ) -- register the hotkey with the parent window integer at, parent, key -- find the parent window parent = id while window_class[ parent ] != WINDOW do -- move up parent = window_owner[ parent ] -- hit top of tree? if parent = 0 then -- control not placed in window return end if end while -- is this a default key? if window_type[ id ] = DefPushButton then -- associate the return key with the control window_hotkeys[parent] &= {{ VK_RETURN, id }} end if -- is there a hotkey in the caption? at = find( '&', caption ) if at = 0 then -- no hotkey return elsif at = length( caption ) then -- error, the '&' was at the end of the string return else key = caption[at+1] end if -- convert the key to upper case -- NOTE: Not internationalized! if key >= 'a' and key <= 'z' then key -= ('a' - 'A') end if -- register the key with the parent window_hotkeys[parent] &= {{ key, id }} end procedure ----------------------------------------------------------------------------- --/topic Attributes --/func create( class, title, parent, x, y, cx, cy, flags ) --/desc Create an object of type /i class. --/ret Control identifier. -- -- The /i title is the text that will appear in the object's caption. -- /i x and /i y specify the position of the object, and /i cx and -- /cy specify the width and height. -- -- You can specify additional attributes by passing them in the /i flags -- parameter. -- -- /b Returns: The value returned is the /i id of the control. This is -- typically the first parameter expected in Win32Lib functions. -- -- The parent of the main window is 0. -- -- If you don't care about the positioning of a window, you can -- use the parameter /b Default, and Windows will automatically -- position the window. -- -- Note that, for windows, the size specified by /i cx, /i cy is -- the /i total size of the window, not the size of the client area. -- -- The following will create a /Window called /b MyWindow: -- --/code -- -- create a window -- constant MyWindow = create( Window, -- the class -- "My Window", -- the caption -- 0, -- the parent -- Default, Default, -- x and y position -- 60, 40, -- height and width -- 0 ) -- no special flags --/endcode -- -- The following will create a /PushButton in /b MyWindow: --/code -- -- create a pushbutton -- constant MyButton = create( PushButton, -- the class -- "Push Me!", -- the caption -- MyWindow, -- the parent -- 10, 10, -- x and y position -- 60, 40, -- height and width -- 0 ) -- no special flags --/endcode -- -- -- The different classes of objects are: -- /li /Bitmap: static bitmap -- /li /CheckBox: check box -- /li /Combo: combo box - has edit box and drop down list -- /li /CText: static text lable, center justified -- /li /DefPushButton: default push button -- /li /DropDownList: drop down list, non-editable -- /li /EditText: edit text -- /li /Group: group box -- /li /HScroll: horizontal scroll bar -- /li /HTrackBar: horizontal track bar -- /li /List: list with scroll bar -- /li /LText: left justified static label -- /li /Icon: static icon -- /li /Menu: menu bar item -- /li /MenuItem: dropdown menu item -- /li /MleText: multiple line text edit -- /li /PictureButton: push button with graphic -- /li /PushButton: push button -- /li /Radio: radio button -- /li /RText: right-justified static text label -- /li /Pixmap: off-screen color bitmap -- /li /SimpleCombo: combo box, no drop down list -- /li /SortedCombo: combo box, with sorted list -- /li /SortedList: list, with sorted elements -- /li /StatusBar: control for status text -- /li /TabControl: control containing tab items -- /li /TabItem: control item in /TabControl -- /li /ToolBar: control for placing other controls into -- /li /ToggleButton: push button that toggles off and on -- /li /TogglePicture: toggle button with picture -- /li /TriCheckBox: 3 state check box -- /li /VScroll: vertical scroll bar -- /li /VTrackBar: vertical track bar -- /li /Window: window -- NEW! 0.41 renamed parameter 'typeOf' to 'class' global function create( integer class, sequence caption, atom owner, atom x, atom y, atom cx, atom cy, object styleFlags ) integer id, at, hotkey atom style, result, hWnd, flags, flagsEx atom szClassName, szCaption, hMenu -- allocate control space -- the window_fcolor should probably be set based on the -- syscolor. window_handle = append( window_handle, -1 ) window_func = append( window_func, -1 ) window_class = append( window_class, -1 ) -- NEW! 0.31 added window_type window_type = append( window_type, class ) -- NEW! 0.45g focus_order contains a sequence, not a number window_focus_order = append( window_focus_order, {} ) window_focus = append( window_focus, 0 ) window_owner = append( window_owner, owner ) window_x = append( window_x, 0 ) window_y = append( window_y, 0 ) window_font = append( window_font, FontDefault ) window_pen = append( window_pen, PenDefault ) window_fcolor = append( window_fcolor, Black ) -- NEW! 0.45j changed default color window_bcolor = append( window_bcolor, c_func( xGetSysColor, {WindowColor}) ) window_scroll = append( window_scroll, {1,10} ) -- NEW! 0.45f added range window_range = append( window_scroll, {0,100} ) -- NEW! 0.45f added tabitems window_tabitems = append( window_tabitems, {} ) -- NEW! 0.45g added group window_group = append( window_group, {} ) -- NEW! 0.44b added cursor window_cursor = append( window_cursor, 0 ) window_menu = append( window_menu, 0 ) -- NEW! 0.40 added toolbar and statusbar window_toolbar = append( window_toolbar, 0 ) window_statusbar = append( window_statusbar, 0 ) -- NEW! 0.41 added tooltip window_tooltip = append( window_tooltip, "" ) -- NEW! 0.46h window_hotkeys = append( window_hotkeys, {} ) -- NEW! 0.45r set default alignment window_textalign = append( window_textalign, TA_TOP ) -- NEW! 0.45f used 'window_handle' instead of deprecated 'window' -- get index id = length( window_handle ) -- allocate event handlers onMouse = append( onMouse, -1 ) onClick = append( onClick, -1 ) onKeyPress = append( onKeyPress, -1 ) onKeyUp = append( onKeyUp, -1 ) onKeyDown = append( onKeyDown, -1 ) onResize = append( onResize, -1 ) onChange = append( onChange, -1 ) onGotFocus = append( onGotFocus, -1 ) onLostFocus = append( onLostFocus, -1 ) onOpen = append( onOpen, -1 ) onClose = append( onClose, -1 ) onDestroy = append( onDestroy, -1 ) onScroll = append( onScroll, -1 ) onTimer = append( onTimer, -1 ) onPaint = append( onPaint, -1 ) -- NEW! 0.45k onDragAndDrop = append( onDragAndDrop, -1 ) onEvent = append( onEvent, -1 ) -- NEW! 0.45g -- is the parent a TabItem? if owner != 0 and window_type[ owner ] = TabItem then -- track the item in the window_group window_group[ owner ] &= id -- set the parent to the parent of the TabItem owner = window_owner[ owner ] window_owner[ id ] = owner end if -- NEW! 0.46h hot key support registerHotKey( id, caption ) -- NEW! 0.43 added Printer_ class -- actual creation if class = Screen_ or class = Printer_ then -- nothing to do. just wanted to allocate storage. elsif class = Window then -- NEW! 0.45f pass parameters instead of using deprecated 'window' -- create a window createWindow( id, class, caption, owner, x, y, cx, cy, styleFlags ) -- NEW! 0.45p create for window (used to be for everything) -- set default font setDefaultFont(id) elsif class = Menu then -- create a menu bar createMenu( MENU, id, caption, owner ) -- NEW! 0.45 elsif class = Popup then -- create a popup menu createMenu( POPUP, id, caption, owner ) elsif class = MenuItem then -- create a menu bar item createMenuItem( id, caption, owner ) elsif class = Pixmap then -- create a pixmap item createPixmap( id, cx, cy ) -- NEW! 0.45p create for pixmap -- set default font setDefaultFont(id) -- NEW! 0.45f elsif class = TabItem then -- create a pixmap item createTabItem( id, caption, owner ) else -- NEW! 0.45f use szClassName instead of buffer1 -- create C string for class name szClassName = allocate_string( className[ class ] ) -- NEW! 0.45f use szCaption instead of buffer2 -- create C string for caption szCaption = allocate_string( caption ) -- include the user flags -- NEW! 0.41 handle picture controls if atom( styleFlags ) and find( class, PictureControls ) = 0 then -- combine with user's values flags = or_bits( classStyle[ class ], styleFlags ) else -- use defaults flags = classStyle[ class ] end if -- common controls interpret hMenu differently if classType[ class ] = COMMON_CONTROL then -- identifier of parent hMenu = owner else -- null hMenu = NULL end if -- NEW! 0.54e added classStyleEx -- NEW! 0.45p pass instance handle as well -- create control hWnd = c_func( xCreateWindow, { classStyleEx[ class ], -- extended style szClassName, -- window class name szCaption, -- window caption flags, -- window style x, y, -- initial x, y position cx, cy, -- initial x, y size getHandle( owner ), -- parent window handle hMenu, -- window menu handle instance(), -- program instance handle NULL} ) -- creation parameters -- NEW! 0.45f release strings free( szClassName ) free( szCaption ) -- save the handle with the control setId( hWnd, id ) -- save the handle in the sequence window_handle[id] = hWnd -- NEW! 0.45l uses SubProcAddress instead of WndProcAddress -- save address of original class routine; -- replace it with a handle to the original window_func[id] = c_func( xSetWindowLong, { hWnd, GWL_WndProc, SubProcAddress } ) -- save class message type window_class[id] = classType[ class ] -- save tab order with owner if the attribute is tab stop if and_bits( WS_TABSTOP, flags ) then -- NEW! 0.45g changed logic -- add to the owner's focus_order list window_focus_order[owner] &= id end if -- NEW! 0.41 handle picture controls -- picture control? if find( class, PictureControls ) then -- need to load image? if sequence( styleFlags ) then -- it's a pathname. use LOADFROMFILE. styleFlags = c_func(xLoadImage, {NULL, allot_string(styleFlags), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE}) -- free the string free_strings() end if if styleFlags then result = sendMessage( id, BM_SETIMAGE, IMAGE_BITMAP, styleFlags ) end if end if -- NEW! 0.45p create for controls (used to be for everything) -- set default font setDefaultFont(id) end if -- track as children, since they need to resize if window_type[id] = ToolBar then -- track toolbar in owner window_toolbar[ owner ] = id elsif window_type[id] = StatusBar then -- track statusbar in owner window_statusbar[ owner ] = id end if return id end function ----------------------------------------------------------------------------- -- SCREEN DISPLAY -- ----------------------------------------------------------------------------- --/topic Fonts --/proc setPosition( window, x, y ) --/desc Position the text pen in /i window. -- Example: -- --/code -- -- move the pen -- /setPosition( MyWindow, 10, 10 ) -- -- -- display message -- /wPuts( MyWindow, "This is at {10,10}" ) --/endcode -- -- /b Note: There's a good chance this routine name will be changed in -- a future release to /i moveTo(). global procedure setPosition( integer id, integer x, integer y ) -- set the window cursor position window_x[id] = x window_y[id] = y end procedure ----------------------------------------------------------------------------- procedure flush_paint_event( atom hWnd ) -- force redraw without clearing window -- this needs to handle multiple windows! if not c_func( xInvalidateRect, {hWnd, NULL, 0} ) then abortErr( "InvalidateRect in flushPaintEvent failed." ) end if end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc repaintWindow( window ) --/desc Force /i window to be entirely repainted. -- This repaints the entire window in it's background color, effectively -- erasing everything in it. It then triggers an /onPaint event -- for that window, requesting that the entire window be repainted. -- -- Example: -- --/code -- -- force MyWindow to be repainted -- /repaintWindow( myWindow ) --/endcode global procedure repaintWindow( integer id ) -- redraws *everything* atom hwnd -- NEW! 0.45o replaced window_handle with getHandle -- get handle hwnd = getHandle( id ) -- invalidate all of the current window, and clear it if not c_func( xInvalidateRect, {hwnd, NULL, 1} ) then abortErr( "InvalidateRect in repaintWindow failed." ) end if -- trigger an immediate paint message ok = sendMessage( id, WM_PAINT, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc repaintRect( window, x1, y1, x2, y2 ) --/desc Force /i window to be partially repainted. -- This sends repaints a the specified portion of the /i window with -- the background color, erasing that portion of it. It then triggers -- an /onPaint event for that window, passing the erased area as -- parameters. -- -- Example: -- --/code -- -- repaint only a portion of MyWindow -- /repaintRect( myWindow, 1, 1, 10, 10 ) --/endcode global procedure repaintRect( integer id, integer x1, integer y1, integer x2, integer y2 ) -- invalidates only a portion of the window atom hWnd atom rect -- allocate rectangle rect = allocate_struct( SIZEOF_RECT ) store( rect, rectLeft, x1 ) store( rect, rectTop, y1 ) store( rect, rectRight, x2 ) store( rect, rectBottom, y2 ) -- NEW! 0.45o replaced window_handle with getHandle -- get handle hWnd = getHandle( id ) -- invalidate all of the current window, and clear it if not c_func( xInvalidateRect, {hWnd, rect, 1} ) then warnErr( "InvalidateRect in repaintRect failed." ) end if -- free the rectangle structure free( rect ) -- trigger an immediate paint message ok = sendMessage( id, WM_PAINT, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/func getSize( object ) --/desc Get the metrics of /i object. --/ret { x1, y1, x2, y2 } -- -- -- Example: -- --/code -- -- where is the window located? -- sequence size -- -- -- get the size of the window -- size = /getSize( MyWindow ) -- -- -- display the position -- /wPrintf( MyWindow, "MyWindow is located at %d,%d}, size[1..2] ) --/endcode global function getSize( atom id ) -- get metrics for current window -- returns { left, top, bottom, right } integer top, bottom, left, right, viewTop, viewLeft atom struct, pt, hdc -- NEW! 0.41 uses screen id -- NEW! 0.43 added printer if id = Screen or id = Printer then -- get dc of screen or printer hdc = getDC( id ) -- screen size top = 0 left = 0 right = c_func( xGetDeviceCaps, {hdc, HORZRES} ) bottom = c_func( xGetDeviceCaps, {hdc, VERTRES} ) -- NEW! 0.43 changed 'Screen' to 'id' -- release dc releaseDC( id ) elsif not validId( id ) then -- probably passed a bitmap -- allocate a buffer to hold bitmap information struct = allocate( SIZEOF_BITMAP ) -- load bitmap data into structure if not c_func( xGetObject, { id, SIZEOF_BITMAP, struct} ) then warnErr( "getSize:GetObject failed." ) end if -- get the values from the bitmap top = 0 left = 0 right = fetch( struct, bmWidth ) bottom = fetch( struct, bmHeight ) -- free structure free( struct ) elsif window_class[ id ] = PIXMAP then -- not allocated? if window_handle[ id ] = 0 then -- NEW! 0.42 returns 4 elements instead of 2 -- empty return {0,0,0,0} end if -- allocate a buffer to hold bitmap information struct = allocate( SIZEOF_BITMAP ) -- load bitmap data into structure if not c_func( xGetObject, { getHandle(id), SIZEOF_BITMAP, struct} ) then warnErr( "getSize:GetObject failed." ) end if -- get the values from the bitmap top = 0 left = 0 right = fetch( struct, bmWidth ) bottom = fetch( struct, bmHeight ) -- free structure free( struct ) else -- allocate a buffer to hold the rectangle information struct = allocate_struct( SIZEOF_RECT ) -- load rectangle information into the buffer if not c_func( xGetWindowRect, { getHandle( id ), struct } ) then abortErr( "getSize:GetWindowRect failed." ) end if -- get points left = fetch( struct, rectLeft ) top = fetch( struct, rectTop ) right = fetch( struct, rectRight ) bottom = fetch( struct, rectBottom ) -- is it owned by a window? if window_owner[ id ] then -- allocate a point structure pt = allocate_struct( SIZEOF_POINT ) -- set to owner window id = window_owner[ id ] -- set to client (0, 0) store( pt, ptX, 0 ) store( pt, ptY, 0 ) -- NEW! 0.45o replaced window_handle with getHandle -- convert to screen space if not c_func( xClientToScreen, { getHandle( id ), pt } ) then abortErr( "getSize:ClientToScreen failed." ) end if -- get position viewLeft = fetch( pt, ptX ) viewTop = fetch( pt, ptY ) -- adjust points left = left - viewLeft right = right - viewLeft top = top - viewTop bottom = bottom - viewTop -- free point free( pt ) end if -- free structure free( struct ) end if -- return values return { left, top, right, bottom } end function -- NEW! 0.45b ----------------------------------------------------------------------------- function getClientSize( integer id ) -- get metrics for current window's client area -- returns { left, top, bottom, right } integer x, y, cx, cy atom rect, pt, hWnd -- NEW! 0.45o replaced window_handle with getHandle -- get handle of window hWnd = getHandle( id ) -- allocate a buffer to hold the rectangle information rect = allocate_struct( SIZEOF_RECT ) -- get size of client area if not c_func( xGetClientRect, {hWnd, rect} ) then warnErr( "getClientSize:GetClientRect failed." ) end if -- fetch the extent cx = fetch( rect, rectRight ) cy = fetch( rect, rectBottom ) -- allocate a point structure pt = allocate_struct( SIZEOF_POINT ) -- set to client (0, 0) store( pt, ptX, 0 ) store( pt, ptY, 0 ) -- NEW! 0.45o replaced window_handle with getHandle -- convert to screen space if not c_func( xClientToScreen, { getHandle( id ), pt } ) then warnErr( "getClientSize:ClientToScreen failed." ) end if -- get position x = fetch( pt, ptX ) y = fetch( pt, ptY ) -- free point and rectangle free( pt ) free( rect ) -- return values return { x, y, cx, cy } end function -- NEW! 0.45 ----------------------------------------------------------------------------- --/topic Attributes --/func getClientPoint( window, x, y ) --/desc Get screen position of point { /i x, /i y } in /i window. --/ret { screen x, screen y } -- -- -- Example: -- --/code -- -- where does {10, 10} in MyWindow appear on the screen? -- sequence point -- -- -- get the screen position -- point = /getClientPoint( MyWindow, 10, 10 ) -- -- -- display the size -- /wPrintf( MyWindow, "The point {10,10} maps to {%d, %d on the screen"}, point ) --/endcode global function getClientPoint( integer id, integer x, integer y ) atom pt sequence point -- allocate a point structure pt = allocate_struct( SIZEOF_POINT ) -- store the x and y store( pt, ptX, x ) store( pt, ptY, y ) -- NEW! 0.45o replaced window_handle with getHandle -- convert to screen space if not c_func( xClientToScreen, { getHandle( id ), pt } ) then abortErr( "getClientPoint:ClientToScreen failed." ) end if -- fetch point point = { fetch( pt, ptX ), fetch( pt, ptY ) } -- free structure free( pt ) return point end function ----------------------------------------------------------------------------- --/topic Attributes --/func getExtent( object ) --/desc Get the extent of /i object. --/ret { width, height } -- -- -- Example: -- --/code -- -- how large is TheButton? -- sequence extent -- -- -- get the size of TheButton -- extent = /getExtent( TheButton ) -- -- -- display the size -- /wPrintf( MyWindow, "TheButton is %d by %d}, extent ) --/endcode global function getExtent( atom id ) -- get { deep, wide } for the requested item sequence s -- get size s = getSize( id ) -- subtract difference return { s[3]-s[1], s[4]-s[2] } end function ----------------------------------------------------------------------------- --/topic Attributes --/func getClientRect( object ) --/desc Get uncovered portion of the client area. --/ret { x1, y1, x2, y2 } -- Unlike the menu, toolbar and statusbar both occupy space in the window. -- To determine what part of the window's client area is not covered, use -- this function. This function can be used even if there is no toobar or -- statusbar in the window. -- -- For example, the /b generic demo has a /MleEdit that needs to be resized -- every time the window is resized. It uses getClientRect to determine the -- metrics of the /MleEdit. -- --/code -- -- color the unoccupied portion of the window red -- sequence rect -- -- -- find out what portion of the window is free -- rect = getClientRect( TheWindow ) -- -- -- draw a filled rectangle -- /setPenColor( TheWindow, Red ) -- /drawRectangle( TheWindow, rect[1], rect[2], rect[3], rect[4] ) --/endcode -- NEW! 0.41 ----------------------------------------------------------------------------- global function getClientRect( integer id ) -- returns rectangle of the client area, accounting for -- the toolbar and status bar. integer x, y, cx, cy, toolbar, statusbar atom ptrRect sequence rect, extent -- allocate a rectangle structure ptrRect = allocate_struct( SIZEOF_RECT ) -- get client rectangle size if not c_func( xGetClientRect, {getHandle(id), ptrRect} ) then warnErr( "getClientRect:GetClientRect failed." ) end if -- fetch the values rect = repeat( 0, 4 ) rect[1] = fetch( ptrRect, rectLeft ) rect[2] = fetch( ptrRect, rectTop ) rect[3] = fetch( ptrRect, rectRight ) rect[4] = fetch( ptrRect, rectBottom ) -- is there a toolbar? toolbar = window_toolbar[ id ] if toolbar then -- get the extent of the toolbar extent = getExtent( toolbar ) -- add it to the y value rect[2] = extent[2] end if -- is there a statusbar? statusbar = window_statusbar[ id ] if statusbar then -- get the extent of the toolbar extent = getExtent( statusbar ) -- subtract it to the y value rect[4] -= extent[2] end if -- free the structure free( ptrRect ) return rect end function ----------------------------------------------------------------------------- -- GENERIC CONTROLS -- ----------------------------------------------------------------------------- function getMenuState( integer id ) -- NEW! 0.45o replaced window_handle with getHandle -- get menu state return c_func( xGetMenuState, { getHandle( id ), id, 0 } ) end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setText( object, text ) --/desc Set the text in /i object. -- If the control is editable, it updated the data in the control. -- Otherwise, it updates the caption text of the control. -- -- Example: -- --/code -- -- change the caption of status bar -- /setText( TheStatusBar, "Ready" ) --/endcode -- -- /b Note: This should probably be divided into two seperate functions, -- /i setCaption and /i setData. global procedure setText( integer id, sequence s ) -- set the text in a window atom ptr, result ptr = allocate_string( s ) -- NEW! 0.40 if window_type[ id ] = StatusBar then -- send the text to the statusbar result = sendMessage( id, SB_SETTEXT, 0, ptr ) else -- NEW! 0.45o replaced window_handle with getHandle -- set the window text if not c_func( xSetWindowText, { getHandle( id ), ptr } ) then warnErr( "SetWindowText in setText failed." ) end if end if free( ptr ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/func getText( object ) --/desc Get the text in /i object. --/ret Text in object's caption or edit. -- If the control is editable, it returns the data in the control. -- Otherwise, it returns the caption text of the control. -- -- Example: -- --/code -- -- get the text from TheTextEdit -- sequence text -- -- text = /getText( TheTextEdit ) --/endcode -- -- /b Note: This should probably be divided into two seperate functions, -- /i getCaption and /i getData. global function getText( integer id ) -- get the text in a window integer at, iLength, result atom buffer, hWnd sequence text -- NEW! 0.45o replaced window_handle with getHandle -- get the handle hWnd = getHandle( id ) -- edit controls -- get the text size; add 1 for /0 -- NEW! 0.40 if window_type[ id ] = StatusBar then -- get length of text in status bar iLength = sendMessage( id, SB_GETTEXTLENGTH, 0, 0 ) + 1 else -- get length of text in window iLength = c_func( xGetWindowTextLength, { hWnd } ) + 1 end if -- no item? if iLength = 0 then return "" end if -- allocate a buffer buffer = allocate_struct( iLength ) -- copy the text into the buffer if window_type[ id ] = StatusBar then -- copy from status bar result = sendMessage( id, SB_GETTEXT, 0, buffer ) -- string length is in low byte of 32 bit value passed back iLength = lo_word( result ) else -- copy from window; function returns string length iLength = c_func( xGetWindowText, { hWnd, buffer, iLength } ) end if -- get the text text = peek( {buffer, iLength} ) -- release the buffer free( buffer ) -- return the string return text end function ----------------------------------------------------------------------------- --/topic Attributes --/func getNumber( object ) --/desc Get the numeric value of text from /i object. --/ret Numeric value of caption or edit. -- -- This is basically a combination of Euphoria's /i value() function and -- /getText(). -- -- Example: -- --/code -- -- get the numeric value from TheTextEdit -- atom number -- -- number = /getNumber( TheTextEdit ) --/endcode -- NEW! v0.31 global function getNumber( integer id ) -- get the numeric value of text sequence text, result -- convert the value of the text result = value( getText( id ) ) if result[1] = GET_SUCCESS then return result[2] else return 0 end if end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setVisible( object, visible flag ) --/desc Make /i object visible or invisible. -- Example: --/code -- -- make TheButton invisible -- /setVisible( TheButton, False ) --/endcode -- -- /b Note: If /i object is a /Window being made visible, it will trigger -- an /onOpen event. However, if it is a /Window being made invisible, it -- will not trigger any event. This should probably be corrected. global procedure setVisible( integer id, integer flag ) if flag then -- NEW! 0.45o replaced window_handle with getHandle -- show a window ok = c_func( xShowWindow, { getHandle( id ), SW_SHOWNORMAL } ) else -- NEW! 0.45o replaced window_handle with getHandle -- hide a window ok = c_func( xShowWindow, { getHandle( id ), SW_HIDE } ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc isVisible( object ) --/desc Returns the visibility state of /i object. -- Example: --/code -- -- is TheButton visible? -- integer flag -- -- flag = /isVisible( TheButton ) --/endcode global function isVisible( integer id ) -- NEW! 0.46h if window_type[ id ] = TabItem then -- always enabled return True else -- NEW! 0.45o replaced window_handle with getHandle -- return hidden state of control return c_func( xIsWindowVisible, { getHandle( id ) } ) end if end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setEnable( object, visible flag ) --/desc Enable or disable /i object. -- Example: --/code -- -- disable TheButton -- /setEnable( TheButton, False ) --/endcode global procedure setEnable( integer id, integer flag ) -- enable/disable an item if window_class[ id ] = MENU or window_class[ id ] = MENUITEM then -- convert the flag flag = iif( flag, MF_ENABLED, or_all( {MF_DISABLED, MF_GRAYED} ) ) -- NEW! 0.45o replaced window_handle with getHandle -- enable/disable the menu if c_func( xEnableMenuItem, { getHandle( id ), -- menu handle id, -- id flag} )= #FFFFFFFF -- enable/disble then -- item does not exist warnErr( "EnableMenuItem in enableMenuItem failed." ) end if -- if menubar, need to redraw if window_class[ id ] = MENU then ok = c_func( xDrawMenuBar, { window_owner[ id ] } ) end if else -- NEW! 0.45o replaced window_handle with getHandle -- enable/disable the window c_proc( xEnableWindow, { getHandle( id ), flag } ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc isEnabled( object ) --/desc Returns the enabled state of /i object. -- Example: --/code -- -- is TheButton enabled? -- integer flag -- -- flag = /isEnabled( TheButton ) --/endcode global function isEnabled( integer id ) -- return enabled state of control atom result if window_class[ id ] = MENU or window_class[ id ] = MENUITEM then -- true if not disabled return not and_bits( getMenuState(id), MF_DISABLED ) -- NEW! 0.46h elsif window_type[ id ] = TabItem then -- always enabled return True else -- NEW! 0.45o replaced window_handle with getHandle -- control return c_func( xIsWindowEnabled, { getHandle( id ) } ) end if end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setCheck( object, checked flag ) --/desc Check or uncheck /i object. -- This works for /Menus and /MenuItems as well as toggle controls -- such as /Radio, /CheckBox and /ToggleButton. -- -- Example: --/code -- -- set a check on the SyntaxColoring option -- /setCheck( SyntaxColoring, True ) --/endcode global procedure setCheck( integer id, integer flag ) if window_class[ id ] = MENU or window_class[ id ] = MENUITEM then -- convert the flag flag = iif( flag, MF_CHECKED, MF_UNCHECKED ) -- NEW! 0.45o replaced window_handle with getHandle -- set the check in the menu if c_func( xCheckMenuItem, { getHandle( id ), -- owner's menu handle id, -- use the id flag} )= #FFFFFFFF -- check/uncheck then -- item does not exist warnErr( "CheckMenuItem in checkMenuItem failed." ) end if -- if menubar, need to redraw if window_class[ id ] = MENU then ok = c_func( xDrawMenuBar, { window_owner[ id ] } ) end if else -- toggle the control ok = sendMessage( id, BM_SETCHECK, flag, 0 ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc isChecked( object ) --/desc Returns the checked state of /i object. -- Example: --/code -- -- is TheRadio1 checked? -- integer flag -- -- flag = /isChecked( TheRadio1 ) --/endcode global function isChecked( integer id ) -- return checked state of control if window_class[ id ] = MENU or window_class[ id ] = MENUITEM then -- true if not disabled return and_bits( getMenuState(id), MF_CHECKED ) else -- controls return sendMessage( id, BM_GETCHECK, 0, 0 ) end if end function ----------------------------------------------------------------------------- --/topic Edit Control --/proc cut( object ) --/desc Cut any selected text from /i object and place in the clipboard. -- Example: --/code -- -- cut text from TheTextEdit -- /cut( TheTextEdit ) --/endcode global procedure cut( integer id ) -- send a cut request to a window ok = sendMessage( id, WM_CUT, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Edit Control --/proc copy( object ) --/desc Copy any selected text from /i object and place in the clipboard. -- Example: --/code -- -- copy text from TheTextEdit into the clipboard -- /copy( TheTextEdit ) --/endcode global procedure copy( integer id ) -- send a copy request to a window ok = sendMessage( id, WM_COPY, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Edit Control --/proc paste( object ) --/desc Paste text from the clipboard to /i object. -- Example: --/code -- -- paste text from clipboard to TheTextEdit -- /paste( TheTextEdit ) --/endcode global procedure paste( integer id ) -- send a paste request to a window ok = sendMessage( id, WM_PASTE, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Edit Control --/proc clear( object ) --/desc Clear selected text from /i object. -- Example: --/code -- -- clear selected text in TheTextEdit -- /clear( TheTextEdit ) --/endcode global procedure clear( integer id ) -- NEW! 0.43 changed WM_CUT to WM_CLEAR -- send a clear request to a window ok = sendMessage( id, WM_CLEAR, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Edit Control --/proc undo( object ) --/desc Undo last edit in /i object. -- Example: --/code -- -- undo last edit in TheTextEdit -- /undo( TheTextEdit ) --/endcode global procedure undo( integer id ) -- send a undo request to a window ok = sendMessage( id, WM_UNDO, 0, 0 ) end procedure ----------------------------------------------------------------------------- -- LISTS -- ----------------------------------------------------------------------------- --/topic List Control --/proc addItem( control, text ) --/desc Add /i text to /i control's list. -- Example: --/code -- -- add "Apples" to TheList -- /addItem( TheList, "Apples" ) --/endcode global procedure addItem( integer id, sequence text ) -- add an item to a list integer msg -- what control is it? if window_class[ id ] = LISTBOX then msg = LB_ADDSTRING elsif window_class[ id ] = COMBO then msg = CB_ADDSTRING else return end if -- send a message ok = sendMessage( id, msg, 0, allot_string( text ) ) -- free the string free_strings() end procedure ----------------------------------------------------------------------------- --/topic List Control --/proc insertItem( list, text, position ) --/desc Insert /i text into /i list's list at position /i. -- The /i position starts at 1. -- -- Example: --/code -- -- insert "Bannanas" at position 2 in TheList -- /insertItem( TheList, "Bannanas", 2 ) --/endcode global function insertItem( atom id, sequence text, integer pos ) -- inserts string to list integer msg -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_INSERTSTRING elsif window_class[ id ] = COMBO then msg = CB_INSERTSTRING end if -- NEW! 0.45o fixed indexing -- send a message; subtract because it's zero based ok = sendMessage( id, msg, pos-1, allot_string( text ) ) -- free the string free_strings() -- return position return ok+1 end function ----------------------------------------------------------------------------- --/topic List Control --/proc deleteItem( list, position ) --/desc Delete item from /i list's list at position /i. -- The /i position starts at 1. -- -- Example: --/code -- -- delete item 2 from the list -- /deleteItem( TheList, 2 ) --/endcode global function deleteItem( atom id, integer pos ) -- deletes an item at position integer msg -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_DELETESTRING elsif window_class[ id ] = COMBO then msg = CB_DELETESTRING end if return sendMessage( id, msg, pos-1, 0 ) end function ----------------------------------------------------------------------------- --/topic List Control --/func getCount( list ) --/desc Get the count of items in /i list. --/ret Count of items, or zero if control's list is empty. -- -- -- Example: --/code -- -- count size of TheList -- integer count -- -- count = /getCount( TheList ) --/endcode global function getCount( atom id ) -- get count of items in list integer msg -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_GETCOUNT elsif window_class[ id ] = COMBO then msg = CB_GETCOUNT end if return sendMessage( id, msg, 0, 0 ) end function ----------------------------------------------------------------------------- --/topic List Control --/func getIndex( list ) --/desc Get the index of the selected item on the list. --/ret Index of selected item, or zero if no item is selected. -- Example: --/code -- -- get index of selected item in TheList -- integer index -- -- index = /getIndex( TheList ) --/endcode global function getIndex( atom id ) -- get index of selected list item integer msg -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_GETCURSEL elsif window_class[ id ] = COMBO then msg = CB_GETCURSEL end if return sendMessage( id, msg, 0, 0 )+1 end function ----------------------------------------------------------------------------- --/topic List Control --/proc setIndex( list, index ) --/desc Set the selected item on the list to /i index. -- Use 0 to set the index to 'unselected.' -- -- Example: --/code -- -- select the first item on the list -- integer result -- -- result = /setIndex( TheList, 1 ) --/endcode global procedure setIndex( atom id, integer index ) -- set index of list integer msg atom result -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_SETCURSEL elsif window_class[ id ] = COMBO then msg = CB_SETCURSEL end if -- NEW! 0.45m don't report an error if index is *supposed* to be -1 if sendMessage( id, msg, index-1, 0 ) = -1 and index != 0 then warnErr( sprintf("sendMessage(#%x) in setIndex failed.", {msg} ) ) end if end procedure ----------------------------------------------------------------------------- --/topic List Control --/func getItem( list, index ) --/desc Return the text of item at /i index in /i list. --/ret Text of item, or "" if fails. -- Example: --/code -- -- get the text of the third item in TheList -- sequence text -- -- -- get the text -- text = /getItem( TheList, 3 ) --/endcode global function getItem( atom id, integer item ) -- get text of requested item integer msg, iLength atom buffer sequence text -- correct class? if window_class[ id ] != LISTBOX and window_class[ id ] != COMBO then warnErr( "getItem requested and class not LISTBOX or COMBO" ) return "" end if -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_GETTEXTLEN elsif window_class[ id ] = COMBO then msg = CB_GETLBTEXTLEN end if -- get the text size; add 1 for /0 iLength = sendMessage( id, msg, item-1, 0 ) + 1 -- no item? if iLength = 0 then return "" end if -- allocate a buffer buffer = allocate_struct( iLength ) -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_GETTEXT elsif window_class[ id ] = COMBO then msg = CB_GETLBTEXT end if -- NEW! 0.44d trims off trailing 0 -- move the text to a buffer -- value returned is length without 0 terminator iLength = sendMessage( id, msg, item-1, buffer ) -- get the text text = peek( {buffer, iLength} ) -- release the buffer free( buffer ) return text end function ----------------------------------------------------------------------------- --/topic List Control --/proc eraseItems( list ) --/desc Remove all items from /i list. -- Example: --/code -- -- erase items from TheList -- /eraseItems( TheList ) --/endcode global procedure eraseItems( atom id ) -- clear a list integer msg -- get the message, based on control type if window_class[ id ] = LISTBOX then msg = LB_RESETCONTENT elsif window_class[ id ] = COMBO then msg = CB_RESETCONTENT end if ok = sendMessage( id, msg, 0, 0 ) end procedure ----------------------------------------------------------------------------- -- SCROLL BARS -- ----------------------------------------------------------------------------- --/topic Scroll Control --/proc setScrollChange( scroll, line size, page size ) --/desc Adjust the amount that a scroll control will change. -- The /i line /i size is the amount that the scroll will adjust -- when the up/down arrow is selected, and the /i page /i size is -- used when the page up/page down is selected. -- -- For trackbars, the /i page /i size is used to determine the distance -- between the tick marks. -- -- The default values are {1,10}. -- -- Example: --/code -- -- set change amount for TheScroll -- /setScrollChange( TheScroll, 1, 10 ) --/endcode global procedure setScrollChange( integer id, atom low, atom high ) -- set the "line" and "page" change amount atom result -- save value window_scroll[id] = { low, high } -- NEW! 0.45f trackbar support if window_type[id] = HTrackBar or window_type[id] = VTrackBar then -- new page size result = sendMessage( id, TBM_SETPAGESIZE, low, high ) -- set tick frequency result = sendMessage( id, TBM_SETTICFREQ, high, 0 ) end if end procedure ----------------------------------------------------------------------------- --/topic Scroll Control --/func getScrollChange( scroll ) --/desc Returns the amount that /i scroll will change. --/ret { line change, page change } -- This value is set by /setScrollChange. The default value is {1,10}, -- indicating the small change and large change amounts. -- -- Example: --/code -- -- get change amount for TheScroll -- sequence change -- change = /getScrollChange( TheScroll ) --/endcode global function getScrollChange( integer id ) -- return the "line change" amount for scroll bar return window_scroll[ id ][ MY_SMALLCHANGE..MY_LARGECHANGE ] end function ----------------------------------------------------------------------------- --/topic Scroll Control --/proc setScrollRange( scroll, low, high ) --/desc Sets the range of values of /i scroll. -- The low value must be greater than zero. -- -- The default values are {0,100}. -- -- Example: --/code -- -- set range for TheScroll -- /setScrollRange( TheScroll, 1, 100 ) --/endcode global procedure setScrollRange( integer id, integer min, integer max ) -- set the allowable range for a scroll bar atom sif, result -- store value window_range[ id ] = { min, max } -- NEW! 0.45f changed test from class to type -- what type of control? if window_type[ id ] = HScroll or window_type[ id ] = VScroll then -- scroll bar -- allocate structure sif = allocate_struct( SIZEOF_SCROLLINFO ) -- store values store( sif, sifSize, SIZEOF_SCROLLINFO ) store( sif, sifMask, SIF_RANGE ) store( sif, sifMin, min ) store( sif, sifMax, max ) -- NEW! 0.45o replaced window_handle with getHandle -- function call ok = c_func( xSetScrollInfo, { getHandle( id ), -- handle SB_CTL, -- scroll bar control sif, -- pointer to structure 0 } ) -- redraw flag -- free structure free( sif ) -- NEW! 0.45f elsif window_type[id] = HTrackBar or window_type[id] = VTrackBar then -- set the range and selection range result = sendMessage( id, TBM_SETRANGE, True, pack_word( min, max ) ) result = sendMessage( id, TBM_SETSEL, False, pack_word( min, max ) ) end if end procedure ----------------------------------------------------------------------------- --/topic Scroll Control --/func getScrollRange( scroll ) --/desc Returns /i scroll's range of values. --/ret { low, high } -- -- -- This value is set by /setScrollRange. The default value is {0,100}. -- -- Example: --/code -- -- get range of TheScroll -- sequence range -- range = /getScrollRange( TheScroll ) --/endcode global function getScrollRange( integer id ) -- set the allowable range for a scroll bar -- NEW! 0.45f use structure return window_range[ id ] end function ----------------------------------------------------------------------------- --/topic Scroll Control --/proc setScrollPos( scroll, position ) --/desc Sets the value of /i scroll. -- The value must be greater than zero. This will trigger an -- /onScroll event. -- -- Example: --/code -- -- set value of the TheScroll -- /setScrollPos( TheScroll, 20 ) --/endcode global procedure setScrollPos( integer id, atom pos ) -- return the value of the scroll bar atom result -- NEW! 0.45f check range if pos < window_range[id][1] then -- clip to minimum pos = window_range[id][1] elsif pos > window_range[id][2] then -- clip to maximum pos = window_range[id][2] end if -- NEW! 0.45f changed window_class to window_type -- scrollbar? if window_type[ id ] = HScroll or window_type[ id ] = VScroll then -- NEW! 0.45o replaced window_handle with getHandle -- call the function result = c_func( xSetScrollPos, { getHandle( id ), -- handle SB_CTL, -- scroll bar specific pos, -- new scroll bar position True } ) -- redraw flag -- NEW! 0.45f support TrackBar elsif window_type[ id ] = HTrackBar or window_type[ id ] = VTrackBar then -- send message result = sendMessage( id, TBM_SETPOS, True, pos ) end if -- run the event code, if any if onScroll[ id ] != -1 then call_proc( onScroll[id], {pos} ) end if end procedure ----------------------------------------------------------------------------- --/topic Scroll Control --/func getScrollPos( scroll, position ) --/desc Gets the value of a scroll control. --/ret Position of the thumb on the scroll control. -- -- Example: --/code -- -- get value of TheScroll -- integer pos -- pos = /getScrollPos( TheScroll ) --/endcode global function getScrollPos( integer id ) -- return the value of the scroll bar if window_type[ id ] = HScroll or window_type[ id ] = VScroll then -- scroll bar -- NEW! 0.45o replaced window_handle with getHandle -- call the function return c_func( xGetScrollPos, { getHandle( id ), -- handle SB_CTL } ) -- scroll bar specific elsif window_type[ id ] = HTrackBar or window_type[ id ] = VTrackBar then return sendMessage( id, TBM_GETPOS, 0, 0 ) end if -- trace(1) -- ? 1/0 end function ----------------------------------------------------------------------------- -- GRAPHICS -- ----------------------------------------------------------------------------- --/topic Fonts --/proc setTextColor( window, color ) --/desc Set the text color to use when drawing text in /i window. -- To set the color of the graphics pen, use /setPenColor. -- -- Example: --/code -- -- draw text in red in TheWindow -- /setTextColor( TheWindow, Red ) -- /wPuts( TheWindow, "This text is in red" ) --/endcode global procedure setTextColor( integer id, atom color ) -- set the text color for the window window_font[id][FontColor] = color end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc setBackColor( window, color ) --/desc Set the color for used for the pen fill color in /i window. -- /b Note: At best, this function is a misnamed, and it's probably no -- event longer in use. When the pen mode is set to /b OPAQUE, this -- specifies the color used to fill the 'gaps'. -- -- However, Win32Lib doesn't directly support these pen modes, so it's -- not clear that this function even needs to exist. Further, it's -- often confused with /setWindowBackColor. -- -- Example: --/code -- -- set pen opaque color -- /setTextColor( TheWindow, Red ) -- /wPuts( TheWindow, "This text is in red" ) --/endcode global procedure setBackColor( integer id, atom color ) -- NEW! 0.45o replaced window_handle with getHandle -- set the background color for the window if c_func(xSetBkColor, {getHandle( id ), color} ) = CLR_INVALID then warnErr( "SetBkColor in setBackColor failed." ) end if end procedure ----------------------------------------------------------------------------- procedure createPen( integer id, atom hdc ) -- make sure the pen is set atom result, rop2, hPen -- need to create a pen? if window_pen[id][PenValid] = 0 or id = Screen then -- NEW! 0.41 Screen invalidates each time -- NEW! 0.45j added PenWidth -- create a pen hPen = c_func(xCreatePen, { window_pen[id][PenStyle], -- pen style window_pen[id][PenWidth], -- pen thickness window_pen[id][PenColor] }) -- color -- select into the current device replaceObject( id, hdc, hPen, ForPaint ) -- flag that the pen was created window_pen[id][PenValid] = 1 -- set the ROP2 style rop2 = window_pen[id][PenROP2] if rop2 then if not c_func( xSetROP2, { hdc, rop2 } ) then warnErr( "SetROP2 in createPen failed." ) end if end if end if end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc setPenColor( window, color ) --/desc Set the the pen color used in /i window. -- This is the color that is used by other graphics routines. -- -- To set the color of text, use /setTextColor. -- -- Example: --/code -- -- set pen color to red -- /setPenColor( TheWindow, /Red ) -- -- draw a red line -- /drawLine( TheWindow, 10, 10, 40, 40 ) --/endcode global procedure setPenColor( integer id, atom color ) -- set a new pen color for the window -- save the color window_pen[id][PenColor] = color window_pen[id][PenValid] = 0 end procedure -- NEW! 0.45j ----------------------------------------------------------------------------- --/topic Graphics --/proc setPenWidth( window, pixel width ) --/desc Set the the pen width used in /i window. -- The default thickness of the pen is 1 pixel. -- -- Example: --/code -- -- set pen thickness of 3 -- /setPenWidth( TheWindow, 3 ) -- -- draw a thick line -- /drawLine( TheWindow, 10, 10, 40, 40 ) --/endcode global procedure setPenWidth( integer id, integer pixels ) -- set a new pen thickness for the window -- save the thickness window_pen[id][PenWidth] = pixels -- invalidate the old pen window_pen[id][PenValid] = 0 end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc setPenStyle( window, color ) --/desc Set the style that lines are drawn in. -- This allows the creation of various dotted line styles. -- Use /setBackColor to define the background fill used on the line. -- -- The following styles are defined: -- -- /li /b Solid -- /li /b Dash -- /li /b Dot -- /li /b DashDot -- /li /b DashDotDot -- -- /b Note: This routine will probably be dropped in later releases. -- -- Example: --/code -- -- set pen style -- /setPenStyle( TheWindow, Dot ) -- -- -- draw a line using that pen style -- /drawLine( TheWindow, 10, 10, 100, 100 ) --/endcode global procedure setPenStyle( integer id, atom style ) -- set a new pen style for the window -- save the style window_pen[id][PenStyle] = style window_pen[id][PenValid] = 0 end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc setPenROP2( window, code ) --/desc Determines what mode graphics are drawn in. -- The default value is /b R2_COPYPEN. The ROP2 codes are: -- -- /li /b R2_BLACK: Pixel is always 0. -- /li /b R2_NOTMERGEPEN: Pixel is the inverse of the R2_MERGEPEN color. -- /li /b R2_MASKNOTPEN: combination common screen and inverse of pen. -- /li /b R2_NOTCOPYPEN: Pixel is the inverse of the pen color. -- /li /b R2_MASKPENNOT: combination common to pen and inverse of screen. -- /li /b R2_NOT: Pixel is the inverse of the screen color. -- /li /b R2_XORPEN: Pixel is the inverse of the R2_XORPEN color. -- /li /b R2_NOTMASKPEN: Pixel is the inverse of the R2_MASKPEN color. -- /li /b R2_MASKPEN: combination common to pen and the screen. -- /li /b R2_NOTXORPEN: combination of colors in pen and screen, but not in both. -- /li /b R2_NOP: Pixel remains unchanged. -- /li /b R2_MERGENOTPEN: combination of screen and inverse of pen. -- /li /b R2_COPYPEN: Pixel is the pen color. -- /li /b R2_MERGEPENNOT: combination of pen color and inverse of screen color. -- /li /b R2_MERGEPEN: combination of pen color and the screen color. -- /li /b R2_WHITE: Pixel is always 1. -- -- Example: --/code -- -- draw an XOR line in TheWindow -- /setPenROP2( TheWindow, R2_XORPEN ) -- /drawLine( TheWindow, 10, 10, 100, 100 ) --/endcode global procedure setPenROP2( integer id, atom rop2 ) -- sets the ROP2 mode for the window -- perhaps better called setPenMixMode() window_pen[id][PenROP2] = rop2 end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc setPenBkMode( window, mode ) --/desc Determines if the background color for lines and text. -- Modes are: -- -- /li /b OPAQUE: Draws using background color. -- /li /b TRANSPARENT: Draws without background color. -- -- If /i mode is /b OPAQUE, the color set in /setBackColor is used. -- The default mode is /b TRANSPARENT. -- -- -- Example: --/code -- -- draw an XOR line in TheWindow -- /setPenROP2( TheWindow, R2_XORPEN ) -- /drawLine( TheWindow, 10, 10, 100, 100 ) --/endcode global procedure setPenBkMode( integer id, atom bkMode ) -- sets the pen background mode -- default is transparent window_pen[id][PenBkMode] = bkMode end procedure ----------------------------------------------------------------------------- --/topic Graphics --/func getPixel( window, x, y ) --/desc Get a pixel value from /i window's client area. --/ret rgb value of point. -- Example: -- --/code -- -- get a pixel color from {10,10} in TheWindow -- atom rgb -- rgb = /getPixel( TheWindow, 10, 10 ) --/endcode -- NEW! 0.43b restored as global global function getPixel( integer id, integer x, integer y ) integer rgb atom hdc -- get the device context hdc = getDC( id ) -- get pixel rgb = c_func( xGetPixel, {hdc, x, y} ) -- release the device context releaseDC( id ) return rgb end function ----------------------------------------------------------------------------- --/topic Graphics --/proc setPixel( window, x, y, rgb color ) --/desc Set a pixel value in /i window's client area. -- -- Example: -- --/code -- -- set pixel at {10,10} to Red -- /setPixel( TheWindow, 10, 10, Red ) --/endcode global procedure setPixel( integer id, integer x, integer y, atom rgbColor ) -- returns RGB value from point atom hdc -- get the device context hdc = getDC( id ) -- get pixel ok = c_func( xSetPixel, {hdc, x, y, rgbColor } ) -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawLine( window, x1, y1, x2, y2 ) --/desc Draw a line. -- The line is drawn in the current pen color between { /i x1, /i y1 } -- and { /i x2, /i y2 }. -- -- Example: -- --/code -- -- draw a line in TheWindow from {10,10} to {100,100} -- /drawLine( TheWindow, 10, 10, 100, 100 ) --/endcode global procedure drawLine( integer id, integer x1, integer y1, integer x2, integer y2 ) object hdc, result -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- move to the first point if not c_func(xMoveToEx, {hdc, x1, y1, NULL}) then warnErr( "MoveToEx in PLine of drawLine failed." ) end if -- draw the line if not c_func(xLineTo, {hdc, x2, y2}) then warnErr( "LineTo in PLine of drawLine failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- procedure createBrush( integer id, integer filled, atom hdc ) -- create the appropriate brush for the filled shape -- 'filled' is the brush flag atom rgbColor, hBrush if filled then -- create a solid brush rgbColor = window_pen[id][PenColor] hBrush = c_func( xCreateSolidBrush, { rgbColor } ) else -- use null brush -- NEW! 0.30 changed from NULL_PEN to NULL_BRUSH -- NEW! 0.45l used NullBrushID instead of calling GetStockObject hBrush = NullBrushID end if -- NEW! 0.30 move out of if portion, so NULL_BRUSH replaces prior brush -- replace the brush in the dc replaceObject( id, hdc, hBrush, ForPaint ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawRectangle( window, filled, x1, y1, x2, y2 ) --/desc Draw a rectangle. -- Draws the rectangle in the current pen color from { /i x1, /i y1 } -- to { /i x2, /i y2 }. If /i filled is true, the rectangle is filled -- in the current pen color. -- -- Example: -- --/code -- -- draw a filled green rectangle in TheWindow -- /setPenColor( TheWindow, Green ) -- /drawRectangle( TheWindow, True, 10, 10, 100, 100 ) --/endcode global procedure drawRectangle( integer id, integer filled, integer x1, integer y1, integer x2, integer y2 ) -- draw a rectangle atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call Rectangle if not c_func( xRectangle, {hdc, x1, y1, x2, y2 } ) then warnErr( "drawRectangle:Rectangle failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawRoundRectangle( window, filled, x1, y1, x2, y2, xc, yc ) --/desc Draw a rounded rectangle. -- Draws the rounde rectangle in the current pen color from { /i x1, /i y1 } -- to { /i x2, /i y2 }. The ellipse corner width and height are specified -- in /i xc and /i yc. If /i filled is true, the rectangle is filled -- in the current pen color. -- -- Example: -- --/code -- -- draw a filled blue round rectangle in TheWindow -- /setPenColor( TheWindow, Green ) -- /drawRoundRectangle( TheWindow, True, 10, 10, 100, 100, 5, 5 ) --/endcode global procedure drawRoundRect( integer id, integer filled, integer x1, integer y1, integer x2, integer y2, integer xc, integer yc ) -- draw a rounded rectangle -- xc = ellipse corner width -- yc = ellipse corner height atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call RoundRect if not c_func( xRoundRect, {hdc, x1, y1, x2, y2, xc, yc } ) then warnErr( "RoundRect in drawRoundRect failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawEllipse( window, filled, x1, y1, x2, y2 ) --/desc Draw an ellipse. -- Draws the ellipse in the current pen color within the rectangle -- bounded by { /i x1, /i y1 } and { /i x2, /i y2 }. If /i filled -- is true, the ellipse is filled in the current pen color. -- -- Example: -- --/code -- -- draw a black ellipse in TheWindow -- /setPenColor( TheWindow, Black ) -- /drawEllipse( TheWindow, True, 10, 10, 100, 100 ) --/endcode global procedure drawEllipse( integer id, integer filled, integer x1, integer y1, integer x2, integer y2 ) -- draw an ellipse atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call Ellipse if not c_func( xEllipse, {hdc, x1, y1, x2, y2 } ) then warnErr( "Ellipse in drawEllipse failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawArc( window, filled, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd ) --/desc Draw an arc. -- Draws the arc in the current pen color. The arc's bounding rectangle -- is defined as { /i x1, /i y1 } to { /i x2, /i y2 }. If /i filled -- is true, the ellipse is filled in the current pen color. -- -- The arc is defined by the intersection between the radial start point -- and radial end point. The radial start point is a line running from -- the center of the bounding rectangle to { /i xStart, /i yStart }, and -- radial end point by a line running from the center of the bounding -- rectangle to { /i xEnd, /i yEnd }. -- -- If /i filled is true, the arc will be filled. -- -- Example: -- --/code -- -- draw a bright cyan filled arc in TheWindow -- /setPenColor( TheWindow, BrightCyan ) -- /drawArc( TheWindow, -- True, -- filled -- 1, 1, -- upper left boundary -- 100, 100, -- lower right boundary -- 49, 1, -- top center of rectangle -- 100, 49 ) -- right center of rectangle --/endcode global procedure drawArc( integer id, integer filled, integer x1, integer y1, integer x2, integer y2, integer xStart, integer yStart, integer xEnd, integer yEnd ) -- draw an arc -- xStart, yStart: start of arc; on imaginary line from center of arc -- xEnd, yEnd : end of arc; on imaginary line from center of arc atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call Arc if not c_func( xArc, {hdc, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd } ) then warnErr( "Arc in drawArc failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawChord( window, filled, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd ) --/desc Draw a chord. -- Draws the chord in the current pen color. -- -- A /i chord is a region bounded by the intersection of an ellipse and a -- line segment. The ellipse is bounding rectangle is defined -- { /i x1, /i y1 } to { /i x2, /i y2 }. If /i filled is true, the -- chord is filled in the current pen color. -- -- The chord is defined by the intersection between the radial start point -- and radial end point. The radial start point is a line running from -- the center of the bounding rectangle to { /i xStart, /i yStart }, and -- radial end point by a line running from the center of the bounding -- rectangle to { /i xEnd, /i yEnd }. -- -- If /i filled is true, the chord will be filled. -- -- Example: -- --/code -- -- draw a yellow chord in TheWindow -- /setPenColor( TheWindow, Yellow ) -- /drawChord( TheWindow, -- True, -- filled -- 1, 1, -- upper left boundary -- 100, 100, -- lower right boundary -- 49, 1, -- top center of rectangle -- 100, 49 ) -- right center of rectangle --/endcode global procedure drawChord( integer id, integer filled, integer x1, integer y1, integer x2, integer y2, integer xStart, integer yStart, integer xEnd, integer yEnd ) -- draw an chord -- xStart, yStart: start of arc; on imaginary line from center of arc -- xEnd, yEnd : end of arc; on imaginary line from center of arc atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call Chord if not c_func( xChord, {hdc, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd } ) then warnErr( "Chord in drawChord failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawPie( window, filled, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd ) --/desc Draw a pie slice. -- Draws the pie slice in the current pen color. The bounding rectangle -- is defined as { /i x1, /i y1 } to { /i x2, /i y2 }. If /i filled -- is true, the slice is filled in the current pen color. -- -- The curve start and end points are defined by the intersection between -- the radial start point and radial end point. The radial start point is -- a line running from the center of the bounding rectangle to { -- /i xStart, /i yStart }, and radial end point by a line running from -- the center of the bounding rectangle to { /i xEnd, /i yEnd }. -- -- If /i filled is true, the pie will be filled. -- -- Example: -- --/code -- -- draw a blue filled arc in TheWindow -- /setPenColor( TheWindow, Blue ) -- /drawPie( TheWindow, -- True, -- filled -- 1, 1, -- upper left boundary -- 100, 100, -- lower right boundary -- 49, 1, -- top center of rectangle -- 100, 49 ) -- right center of rectangle --/endcode global procedure drawPie( integer id, integer filled, integer x1, integer y1, integer x2, integer y2, integer xStart, integer yStart, integer xEnd, integer yEnd ) -- draw a pie slice -- xStart, yStart: start of arc; on line from center of arc -- xEnd, yEnd : end of arc; on line from center of arc atom hdc -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call DrawPie if not c_func( xPie, {hdc, x1, y1, x2, y2, xStart, yStart, xEnd, yEnd } ) then warnErr( "Pie in drawPie failed." ) end if -- release the device context releaseDC( id ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc drawPolygon( window, filled, points ) --/desc Draw a polygon. -- Draws the polygon in /i window in the current pen color using /i points. -- If i/ filled is true, the polygon will be filled. -- -- Example: -- --/code -- -- draw a blue filled triangle in TheWindow -- sequence points -- -- -- define the points -- points = { { 10, 10 }, -- { 80, 40 }, -- { 40, 80 } } -- -- -- set pen color -- /setPenColor( TheWindow, Blue ) -- -- -- draw a filled polygon using the points -- /drawPolygon( TheWindow, True, points ) --/endcode global procedure drawPolygon( integer id, integer filled, sequence points ) -- draw a polygon integer count, offset atom hdc, address -- count of points count = length( points ) -- allocate room for points address = allocate_struct( count * 4 * 2 ) -- poke the points offset = 0 for i = 1 to count do -- x point poke( address+offset, int_to_bytes( points[i][1] ) ) -- y point poke( address+offset+4, int_to_bytes( points[i][2] ) ) -- increment offset offset += 8 end for -- get the device context hdc = getDC( id ) -- create a pen createPen( id, hdc ) -- create the brush createBrush( id, filled, hdc ) -- call Polygon if not c_func( xPolygon, {hdc, address, count } ) then warnErr( "Polygon in drawPolygon failed." ) end if -- release the device context releaseDC( id ) -- release the memory free( address ) end procedure ------------------------------------------------------------------------------ function loadBitmapFromFile2( sequence fileName ) -- alternate version of loadBitmapFromFile -- this should work for NT and other versions not -- supporting LoadImage's load from file option. -- -- this version is called if the default version fails atom bmFile, bmInfoHeader, bmBits, bmColors, hdc, hDib integer hFile, fSize, byte sequence info hFile = open( fileName, "rb" ) if hFile = -1 then -- warning warnErr( sprintf( "Unable to open '%s', in ReadDIB", {fileName} ) ) return NULL end if -- get the size of the file info = dir( fileName ) if length( info ) != 1 then warnErr( sprintf( "Error reading '%s', in ReadDIB", {fileName} ) ) return 0 else fSize = info[1][D_SIZE] end if -- read the whole file bmFile = allocate( fSize ) for i = 0 to fSize-1 do -- get a byte from the file byte = getc( hFile ) -- eof? if byte = -1 then -- free memory free( bmFile ) -- warning warnErr( sprintf( "Early EOF in '%s', in ReadDIB", {fileName} ) ) -- return failure return NULL else -- poke into structure poke( bmFile+i, byte ) end if end for -- check header if compare( fetch( bmFile, bfType ), "BM" ) != 0 then close( hFile ) free( bmFile ) -- warning warnErr( sprintf( "'%s' not a bitmap file, in ReadDIB", {fileName} ) ) return NULL end if -- check header size against file size if fetch( bmFile, bfSize ) != fSize then -- warning warnErr( sprintf( "Bitmap '%s' is corrupt, in ReadDIB", {fileName} ) ) -- correct header in memory store( bmFile, bfSize, fSize ) end if -- address of BitmapInfoHeader bmInfoHeader = bmFile + SIZEOF_BITMAPFILEHEADER -- offset to bitmap data bmBits = bmFile + fetch( bmFile, bfOffBits ) -- address of color information bmColors = bmInfoHeader + SIZEOF_BITMAPINFOHEADER -- Get the screen's device context. hdc = getDC( Screen ) -- Create the DIB. hDib = c_func( xCreateDIBitmap, { hdc, -- handle to device context address( bmInfoHeader, bmiHeader ), -- pointer to BITMAPINFOHEADER CBM_INIT, -- initialization flag bmBits, -- address of initialization data bmInfoHeader, -- pointer to color data DIB_RGB_COLORS} ) -- colors are RGB tuples -- release the screen dc releaseDC( Screen ) -- free memory free( bmFile ) return hDib end function ----------------------------------------------------------------------------- --/topic Graphics --/func loadBitmapFromFile( file name ) --/desc Loads a bitmap file. --/ret Win32 handle of bitmap, or /b Null if an error occured. -- /b Note: The name /i bitmap is a bit confusing; it should be more -- properly called /i loadDIBFromFile. At some point, the graphic -- routines need to be renamed in a more consistant manner. -- -- Example: -- --/code -- -- load a bitmap, and display in window -- atom hBitmap -- -- -- load the bitmap -- hBitmap = /loadBitmapFromFile( "graphic.bmp" ) -- -- -- display the bitmap in TheWindow at {1,1} -- /drawBitmap( theWindow, hBitmap, 1, 1 ) -- --/endcode global function loadBitmapFromFile( sequence fName ) -- loads a bitmap, returns the handle atom file, hBitmap -- make it a lpz string file = allocate_string(fName) -- load it hBitmap = c_func(xLoadImage, {NULL, file, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE}) -- free the string free( file ) -- success? if hBitmap = NULL then -- try using alternate version hBitmap = loadBitmapFromFile2( fName ) -- failed again? if hBitmap = NULL then warnErr( "LoadImage in loadBitmapFrom File failed." ) end if end if -- NEW! 0.45o track as resource -- the use of mainWindow is probably not needed trackObject( mainWindow, hBitmap, ForProgram ) return hBitmap end function ----------------------------------------------------------------------------- --/topic Graphics --/proc drawBitmap( window, DIB handle, x, y ) --/desc Draws /i DIB (device independant bitmap) in /i window at { /i x, /i y }. -- /b Note: The term /i bitmap is inconsistant; I expect to be renaming -- these routines in the future. -- -- Example: -- --/code -- -- load a bitmap, and display in window -- atom hBitmap -- -- -- load the bitmap -- hBitmap = /loadBitmapFromFile( "graphic.bmp" ) -- -- -- display the bitmap in TheWindow at {1,1} -- /drawBitmap( theWindow, hBitmap, 1, 1 ) -- --/endcode global procedure drawBitmap( integer id, object bitmap, integer xStart, integer yStart ) -- Draw a bitmap onto the requested device -- The bitmap is (currently) expected to be passed as a handle atom hdc, hdcMem, hBitmap, bm, fName, ptSize, ptOrg bm = allocate_struct( SIZEOF_BITMAP ) ptSize = allocate_struct( SIZEOF_POINT ) ptOrg = allocate_struct( SIZEOF_POINT ) -- need to load the bitmap? if sequence( bitmap ) then -- passed a file name hBitmap = loadBitmapFromFile( bitmap ) else -- passed handle hBitmap = bitmap end if -- get the DC of the destination hdc = getDC( id ) -- create a memory device context hdcMem = c_func( xCreateCompatibleDC, {hdc} ) if hdcMem = NULL then warnErr( "drawBitmap:CreateCompatibleDC failed." ) end if -- select the bitmap into it if not c_func( xSelectObject, {hdcMem, hBitmap} ) then warnErr( "drawBitmap:SelectObject failed." ) end if -- set mapping mode to same as window if not c_func( xSetMapMode, {hdcMem, c_func( xGetMapMode, {hdc} ) } ) then warnErr( "drawBitmap:SetMapMode failed." ) end if -- get the dimensions of the bitmap if not c_func( xGetObject, {hBitmap, SIZEOF_BITMAP, bm} ) then warnErr( "drawBitmap:GetObject failed." ) end if -- move the size into the point structure ptSize store( ptSize, ptX, fetch( bm, bmWidth ) ) store( ptSize, ptY, fetch( bm, bmHeight ) ) -- convert the point to logical coordinates if not c_func( xDPtoLP, {hdc, ptSize, 1} ) then warnErr( "drawBitmap:DPtoLP failed." ) end if -- get the origin of the bitmap store( ptOrg, ptX, 0 ) store( ptOrg, ptY, 0 ) -- convert to logical coordinates if not c_func( xDPtoLP, {hdc, ptOrg, 1} ) then warnErr( "drawBitmap:DPtoLP failed." ) end if -- copy bitmap to device context if not c_func( xBitBlt, { hdc, xStart, yStart, fetch( ptSize, ptX ), fetch( ptSize, ptY ), hdcMem, fetch( ptOrg, ptX ), fetch( ptOrg, ptY ), SRCCOPY} ) then warnErr( "drawBitmap:BitBlt failed." ) end if -- release the device context if not c_func( xDeleteDC, {hdcMem} ) then warnErr( "drawBitmap:DeleteDC failed." ) end if -- release the DC of the destination releaseDC( id ) -- release topic Low Level Routines free( bm ) free( ptSize ) free( ptOrg ) end procedure ----------------------------------------------------------------------------- function codeToBytes( sequence bits ) -- Convert a sequence of text into bytes -- This is a support routine for createMonochromeBitmap -- Ex: "1,1,1,1,1,1,1,1,0,0" -- --> { #FF, #00 } integer byte, extra sequence slice, bytes -- add extra bits: must be multiple of 16 extra = remainder( length(bits), 16 ) if extra then bits = bits & repeat( 1, 16-extra ) end if -- convert bits to bytes bytes = {} for i = 1 to length( bits ) by 8 do -- get an 8 bit slice slice = bits[i..i+7] -- reverse it for conversion slice = reverse( slice ) -- convert bits to a byte byte = bits_to_int( slice ) -- add to list bytes = append( bytes, byte ) end for return bytes end function -- NEW! 0.43 removed global function createBitmap( sequence s ) -- build a monochrome bitmap from text integer wide, high atom bitmapData, hBitmap sequence data -- get the size wide = length( s[1] ) high = length( s ) -- build the data data = {} for i = 1 to length( s ) do data = data & codeToBytes( s[i] ) end for -- poke the bitmap into memory bitmapData = allocate_struct( length( data ) ) poke( bitmapData, data ) -- create a bitmap hBitmap = c_func( xCreateBitmap, {wide, high, 1, 1, bitmapData} ) if hBitmap = 0 then warnErr( "CreateBitmap failed." ) end if -- track resource for lenght of program trackObject( -1, hBitmap, ForProgram ) -- release memory free( bitmapData) return hBitmap end function ----------------------------------------------------------------------------- --/topic Graphics --/func textToBitmap( text ) --/desc Converts a sequence of text into a monochrome bitmap. --/ret Handle to Win32 bitmap, or /b Null on an error. -- Spaces are converted to White pixels; all other characters are -- converted to Black pixels. -- -- /b Note: This routine should probably be deprecated, or at least -- renames. -- -- Example: -- --/code -- -- create a bitmap, and display it -- atom hBitmap -- sequence image -- -- -- the image -- image = { " xxxxxx ", -- "x x", -- "x x x x", -- "x x", -- "x x x x", -- "x x x x", -- "x xxxx x", -- " xxxxxx ", -- -- -- -- create the bitmap -- hBitmap = /textToBitmap( image ) -- -- -- display the bitmap in TheWindow at {1,1} -- /drawBitmap( theWindow, hBitmap, 1, 1 ) -- --/endcode global function textToBitmap( sequence s ) -- build a monochrome bitmap from text -- all spaces become lit s = ( s = ' ' ) -- create the bitmap return createBitmap( s ) end function ----------------------------------------------------------------------------- function packScanLine( sequence pal, sequence pixels, integer bitsPer ) -- convert a scanline of data into a packed scanline integer fill, bytes, byte, at, perByte, pixtemp sequence packed -- NEW! 0.43 handled 24 bits if bitsPer = 24 then -- bytes in packed array bytes = length( pixels ) * 3 -- packed pixels packed = repeat( 0, bytes ) -- 3 byte triplet; blue, green, red at = 1 for i = 1 to bytes/3 do pixtemp = pixels[i] + 1 packed[at] = pal[ pixtemp ][3] packed[at+1] = pal[ pixtemp ][2] packed[at+2] = pal[ pixtemp ][1] -- move to start of next triplet at += 3 end for -- NEW! 0.43 changed >= to = elsif bitsPer = 8 then -- 1:1 packed = pixels elsif bitsPer = 4 then -- 4:1 -- pad to even length pixels = pixels & repeat( 0, 1 ) ---- 3 -- bytes in packed array bytes = floor( length( pixels ) / 2 ) ---- 4 -- packed pixels packed = repeat( 0, bytes ) -- 4 bits per; 2 numbers per byte at = 1 for i = 1 to bytes*2 by 2 do ---- 4 -- build a byte packed[at] = (pixels[i] * 16) + (pixels[i+1] * 1 ) ---- 4 -- move to start of next byte at = at + 1 end for elsif bitsPer = 1 then -- 8:1 -- pad to even length pixels = pixels & repeat( 0, 7 ) -- bytes in packed array bytes = floor( length( pixels ) / 8 ) -- packed pixels packed = repeat( 0, bytes ) -- 1 bits per; 8 numbers per byte at = 1 for i = 1 to bytes*8 by 8 do -- build a byte packed[at] = (pixels[i] * 128) + (pixels[i+1] * 64) + (pixels[i+2] * 32) + (pixels[i+3] * 16) + (pixels[i+4] * 8 ) + (pixels[i+5] * 4 ) + (pixels[i+6] * 2 ) + pixels[i+7] -- move to next byte at = at + 1 end for end if -- scanline needs to fall on an long boundary (4 bytes) fill = remainder( length( packed ), 4 ) if fill then packed = packed & repeat( 0, 4-fill ) end if return packed end function ----------------------------------------------------------------------------- --/topic Graphics --/func createDIB( data ) --/ret Handle to Win32 bitmap, or /b Null on an error. --/desc Converts a Euphoria bitmap format into a Win32 bitmap. -- The data is in the form { pal, data }. -- -- The name createDIB ("Device Independant Bitmap") was intended to -- distinguish this function from the obsolete /i createBitmap, which -- created only monochrome bitmaps. -- -- You only need to supply as many palette entries that are actually -- used by the image. Pixel indexes into the palette start at 0 (to be -- compatible with how Euphoria uses bitmaps) -- -- Palette entries are color tuples in the form { r, g, b }, with each -- color value ranging from 0 to 255. -- -- Example: -- --/code -- -- create a bitmap, and display it -- atom hBitmap -- sequence pixels, pal -- -- -- the pixels data -- pixels = { -- { 0,0,0,0 }, -- scan line 1 -- { 0,1,1,0 }, -- scan line 2 -- { 0,1,1,0 }, -- scan line 3 -- { 0,0,0,0 } } -- scan line 4 -- -- -- the pal data (color tuples) -- pal = { -- { 255, 0, 0 }, -- color 0 is bright red -- { 0, 0, 255 } } -- color 1 is bright blue -- -- -- create the DIB -- hBitmap = /createDIB( {Pal, Pixels} ) -- -- -- display the bitmap in TheWindow at {1,1} -- /drawBitmap( theWindow, hBitmap, 1, 1 ) --/endcode -- NEW! 0.41 now is passed a Euphoria bitmap global function createDIB( sequence euBmp ) -- create a DIB (bitmap) from pixels and palette -- note that the sequence of pixels is *zero* based. integer colors, palSize, headerSize, bitsPer, h, w, fill sequence pal, pixels atom memBitmapInfo, memBits, at, hdc, hDIB -- get values pal = euBmp[1] pixels = euBmp[2] -- number of colors colors = length( pal ) -- palette and packing size if colors <= 2 then palSize = 2 bitsPer = 1 elsif colors <= 16 then palSize = 16 bitsPer = 4 elsif colors <= 256 then palSize = 256 bitsPer = 8 -- NEW! 0.43 changed palSize = 16777216 elsif colors <= 16777216 then palSize = colors bitsPer = 24 end if -- size of bitmap w = length( pixels[1] ) h = length( pixels ) -- calculate the size of the BITMAPINFO header headerSize = SIZEOF_BITMAPINFOHEADER + (SIZEOF_RGBQUAD * palSize ) -- allocate memory for DIB memBitmapInfo = allocate_struct( headerSize ) -- build the bitmap info header store( memBitmapInfo, biSize, SIZEOF_BITMAPINFOHEADER ) store( memBitmapInfo, biWidth, w ) -- Width in pixels. store( memBitmapInfo, biHeight, -h ) -- Height in pixels. store( memBitmapInfo, biPlanes, 1 ) -- 1 color plane. store( memBitmapInfo, biBitCount, bitsPer ) -- bits per pixel. store( memBitmapInfo, biCompression, 0 ) -- No compression. store( memBitmapInfo, biSizeImage, 0 ) -- Unneeded with no compression. store( memBitmapInfo, biXPelsPerMeter, 0 ) -- Unneeded. store( memBitmapInfo, biYPelsPerMeter, 0 ) -- Unneeded. -- NEW! 0.43 (biClrUsed = colors and biClrImportant = all ) -- # colors in color table that are used by the image. 0 means all. store( memBitmapInfo, biClrUsed, colors ) -- # important colors. 0 = all. store( memBitmapInfo, biClrImportant, 0 ) -- NEW! 0.43 (needed to pass palette to packScanLine) -- -- pack the pixels for i = 1 to h do pixels[i] = packScanLine( pal, pixels[i], bitsPer ) end for -- get bytes per scanline w = length( pixels[1] ) -- allocate storage memBits = allocate( h * w ) -- copy pixels to memory at = memBits for i = 1 to h do poke( at, pixels[i] ) at = at + w end for -- get the address of the first rgb tuple at = address( memBitmapInfo, bmiColors ) -- copy the pal to memory for i = 1 to colors do -- store values store( at, rgbRed, pal[i][1] ) store( at, rgbGreen, pal[i][2] ) store( at, rgbBlue, pal[i][3] ) store( at, rgbReserved, 0 ) -- move to next quad at = at + SIZEOF_RGBQUAD end for -- Get the screen's device context. hdc = getDC( Screen ) -- Create the DIB. hDIB = c_func( xCreateDIBitmap, { hdc, address( memBitmapInfo, bmiHeader ), CBM_INIT, memBits, memBitmapInfo, DIB_RGB_COLORS} ) -- release the screen dc releaseDC( Screen ) -- free memory free( memBits ) free( memBitmapInfo ) trackObject( -1, hDIB, ForProgram ) return hDIB end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setIcon( object, icon ) --/desc Assign an icon to /i object. -- /i Object can be one of the following: -- -- /li /Window -- /li /Icon -- /li /PictureButton -- /li /TogglePicture -- -- If /i icon is a sequence, it will be assumed to be the name of an -- icon file, and Win32Lib will attempt to load the icon. -- -- Otherwise, /i icon is assumed to be the handle of an icon. -- -- Example: -- --/code -- -- assign an icon to the window -- /setIcon( TheWindow, "euphoria.ico" ) --/endcode global procedure setIcon( integer id, object icon ) -- assign an icon to an window -- Credit: Pete Eberlein atom szFile, handle -- is the icon a string (pathname) or a constant? if sequence( icon ) then -- get the icon handle handle = c_func(xExtractIcon, {getHandle(id), allot_string(icon), 0}) -- free the string free_strings() else -- use LoadIcon to load handle = c_func(xLoadIcon, {NULL, icon}) end if -- NEW! 0.40 added picture button support -- NEW! 0.43 changed class test if find( window_type[id], PictureControls ) then ok = sendMessage( id, BM_SETIMAGE, IMAGE_ICON, handle ) -- NEW! 0.42 accidentally removed from prior version -- NEW! 0.45l changed from checking window_type to window_class elsif window_class[id] = WINDOW then -- WM_SETICON associates an icon with a window ok = sendMessage( id, WM_SETICON, 0, handle ) else -- STM_SETICON associates an icon with a control ok = sendMessage( id, STM_SETICON, handle, 0 ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc setBitmap( object, bitmap ) --/desc Assign an icon to /i object. -- /i Object can be one of the following: -- -- /li /Bitmap -- /li /PictureButton -- /li /TogglePicture -- -- If /i bitmap is a sequence, it will be assumed to be the name of an -- bitmap file, and Win32Lib will attempt to load the bitmap. -- -- Otherwise, /i bitmap is assumed to be the handle of a bitmap. -- -- Example: -- --/code -- -- assign a bitmap to the picture button -- /setIcon( PictureButton1, "close.bmp" ) --/endcode global procedure setBitmap( integer id, object bitmap ) -- assign an icon to an window -- Credit: Pete Eberlein -- is it a constant, or a file path? if sequence( bitmap ) then -- it's a pathname. use LOADFROMFILE. bitmap = c_func(xLoadImage, {NULL, allot_string(bitmap), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE}) -- free the string free_strings() end if -- NEW! 0.40 added picture button support -- NEW! 0.43 changed class test if find( window_type[id], PictureControls ) then ok = sendMessage( id, BM_SETIMAGE, IMAGE_BITMAP, bitmap ) else ok = sendMessage( id, STM_SETIMAGE, IMAGE_BITMAP, bitmap ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc setPixmap( pixmap, bitmap ) --/desc Assign a new value to a /Pixmap. -- If /i bitmap is a sequence, it will be assumed to be the name of an -- bitmap file, and Win32Lib will attempt to load the bitmap. -- -- Otherwise, /i bitmap is assumed to be the handle of a bitmap. -- -- Example: -- --/code -- -- assign a bitmap to the picture button -- /setPixmap( Pixmap1, "spaceship.bmp" ) --/endcode -- NEW! 0.45m bitmap is now passed as an object global procedure setPixmap( integer id, object bitmap ) -- assign a new value to a pixmap -- NEW! 0.45o replaced window_handle with getHandle -- is there an old bitmap? if window_handle[ id ] != 0 then deleteObject( getHandle( id ) ) end if -- file name or handle? if sequence( bitmap ) then -- try to load bitmap file window_handle[ id ] = loadBitmapFromFile( bitmap ) else -- just assign to handle window_handle[ id ] = bitmap end if end procedure ----------------------------------------------------------------------------- --/topic Graphics --/func copyToBitmapFile( window, fileName, x1, y1, x2, y2 ) --/desc Copies image in source to file /i fileName. --/ret Returns 0 (BMP_SUCCESS) if succeeds. -- There are a number of caveats: -- -- /li It uses /getPixel , so it's slow. -- /li It uses /b save_bitmap, so it's currently limited to 256 colors. -- The error codes are the also the same as those returned by /b save_bitmap. -- -- Example: -- --/code -- -- save {0,0} {100,100} on the screen to a file -- /copyToBitmapFile( Screen, "screen.bmp", 0, 0, 100, 100 ) --/endcode global function copyToBitmapFile( integer id, sequence fileName, integer x1, integer y1, integer x2, integer y2 ) integer index, cx, cy, colors, ok, r, g, b atom rgb sequence image, scanline, palRGB, palPix -- empty palette palRGB = {} palPix = {} -- empty image image = {} -- scan a cx*cy image from the window for y = y1 to y2 do -- empty scanline scanline = {} -- scan the x column for x = x1 to x2 do -- get the pixel rgb = getPixel( id, x, y ) -- is it in the palette yet? index = find( rgb, palPix ) if index = 0 then -- save the atom in the pixel palette palPix = append( palPix, rgb ) -- convert to {r,g,b} triplet r = and_bits( rgb, #FF ) rgb = floor( rgb / #100 ) g = and_bits( rgb, #FF ) b = floor( rgb / #100 ) -- save the color in the RGB palette palRGB = append( palRGB, {r,g,b} ) -- index the last palette entry index = length( palPix ) end if -- index is zero based index = index - 1 -- add the palette index to the scanline scanline &= index end for -- add the scanline to the image image = append( image, scanline ) end for -- the palette size MUST be 2, 4, 16 or 32, or Euphoria -- will not save the file. if length( palRGB ) <= 2 then colors = 2 elsif length( palRGB ) <= 4 then colors = 4 elsif length( palRGB ) <= 16 then colors = 16 elsif length( palRGB ) <= 256 then colors = 256 else -- error return BMP_INVALID_MODE end if -- pad the palette, if needed if length( palRGB ) < colors then for i = 1 to colors - length( palRGB ) do palRGB = append( palRGB, {0,0,0} ) end for end if -- write the bitmap return save_bitmap( {palRGB, image}, fileName ) end function ----------------------------------------------------------------------------- --/topic Attributes --/proc setWindowBackColor( window, color ) --/desc Sets /i window to /i color. -- This is typically used to change the default color of a window. You can -- use /getSysColor to get a default system color. This will trigger an -- /onPaint event. -- -- Example: -- --/code -- -- Set the window background color to bright white -- /setWindowBackColor( MyWindow, BrightWhite ) --/endcode global procedure setWindowBackColor( integer id, atom rgbColor ) -- set the background color of a window -- use rgb() to calculate a color atom result -- save color window_bcolor[ id ] = rgbColor -- create a new brush result = c_func( xCreateSolidBrush, {rgbColor} ) -- NEW! 0.45o replaced window_handle with getHandle -- set that as the background color result = c_func( xSetClassLong, {getHandle( id ), GCL_HBRBACKGROUND, result} ) -- delete the prior brush if created by Win32Lib deleteObject( result ) -- redraw the screen repaintWindow( id ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc getSysColor( window, color ) --/desc Return atom with value of a system color. -- The system colors in Windows are: -- -- /li /b COLOR_SCROLLBAR -- /li /b COLOR_BACKGROUND -- /li /b COLOR_DESKTOP -- /li /b COLOR_ACTIVECAPTION -- /li /b COLOR_INACTIVECAPTION -- /li /b COLOR_MENU -- /li /b COLOR_WINDOW -- /li /b COLOR_WINDOWFRAME -- /li /b COLOR_MENUTEXT -- /li /b COLOR_WINDOWTEXT -- /li /b COLOR_CAPTIONTEXT -- /li /b COLOR_ACTIVEBORDER -- /li /b COLOR_INACTIVEBORDER -- /li /b COLOR_APPWORKSPACE -- /li /b COLOR_HIGHLIGHT -- /li /b COLOR_HIGHLIGHTTEXT -- /li /b COLOR_BTNFACE -- /li /b COLOR_BTNSHADOW -- /li /b COLOR_GRAYTEXT -- /li /b COLOR_BTNTEXT -- /li /b COLOR_INACTIVECAPTIONTEXT -- /li /b COLOR_BTNHIGHLIGHT -- /li /b COLOR_3DDKSHADOW -- /li /b COLOR_3DLIGHT -- /li /b COLOR_INFOTEXT -- /li /b COLOR_INFOBK -- -- Example: -- --/code -- -- Set the window to the button color -- /setWindowBackColor( MyWindow, /getSysColor( COLOR_BTNFACE ) ) --/endcode global function getSysColor( integer winPart ) -- returns the color associated with a graphical element -- use the COLOR_xxxx constants return c_func( xGetSysColor, {winPart} ) end function ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- BitBlt Support Routines ----------------------------------------------------------------------------- --/topic Graphics --/proc bitBlt( dst, dstX, dstY, src, srcX, srcY, wide, high, rop ) --/desc Copy image (or partial image) from source to destination. -- The /bitBlt function can be used to rapidly copy images, or -- portions of images. -- -- If you want to copy the entire source image with the /b SRCCOPY -- /b ROP code, /copyBlt does the same thing, but requires less -- arguments. -- -- To copy images with transparency, use /transBlt. -- -- The arguments are: -- -- /li /i dst: Image destination -- /li /i dstX: X position in destination -- /li /i dstY: Y position in destination -- /li /i src: Image source -- /li /i srcX: X position in source -- /li /i srcY: Y position in source -- /li /i wide: Width of image to copy -- /li /i high: Height of image to copy -- /li /i rop: Raster opeartion (ROP) code to apply -- -- The /b ROP (raster operation) specifies how to combine the source with -- the destination. The codes are: -- -- /li /b SrcCopy dest = source -- /li /b SrcPaint dest = source OR dest -- /li /b SrcAnd dest = source AND dest -- /li /b SrcInvert dest = source XOR dest -- /li /b SrcErase dest = source AND (NOT dest) -- /li /b NotSrcCopy dest = (NOT source) -- /li /b NotSrcErase dest = (NOT src) AND (NOT dest) -- /li /b MergeCopy dest = (source AND pattern) -- /li /b MergePaint dest = (NOT source) OR dest -- /li /b PatCopy dest = pattern -- /li /b PatPaint dest = dest OR (pattern OR (NOT source)) -- /li /b PatInvert dest = pattern XOR dest -- /li /b DstInvert dest = (NOT dest) -- /li /b Blackness dest = BLACK -- /li /b Whiteness dest = WHITE -- -- /b Note: At the moment, the coordinates are zero relative; this may -- be changed in later releases. -- Example: --/code -- -- draw a bitmap in a window -- atom hDIB -- -- -- load the bitmap -- hDib = /loadBitmapFromFile( "lizard.bmp" ) -- -- -- copy 40x40 portion of source image to destination -- /bitBlt( TheWindow, -- copy to TheWindow -- 10, 10, -- put at {10,10} in TheWindow -- Pixmap1, -- copy from Pixmap1 -- 0, 0 -- upper left hand corner is {0,0} -- 40, 40, -- copy a 40x40 pixel portion -- SRCCOPY ) -- replace destination with image --/endcode global procedure bitBlt( atom dst, integer dstX, integer dstY, atom src, integer srcX, integer srcY, integer wide, integer high, integer rop ) -- wrapper to bitblt -- copy portion of window into bitmap integer srcIsWin, dstIsWin atom srcDC, dstDC -- get the DCs srcDC = getDC( src ) dstDC = getDC( dst ) -- copy area if not c_func( xBitBlt, { dstDC, dstX, dstY, wide, high, srcDC, srcX, srcY, rop} ) then warnErr( "bitBlt:BitBlt failed." ) end if -- release the DCs releaseDC( dst ) releaseDC( src ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc copyBlt( dst, dstX, dstY, src ) --/desc Copy full image from source to destination. -- If you only want to copy a portion of the source or need to combine -- the source and destination, use /bitBlt. -- -- To copy images with transparency, use /transBlt. -- -- The arguments are: -- -- /li /i dst: Image destination -- /li /i dstX: X position in destination -- /li /i dstY: Y position in destination -- /li /i src: Image source -- -- -- /b Note: At the moment, the coordinates are zero relative; this will -- be changed in later releases. -- Example: --/code -- -- draw a bitmap in a window -- atom hDIB -- -- -- load the bitmap -- hDib = /loadBitmapFromFile( "shuttle.bmp" ) -- -- -- copy the entire image to TheWindow -- /copyBlt( TheWindow, 10, 10, hDib ) --/endcode global procedure copyBlt( atom dst, integer x, integer y, atom src ) -- copy entire destination to source sequence size -- get the size of the pixmap size = getSize( src ) -- bitblt with scrCopy bitBlt( dst, x, y, src, 0, 0, size[3], size[4], SRCCOPY ) end procedure ----------------------------------------------------------------------------- --/topic Graphics --/proc transBlt( dst, dstX, dstY, src ) --/desc Copy full image from source to destination, with transparency. -- TransBlt is typically used for displaying non-rectangular bitmaps - -- /i sprites. It is a computationally expensive operation; if there -- is no transparency in your image, you should use /copyBlt or /bitBlt -- instead. -- -- By default, /transBlt assumes that the color {255,0,255} is to be -- treated as transparent. To change the transparent color, use -- /setTransparentColor. -- -- The arguments are: -- -- /li /i dst: Image destination -- /li /i dstX: X position in destination -- /li /i dstY: Y position in destination -- /li /i src: Image source -- -- /b Note: At the moment, the coordinates are zero relative; this will -- be changed in later releases. -- Example: --/code -- -- draw a bitmap using transparency -- atom hDIB -- sequence extent -- -- -- get the size of TheWindow -- extent = getExtent( TheWindow ) -- -- -- load the bitmap -- hDib = /loadBitmapFromFile( "shuttle.bmp" ) -- -- -- treat the color BrightWhite as transparent -- /setTransparentColor( BrightWhite ) -- -- -- copy multiple images to TheWindow -- for i = 1 to 20 do -- /transBlt( TheWindow, -- destination -- rand( extent[1] ), -- x position -- rand( extent[2] ), -- y position -- hDib ) -- image to copy -- end for --/endcode global procedure transBlt( atom dest, integer destX, integer destY, atom src ) integer wide, -- width of the source bitmap high -- height of the source bitmap atom srcBmp, -- source bitmap destDC, -- device context of destination srcDC, -- source bitmap (color) saveDC, -- backup copy of source bitmap maskDC, -- mask bitmap (monochrome) invDC, -- inverse of mask bitmap (monochrome) resultDC, -- combination of source bitmap & background hResultBmp, -- Bitmap combination of source & background hSaveBmp, -- Bitmap stores backup copy of source bitmap hMaskBmp, -- Bitmap stores mask (monochrome) hInvBmp, -- Bitmap holds inverse of mask (monochrome) hPrevBmp, -- Bitmap holds previous bitmap selected in DC hSrcPrevBmp, -- Holds previous bitmap in source DC hSavePrevBmp, -- Holds previous bitmap in saved DC hDestPrevBmp, -- Holds previous bitmap in destination DC hMaskPrevBmp, -- Holds previous bitmap in the mask DC hInvPrevBmp, -- Holds previous bitmap in inverted mask DC OrigColor, -- Holds original background color from source DC Success -- Stores result of call to Windows API sequence size -- holder for size of source -- is the source a bitmap, or a pixmap? if not validId( src ) then -- it's a bitmap srcBmp = src elsif window_class[ src ] = PIXMAP then -- NEW! 0.45o replaced window_handle with getHandle -- get the handle srcBmp = getHandle( src ) -- release resources for it releaseResourcesForID( src ) else -- no good warnErr( "Source to transBlt must be bitmap or Pixmap" ) return end if -- get the size of the bitmap size = getSize( srcBmp ) -- get the values from the bitmap wide = size[3] high = size[4] -- get the DC of the destintation destDC = getDC( dest ) -- create DCs to hold temporary information srcDC = c_func( xCreateCompatibleDC, {destDC} ) saveDC = c_func( xCreateCompatibleDC, {destDC} ) maskDC = c_func( xCreateCompatibleDC, {destDC} ) invDC = c_func( xCreateCompatibleDC, {destDC} ) resultDC = c_func( xCreateCompatibleDC, {destDC} ) -- Create monochrome bitmaps for the mask-related bitmaps: hMaskBmp = c_func( xCreateBitmap, {wide, high, 1, 1, 0} ) hInvBmp = c_func( xCreateBitmap, {wide, high, 1, 1, 0} ) -- Create color bitmaps for final result & stored copy of source hResultBmp = c_func( xCreateCompatibleBitmap, {destDC, wide, high} ) hSaveBmp = c_func( xCreateCompatibleBitmap, {destDC, wide, high} ) -- select the bitmaps into the DCs hSrcPrevBmp = c_func( xSelectObject, {srcDC, srcBmp} ) hSavePrevBmp = c_func( xSelectObject, {saveDC, hSaveBmp} ) hMaskPrevBmp = c_func( xSelectObject, {maskDC, hMaskBmp} ) hInvPrevBmp = c_func( xSelectObject, {invDC, hInvBmp} ) hDestPrevBmp = c_func( xSelectObject, {resultDC, hResultBmp} ) -- Make backup of source bitmap to restore later Success = c_func( xBitBlt, {saveDC, 0, 0, wide, high, srcDC, 0, 0, SRCCOPY} ) -- Create mask: set background color of source to transparent color. OrigColor = c_func( xSetBkColor, {srcDC, transColor} ) Success = c_func( xBitBlt, {maskDC, 0, 0, wide, high, srcDC, 0, 0, SRCCOPY} ) -- restore the original color Success = c_func( xSetBkColor, {srcDC, OrigColor} ) -- Create inverse of mask to AND w/ source & combine w/ background. Success = c_func( xBitBlt, {invDC, 0, 0, wide, high, maskDC, 0, 0, NOTSRCCOPY} ) -- Copy background bitmap to result & create final transparent bitmap Success = c_func( xBitBlt, {resultDC, 0, 0, wide, high, destDC, destX, destY, SRCCOPY} ) -- AND mask bitmap w/ result DC to punch hole in the background by -- painting black area for non-transparent portion of source bitmap. Success = c_func( xBitBlt, {resultDC, 0, 0, wide, high, maskDC, 0, 0, SRCAND} ) -- AND inverse mask w/ source bitmap to turn off bits associated -- with transparent area of source bitmap by making it black. Success = c_func( xBitBlt, {srcDC, 0, 0, wide, high, invDC, 0, 0, SRCAND} ) -- XOR result w/ source bitmap to make background show through. Success = c_func( xBitBlt, {resultDC, 0, 0, wide, high, srcDC, 0, 0, SRCPAINT} ) -- Display transparent bitmap on backgrnd Success = c_func( xBitBlt, {destDC, destX, destY, wide, high, resultDC, 0, 0, SRCCOPY} ) -- Restore backup of bitmap. Success = c_func( xBitBlt, {srcDC, 0, 0, wide, high, saveDC, 0, 0, SRCCOPY} ) -- select the original objects hPrevBmp = c_func( xSelectObject, {srcDC, hSrcPrevBmp} ) hPrevBmp = c_func( xSelectObject, {saveDC, hSavePrevBmp} ) hPrevBmp = c_func( xSelectObject, {resultDC, hDestPrevBmp} ) hPrevBmp = c_func( xSelectObject, {maskDC, hMaskPrevBmp} ) hPrevBmp = c_func( xSelectObject, {invDC, hInvPrevBmp} ) -- deallocate system resources Success = c_func( xDeleteObject, {hSaveBmp} ) Success = c_func( xDeleteObject, {hMaskBmp} ) Success = c_func( xDeleteObject, {hInvBmp} ) Success = c_func( xDeleteObject, {hResultBmp} ) Success = c_func( xDeleteDC, {srcDC} ) Success = c_func( xDeleteDC, {saveDC} ) Success = c_func( xDeleteDC, {invDC} ) Success = c_func( xDeleteDC, {maskDC} ) Success = c_func( xDeleteDC, {resultDC} ) -- release the DC of the destintation releaseDC( dest ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc closeWindow( window ) --/desc Close /i window. -- If /i window is not a main window, /i window will be hidden -- and the /onClose event will be triggered. -- -- If /i window is the /i main window (see /WinMain), then the -- application will be shut down and the /onDestroy event will -- -- Example: -- --/code -- -- close TheDialog -- /closeWindow( TheDialog ) --/endcode global procedure closeWindow( integer id ) -- close the window ok = sendMessage( id, WM_CLOSE, 0, 0 ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc moveWindow( control, x, y, cx, cy, repaint ) --/desc Move and resize /i control. -- The name is a bit misleading, since this applies to /controls as well -- as to /windows. The name /setPosition is already taken, although -- this may be changed to /i movePen in the future. -- -- /i control is moved to /i x, /i y, and sized to /i cx, /cy. If the -- /i repaint flag is set, the window is repainted. -- -- To find the current size and position of /i control, use /getSize. -- -- Example: -- --/code -- -- move Button1 to 20x20 -- sequence size -- -- -- get the current size -- size = /getSize( Button1 ) -- -- -- change the size and repaint -- /moveWindow( Button1, 20, 20, size[3], size[4], True ) --/endcode global procedure moveWindow( integer id, integer x, integer y, integer cx, integer cy, integer repaint ) -- NEW! 0.45o replaced window_handle with getHandle -- move the given window if not c_func( xMoveWindow, {getHandle( id ), x, y, cx, cy, repaint} ) then warnErr( "moveWindow:MoveWindow failed." ) end if end procedure ----------------------------------------------------------------------------- --/topic Controls --/proc setSize( control, cx, cy ) --/desc Resize /i control to /i cx x /i cy. -- -- Example: -- --/code -- -- size Button1 to 60x32 -- /setSize( Button1, 60, 32 ) --/endcode global procedure setSize( integer id, integer cx, integer cy ) -- resize the given item integer x, y atom oldBmp, srcDC, dstDC sequence result if window_class[ id ] = PIXMAP then -- get the bitmap, replace it with null oldBmp = window_handle[ id ] window_handle[ id ] = 0 -- create a pixmap of the new size createPixmap( id, cx, cy ) -- was there a prior bitmap? if oldBmp != 0 then -- is there a current bitmap to draw into? if window_handle[ id ] != 0 then -- get size of old bitmap result = getExtent( oldBmp ) cx = result[1] cy = result[2] -- copy the old bitmap onto the new one bitBlt( window_handle[ id ], 0, 0, oldBmp, 0, 0, cx, cy, SRCCOPY ) end if -- release the old bitmap deleteObject( oldBmp ) end if else -- get the current location of the window result = getSize( id ) x = result[1] y = result[2] -- NEW! 0.45o replaced window_handle with getHandle -- normal window class, send MoveWindow to resize if not c_func( xMoveWindow, {getHandle( id ), x, y, cx, cy, 1} ) then warnErr( "setSize:MoveWindow failed." ) end if end if end procedure ----------------------------------------------------------------------------- procedure pushModal( integer id ) -- set window as modal -- if there was a prior modal window, stack it -- need to stack? if modalWindow then modalStack = append( modalStack, modalWindow ) end if -- set modal window modalWindow = id end procedure ----------------------------------------------------------------------------- procedure popModal() -- remove modal flag -- if there was a prior modal window, unstack it integer pending pending = length( modalStack ) -- need to unstack? if pending then -- set new modal modalWindow = modalStack[pending] -- unstack modalStack = modalStack[1..pending-1] else -- no pending modal window modalWindow = 0 end if end procedure -- NEW! 0.45 ----------------------------------------------------------------------------- --/topic Attributes --/proc popup( popupMenu, x, y ) --/desc Display popupMenu at { /i x, /i y }. -- -- Example: -- --/code -- -- -- create a popup for MyWindow -- constant -- MyPopup = create( Popup, "", MyWindow, 0, 0, 0, 0, 0 ) -- -- -- add four items into it -- constant -- Item1 = create( MenuItem, "Item 1", MyPopup, 0, 0, 0, 0, 0 ), -- Item2 = create( MenuItem, "Item 2", MyPopup, 0, 0, 0, 0, 0 ), -- Item3 = create( MenuItem, "Item 3", MyPopup, 0, 0, 0, 0, 0 ), -- Item4 = create( MenuItem, "Item 4", MyPopup, 0, 0, 0, 0, 0 ) -- -- -- popup the menu at {10,10} in MyWindow -- popup( MyPopup, 10, 10 ) -- --/endcode global procedure popup( integer id, integer x, integer y ) integer parent sequence pt atom result -- get parent parent = window_owner[ id ] -- convert the point to a screen point pt = getClientPoint( parent, x, y ) -- NEW! 0.45e no longer returns error if user doesn't make a selection -- popup the menu result = c_func( xTrackPopupMenu, { getHandle( id ), -- menu 0, -- flags pt[1], pt[2], -- position 0, -- reserved, must be 0 getHandle( parent ), -- owner window 0 } ) -- pointer to rect end procedure ----------------------------------------------------------------------------- -- MOUSE -- ----------------------------------------------------------------------------- --/topic Mouse --/proc captureMouse( window ) --/desc Send all mouse events to /i window. -- To release the mouse, use /releaseMouse. -- -- Example: -- --/code -- -- grab the mouse for TheWindow -- /captureMouse( TheWindow ) --/endcode global procedure captureMouse( integer id ) -- captures the mouse so all events are sent to that window -- capture the mouse if c_func( xSetCapture, { getHandle( id ) } ) then warnErr( "getMouse:SetCapture failed." ) end if end procedure ----------------------------------------------------------------------------- --/topic Mouse --/proc releaseMouse() --/desc Return control of the mouse to Windows. -- This is called after /captureMouse to put control of the mouse -- back to normal. -- -- Example: -- --/code -- -- release the mouse. -- /releaseMouse() --/endcode global procedure releaseMouse() -- release the mouse from a getMouse c_proc( xReleaseCapture, {} ) end procedure -- NEW! 0.48e ----------------------------------------------------------------------------- --/topic Attributes --/func isScreenPointIn( control, x, y ) --/ret /b True if point { /i x, /i y } is within /i control. --/desc Return /b True if the screen point { /i x, /i y } is within /i control. -- This is used for hit testing, to determine if a point lies on a control. -- -- Example: -- --/code -- -- check if screen point {10,10} lies in MyWindow -- if /isScreenPointIn( MyWindow, 10, 10 ) then -- -- point is in MyWindow -- end if --/endcode global function isScreenPointIn( integer id, integer x, integer y ) -- load the cursor integer x1, y1, x2, y2 object result -- window or control? if window_class[ id ] = WINDOW then -- see if the point falls in the window result = getSize( id ) x1 = result[1] y1 = result[2] x2 = result[3] y2 = result[4] else -- get position of parent result = getSize( window_owner[ id ] ) x1 = result[1] y1 = result[2] -- add position of parent to child -- NEW! 0.45e changed getExtent to getSize result = getSize( id ) x1 = x1 + result[1] - 1 y1 = y1 + result[2] - 1 x2 = result[3] y2 = result[4] end if -- if point falls in window/target if x >= x1 and y >= y1 and x <= x1 + x2 - 1 and y <= x1 + y2 - 1 then -- point is in control return True else -- point is not in control return False end if end function ----------------------------------------------------------------------------- -- TIMERS -- ----------------------------------------------------------------------------- --/topic Low Level Routines --/proc setTimer( window, timer, ticks ) --/desc Start a timer ticking in /i window. -- Timers are clocks that are maintained by Windows, and trigger events -- at a user-specified interval, measured in milliseconds. -- -- The arguments are: -- /li /i window: /Window the timer belongs to. -- /li /i timer: Unique ID assigned to the timer. -- /li /i milliseconds: How much time, in milliseconds, that must pass -- before triggering an /onTimer event. -- -- To respond to timer events, use /onTime. You can have more than -- one timer per /window. If your window is too busy to receive the -- timer messages, they will be discarded. -- -- Example: -- --/code -- -- start a timer with id #12 in MyWindow -- -- it will trigger every 3 seconds. -- /setTimer( MyWindow, 12, 3000 ) --/endcode global procedure setTimer( integer id, integer timerId, atom ticks ) -- NEW! 0.45o replaced window_handle with getHandle -- set a timer to go off every ticks milliseconds c_proc( xSetTimer, { getHandle( id ), timerId, ticks, 0 } ) end procedure ----------------------------------------------------------------------------- --/topic Low Level Routines --/proc killTimer( window, timer ) --/desc Stop a timer. -- This deactivates /i timer that was set with /setTimer. -- -- Example: -- --/code -- -- deactivate timer #12 -- /killTimer( MyWindow, 12 ) --/endcode global procedure killTimer( integer id, integer timerId ) -- NEW! 0.45o replaced window_handle with getHandle -- remove timer from window c_proc( xKillTimer, { getHandle( id ), timerId } ) end procedure ----------------------------------------------------------------------------- -- CURSORS -- ----------------------------------------------------------------------------- --/topic Mouse --/proc setMousePointer( control, pointer ) --/desc Set the pointer the mouse displays when in /i control. -- The default mouse pointer displayed is the /i ArrowPointer, except -- for /TextEdit and /MleEdit controls, which use the /i IBeamPointer. -- -- The /i pointer can either be a system pointer, or one created with -- the /createMousePointer function. -- -- System mouse pointers are: -- /li /i Null: Use default pointer -- /li /i ArrowPointer: Standard arrow -- /li /i IBeamPointer: Text I-Beam -- /li /i WaitPointer: Hourglass -- /li /i CrossPointer: Crosshair -- /li /i UpArrowPointer: Vertical arrow -- /li /i SizeNWSEPointer: Double-pointed arrow pointing northwest and southeast -- /li /i SIZENESWPointer: Double-pointed arrow pointing northeast and southwest -- /li /i SizeWEPointer: Double-pointed arrow pointing west and east -- /li /i SizeNSPointer: Double-pointed arrow pointing north and south -- /li /i SizeAllPointer: Same as /i SizePointer -- /li /i NoPointer: Slashed circle -- /li /i AppStartingPointer: Standard arrow with small hourglass -- /li /i IconPointer: Four-pointed arrow -- -- Example: -- --/code -- -- Change mouse pointer in MyWindow to CrossPointer -- /setMousePointer( MyWindow, CrossPointer ) --/endcode global procedure setMousePointer( integer id, atom style ) -- load the cursor atom handle, point, result integer x, y if style = 0 or find( style, heldCursor ) then -- don't need to load. either null or user defined handle = style else -- load system cursor handle = c_func( xLoadCursor, { NULL, style } ) if handle = NULL then -- warning warnErr( "setPointer:LoadCursor failed." ) end if end if -- set pointer style window_cursor[ id ] = handle -- NEW! 0.44e set pointer immediately if over control/window -- get the current mouse position point = allocate_struct( SIZEOF_POINT ) if not c_func( xGetCursorPos, {point} ) then warnErr( "setMousePointer:GetCursorPos failed." ) end if -- retrieve the position x = fetch( point, ptX ) y = fetch( point, ptY ) -- free the structure free( point ) if isScreenPointIn( id, x, y ) then -- immediately update the cursor if style = 0 then -- set to default cursor result = c_func( xSetCursor, {IDC_ARROW} ) else -- set the custom cursor result = c_func( xSetCursor, {window_cursor[id]} ) -- show the cursor. hide first so count remains same result = c_func( xShowCursor, {False} ) result = c_func( xShowCursor, {True} ) end if end if end procedure ----------------------------------------------------------------------------- --/topic Mouse --/proc createMousePointer( hotspot x, hotspot y, image ) --/desc Create a new mouse pointer. -- The /i x and /i y values are the "hotspot". The image is -- a 2x2 text sequence of the pointer. Bytes are interpreted as follows: -- -- ' ' = transparent -- '.' = solid white -- 'x' = solid black -- -- Example: -- --/code -- constant PlusPointer = /createMousePointer( 8, 8, { -- " xxxxxx ", -- " x....xx ", -- " x....xx ", -- " x....xx ", -- " x....xx ", -- "xxxxxx....xxxxxx ", -- "x..............xx", -- "x..............xx", -- "x..............xx", -- "x..............xx", -- "xxxxxx....xxxxxxx", -- " xxxxx....xxxxxxx", -- " x....xx ", -- " x....xx ", -- " x....xx ", -- " xxxxxxx ", -- " xxxxxx "} ) -- -- -- set as pointer for MyWindow -- /setMousePointer( MyWindow, PlusPointer ) -- --/endcode global function createMousePointer( integer x, integer y, sequence image ) -- load the cursor integer cx, cy, diff atom andPlane, xorPlane, hCursor sequence data, maskBits -- get the metrics for the cursor cx = c_func( xGetSystemMetrics, { SM_CXCURSOR } ) cy = c_func( xGetSystemMetrics, { SM_CYCURSOR } ) -- ensure image is wide enough diff = cx - length( image[1] ) for i = 1 to length( image ) do -- add padding... image[i] &= repeat( ' ', cx ) -- trim image[i] = image[i][1..cx] end for -- ensure the image is tall enough for i = 1 to cy do -- add extra padding image = append( image, repeat( ' ', cx ) ) end for -- trim image = image[1..cy] -- create the and mask maskBits = ( image = ' ' ) -- convert the bits to bytes data = {} for i = 1 to length( maskBits ) do data = data & codeToBytes( maskBits[i] ) end for -- allocate and poke the and plane data andPlane = allocate_struct( length( data ) ) poke( andPlane, data ) -- create the xor mask maskBits = (image = '.') -- convert the bits to bytes for i = 1 to length( image ) do end for data = {} for i = 1 to length( maskBits ) do data = data & codeToBytes( maskBits[i] ) end for -- allocate and poke the xor plane data xorPlane = allocate_struct( length( data ) ) poke( xorPlane, data ) -- NEW! 0.45q use instance() to get instance -- create the cursor hCursor = c_func( xCreateCursor, { instance(), -- application instance x, y, -- x and y of hotspot length( image ), -- cursor width length( image[1] ), -- cursor height andPlane, xorPlane } ) -- keep track of cursor trackCursor( hCursor ) -- free the data free( andPlane ) free( xorPlane ) return hCursor end function ----------------------------------------------------------------------------- -- COMMON DIALOGS: SAVE FILE NAME -- ----------------------------------------------------------------------------- function buildDefaultOfn( integer id, sequence fName, sequence filters, atom flags ) -- builds the ofn structure shared by open and save file -- filters is in the form: -- { "Text Files", "*.TXT,*.DOC", ... } atom ofn sequence filterList -- allocate the structure ofn = allocate_struct( SIZEOF_OPENFILENAME ) -- build the filter list by concatonating the elements -- and ending them with zeros filterList = {} for i = 1 to length( filters ) do filterList = filterList & filters[i] & 0 end for -- ends with nulls filterList = filterList & NULL & NULL -- size of structure, in bytes store( ofn, ofnStructSize, SIZEOF_OPENFILENAME ) -- NEW! 0.45o replaced window_handle with getHandle -- window that owns the dialog box store( ofn, ofnOwner, getHandle( id ) ) -- identifies the data block containing a dialog box template -- specified in ofnTemplateName. not used store( ofn, ofnInstance, NULL ) -- filters store( ofn, ofnFilter, filterList ) store( ofn, ofnCustomFilter, NULL ) store( ofn, ofnMaxCustFilter, NULL ) -- index of which filter to default to store( ofn, ofnFilterIndex, 1 ) -- default file name: allot an (at minimum) 256 byte buffer fName = fName & 0 & repeat( ' ', 256 ) store( ofn, ofnFile, fName ) -- max size of buffer pointed to by ofnFile. store( ofn, ofnMaxFile, 256 ) store( ofn, ofnFileTitle, NULL ) store( ofn, ofnMaxFileTitle, NULL ) store( ofn, ofnInitialDir, NULL ) store( ofn, ofnTitle, NULL ) -- NEW! 0.43 added 'flags' store( ofn, ofnFlags, or_all( { flags, -- flags passsed to routine OFN_EXPLORER, -- looks like windows explorer OFN_HIDEREADONLY, -- hide the read-only checkbox OFN_LONGNAMES, -- use long filenames OFN_PATHMUSTEXIST} ) ) -- path must exist store( ofn, ofnFileOffset, NULL ) store( ofn, ofnFileExtension, NULL ) -- default extension store( ofn, ofnDefExt, NULL ) -- custom data store( ofn, ofnCustData, NULL ) store( ofn, ofnHook, NULL ) store( ofn, ofnTemplateName, NULL ) return ofn end function ----------------------------------------------------------------------------- --/topic Dialogs --/func getOpenFileName( window, file, filters ) --/desc "Open File" dialog. --/ret Selected file name, or empty sequence if cancelled. -- Calling this function brings up the modal "Open File" dialog, allowing -- the user to select a file name. /i file is a sequence holding the default -- file name. /i filters is a list of patterns to limit displayed files to, -- in the format: -- --/code -- { "text", pattern, "text", pattern ... } --/endcode -- -- For example: --/code -- constant FileTypes = { -- "Text File", "*.TXT", -- "Euphoria Program", "*.EX;*.EXW;*.E;*.EW", -- "All Files", "*.*" } --/endcode -- -- Note that a pattern can contain several different values. -- -- Example: -- --/code -- -- get file name to open -- sequence filename -- -- filename = getOpenFileName( -- TheWindow, -- parent window -- "", -- no default name -- { "Text File", "*.TXT", -- text files -- "All Files", "*.*" } ) -- everything else --/endcode global function getOpenFileName( integer id, sequence fName, sequence filters ) atom ofn -- build the structure ofn = buildDefaultOfn( id, fName, filters, or_all( { OFN_FILEMUSTEXIST } ) ) -- file must exist -- call the routine if c_func(xGetOpenFileName, {ofn}) then -- get the name fName = fetch( ofn, ofnFile ) else -- return blank fName = "" end if -- release the structure and strings free( ofn ) free_strings() return fName end function ----------------------------------------------------------------------------- --/topic Dialogs --/func getSaveFileName( window, file, filters ) --/desc "Save File" dialog. --/ret Selected file name, or empty sequence if cancelled. -- Calling this function brings up the modal "Save File" dialog, allowing -- the user to select a file name. /i file is a sequence holding the default -- file name. /i filters is a list of patterns to limit displayed files to, -- in the format: -- --/code -- { "text", pattern, "text", pattern ... } --/endcode -- -- For example: --/code -- constant FileTypes = { -- "Text File", "*.TXT", -- "Euphoria Program", "*.EX;*.EXW;*.E;*.EW", -- "All Files", "*.*" } --/endcode -- -- Note that a pattern can contain several different values. -- -- Example: -- --/code -- -- get file name to save -- filename = getOpenFileName( -- TheWindow, -- parent window -- "MyFile.txt", -- default name -- { "Text File", "*.TXT", -- text files -- "All Files", "*.*" } ) -- everything else --/endcode global function getSaveFileName( integer id, sequence fName, sequence filters ) atom ofn -- build the structure ofn = buildDefaultOfn( id, fName, filters, or_all( { OFN_OVERWRITEPROMPT } ) ) -- warn if exists -- call the routine if c_func(xGetSaveFileName, {ofn}) then -- get the name fName = fetch( ofn, ofnFile ) else -- cancelled fName = "" end if -- release the structure and strings free( ofn ) free_strings() -- return result return fName end function -- NEW! 0.45k ----------------------------------------------------------------------------- --/topic Dialogs --/func getColorDialog( window, default color ) --/desc "Get Color" Dialog --/ret Selected color, or default color if nothing selected. -- Calling this function brings up the modal "Select Color" dialog, allowing -- the user to select a color from the default color list, or add a color to -- the custom color list. -- -- The parameter passed in /b default /b color is an atom representing the -- default color to select, in #RRGGBB format. Passing -1 specifies that -- the color black (#000000) is the default color. -- -- /b NOTE: For some reason, the parameter seems to be in the #BBGGRR format -- instead of the #RRGGBB form. If someone could figure out what's happening -- here, I'd appreciate it. -- -- Example: -- --/code -- -- get a color; red ( #FF0000 ) is the default -- atom color -- color = getColorDialog( Window, #FF0000 ) --/endcode atom customColors customColors = allocate(64) for i=0 to 63 do poke(customColors+i,#FF) end for global function getColorDialog(atom id, atom defaultColor ) atom mem, result, color -- allocate memory for the dialog mem = allocate_struct( SIZEOF_COLORDLG ) -- set up store( mem, COLORDLG_lStructSize, SIZEOF_COLORDLG ) store( mem, COLORDLG_hwndOwner, getHandle(id) ) store( mem, COLORDLG_lpCustColors, customColors ) -- NEW! 0.45m always use default color -- default color store( mem, COLORDLG_Flags, CC_RGBINIT ) store( mem, COLORDLG_rgbResult, defaultColor ) -- call the routine result = c_func(xColorDlg, {mem}) if result then -- fetch the color color = fetch( mem, COLORDLG_rgbResult ) else -- NEW! 0.45m return default color instead of -1 -- cancelled color = defaultColor end if -- release the buffer free( mem ) return color end function -- NEW! 0.45m ----------------------------------------------------------------------------- --/topic Dialogs --/func getFontDialog( window ) --/desc "Get Font" Dialog --/ret { font name, points, style flags, color } or -1 if cancelled. -- Calling this function brings up the modal "Select Font" dialog, allowing -- the user to select a font from the list of available fonts. -- -- Example: -- --/code -- integer flags, points -- atom color -- sequence font -- object result -- -- -- get a font choice from the user -- result = getFontDialog( MyWindow ) -- if sequence( result ) then -- -- get the values -- font = result[1] -- points = result[2] -- flags = result[3] -- color = result[4] -- end if --/endcode global function getFontDialog( integer owner ) integer points, attrib sequence font atom hChooseFont, hLogFont, color object result -- assume failure result = -1 -- create structures hChooseFont = allocate_struct( SIZEOF_CHOOSEFONT) hLogFont = allocate_struct(SIZEOF_LOGFONT) -- populate the choose font structure store( hChooseFont, CF_lStructSize, SIZEOF_CHOOSEFONT ) store( hChooseFont, CF_hwndOwner, getHandle( owner ) ) store( hChooseFont, CF_Flags, CF_SCREENFONTS+CF_EFFECTS ) store( hChooseFont, CF_hLogFont, hLogFont ) -- call the dialog if c_func( xChooseFont,{ hChooseFont } ) then -- pointer to structure good? if fetch( hChooseFont, CF_hLogFont ) then -- got pointer successfully font = peek_string( address( hLogFont, lfFaceName ) ) points = floor( fetch( hChooseFont, CF_iPointSize ) / 10 ) -- clear attributes attrib = 0 -- NEW! 0.45o check correct flag -- bold? if fetch( hLogFont, lfWeight ) = 700 then attrib += Bold end if -- italic? if fetch( hLogFont, lfItalic ) then attrib += Italic end if -- underline? if fetch( hLogFont, lfUnderline ) then attrib += Underline end if -- strikeout? if fetch( hLogFont, lfStrikeOut ) then attrib += Strikeout end if --get font color color = fetch( hChooseFont, CF_rgbColors ) -- save result result = { font, points, attrib, color } end if end if -- free the structures free( hLogFont ) free( hChooseFont ) return result end function -- NEW! 0.45g rewrite of logic ----------------------------------------------------------------------------- procedure tab_direction( integer id, integer direction ) -- tabs ahead or back to next available focus item -- if nothing is found, doesn't focus on anything integer parent, focus, at sequence tabs -- is the id a window? if window_class[id] = WINDOW or window_type[id] = TabControl then -- parent is self parent = id else -- parent is container parent = window_owner[ id ] end if -- get the list of focus items tabs = window_focus_order[ parent ] -- get the index of the item with focus at = find( window_focus[ parent ], tabs ) -- look through all the tab stops for i = 1 to length( tabs ) do -- move in correct direction at += direction -- wrap? if at > length( tabs ) then at = 1 elsif at < 1 then at = length( tabs ) end if -- get proposed focus focus = tabs[at] -- can it take focus? if isEnabled( focus ) and isVisible( focus ) then -- NEW! 0.45o replaced window_handle with getHandle -- change focus c_proc( xSetFocus, { getHandle( focus ) } ) -- leave return end if end for end procedure ----------------------------------------------------------------------------- function shortInt( integer i ) -- converts numbers to short ints if i < 32000 then return i else return i - 65534 end if end function -- NEW! 0.31 added ----------------------------------------------------------------------------- function isTabKey( integer id, integer iMsg, atom wParam, atom lParam ) -- returns true if it's a tab key -- MleText requires the Ctrl key be pressed as well atom result -- key event and tab? if (iMsg = WM_KEYDOWN or iMsg = WM_KEYUP or iMsg = WM_CHAR ) and wParam = VK_TAB then -- MLE? if window_type[ id ] = MleText then -- only respond it CTRL key is pressed as well -- is the control key pressed? result = c_func( xGetKeyState, {VK_CONTROL} ) -- check the high bit. if floor( result / 2 ) then return 1 else return 0 end if else -- it's a tab return 1 end if else return 0 end if end function ----------------------------------------------------------------------------- -- NEW! 0.41 track self and return value on stack procedure pushSelf( integer id ) -- push the current self and return value onto stack myId &= id myReturn &= 0 end procedure ----------------------------------------------------------------------------- -- NEW! 0.41 function popSelf() -- pop the current id from the stack -- return the return value atom returns -- get the return value returns = myReturn[length(myReturn)] -- pop the self and return stacks myId = myId[1..length(myId)-1] myReturn = myReturn[1..length(myReturn)-1] return returns end function ----------------------------------------------------------------------------- --/topic Events --/proc returnValue( value ) --/desc Override default value returned by handler. -- This allows you to override the value an event handler returns to Win32. -- By default, when an event is processed, it goes through these steps: -- -- /li /onEvent: If there is an /onEvent handler for this control, it -- is passed the event. -- /li Event Trap: If there is a specific handler for this event, that -- handler is triggered. For example, /b WM_SETFOCUS triggers -- /onGotFocus, /b WM_SIZE triggers /onResize, etc. -- /li Default Windows Handler: Finally, the default Window handler for -- the control is called. In the case of subclassed /controls, -- /i CallWindowProc calls the normal handler; for /windows, -- /i DefWindowProc is called. -- -- Setting /returnValue causes processing to stop at the step that the -- value was set in, and return that value to Windows. -- -- Example: (not tested yet!) -- --/code -- -- prevent Button1 from seeing any space bar keys -- procedure Button1_KeyDown( /int keycode, /int shift ) -- if keycode = VK_SPACE then -- -- set return value -- /returnValue( True ) -- end if -- end procedure -- /onKeyDown[ Button1 ] = routine_id("Button1_KeyDown") --/endcode -- NEW! 0.42 global procedure returnValue( atom returns ) -- change the return value of the current control myReturn[length(myReturn)] = returns end procedure ----------------------------------------------------------------------------- -- NEW! 0.45a -- Allow user to select tooltip font integer hintFontSize, hintFontAttrib sequence hintFontName -- set defaults hintFontName = "MS Sans Serif" hintFontSize = 8 hintFontAttrib = Normal -- NEW! 0.45a ----------------------------------------------------------------------------- --/topic Fonts --/proc setHintFont( font, point size, attributes ) --/desc Set font type and size for the control's hints. -- -- Default values are { "MS Sans Serif", 8 points, Normal }. -- -- Example: -- --/code -- /setHintFont( "Times New Roman", 10, /Bold) --/endcode global procedure setHintFont( sequence fontName, integer points, integer attrib ) -- Updates default HintFontName value if not an empty string if length( fontName ) then hintFontName = fontName end if -- Updates default HintFontSize if value allowed if points > 4 then hintFontSize = points end if -- store style hintFontAttrib = attrib end procedure -- NEW! 0.45b ----------------------------------------------------------------------------- --/topic Attributes --/func getMousePos() --/desc Retrieves absolute position of the mouse. --/ret Mouse {x,y} position, relative to screen. -- -- Example: -- --/code -- sequence pos -- -- pos = getMousePos() -- if pos[1] > 200 then -- -- code goes here... -- end if --/endcode global function getMousePos() integer x, y atom point -- allocate a buffer to hold the point point = allocate_struct( SIZEOF_POINT ) if not c_func( xGetCursorPos, {point} ) then warnErr( "getMousePos:GetCursorPos failed." ) end if -- get the point x = fetch( point, ptX ) y = fetch( point, ptY ) -- free the point free( point ) return {x,y} end function ----------------------------------------------------------------------------- -- NEW! 0.41 procedure deactivateTooltip() -- restore the saved screen and kill timer if tooltip was shown if tooltipState = TooltipShown then -- deactivate the timer killTimer( mainWindow, TooltipTimerId ) -- restore the area of the screen covered by tooltip copyBlt( Screen, tooltipX, tooltipY, tooltipCovers ) end if -- set state to inactive tooltipState = TooltipInactive end procedure ----------------------------------------------------------------------------- -- NEW! 0.41 procedure armTooltip( integer id, integer x, integer y ) -- mouse moved over a tooltip. should it be armed? integer parent atom point, hWnd -- if there is another tooltip active, deactivate it deactivateTooltip() -- find the parent window parent = id while window_class[ parent ] != WINDOW do parent = window_owner[ parent ] end while -- is the control active? if getHandle( parent ) != c_func( xGetActiveWindow, {} ) then -- window is not active return end if -- does the control have a tooltip? if length( window_tooltip[id] ) then -- allocate a buffer to hold the point point = allocate_struct( SIZEOF_POINT ) store( point, ptX, x ) store( point, ptY, y ) -- map the point to window if not c_func( xMapWindowPoints, { getHandle( id ), 0, point, 1 } ) then warnErr( "triggerTooltip:MapWindowPoints failed." ) end if -- NEW! 0.45j added tooltipWindow -- store information for tool tip tooltipControl = id tooltipWindow = parent tooltipState = TooltipArmed tooltipMouseX = fetch( point, ptX ) tooltipMouseY = fetch( point, ptY ) -- NEW! 0.45a changed tick amount from 1000 to 100 -- start the timer in the main window setTimer( mainWindow, TooltipTimerId, 100 ) end if end procedure -- NEW! lots of changes in 0.45b ----------------------------------------------------------------------------- procedure triggerTooltip() -- tooltip timer was triggered. show the tooltip? integer x, y, cx, cy, mouseX, mouseY, winX1, winY1, winX2, winY2 atom point sequence extent, text, priorFont, size, mousePos -- NEW! 0.45b -- showing a tooltip? if tooltipState = TooltipShown then -- if the mouse out of client area, hide the tooltip -- find mouse pos mousePos = getMousePos() mouseX = mousePos[1] mouseY = mousePos[2] -- NEW! 0.45j uses tooltipWindow instead of mainWindow -- find tooltip's parent window client bounds size = getClientSize(tooltipWindow) winX1 = size[1] winY1 = size[2] winX2 = winX1 + size[3] winY2 = winY1 + size[4] -- pointer out of client area? if (mouseX < winX1) or (mouseX > winX2) or (mouseY < winY1) or (mouseY > winY2) then -- deactivate the tooltip deactivateTooltip() end if -- NEW! 0.45f prevent retriggering -- tooltip not displayed yet? elsif tooltipState = TooltipArmed then -- is the pointer in the same place? -- allocate a buffer to hold the point point = allocate_struct( SIZEOF_POINT ) if not c_func( xGetCursorPos, {point} ) then warnErr( "triggerTooltip:GetCursorPos failed." ) end if -- get the point x = fetch( point, ptX ) y = fetch( point, ptY ) -- free the point free( point ) -- NEW! 0.45f added suppression logic -- has mouse not moved and not suppressing tooltip? if tooltipShow and ( tooltipMouseX = x or tooltipMouseY = y ) then -- NEW! 0.45f moved font setting code after test -- store old values of screen before altering priorFont = window_font[Screen] -- set screen font to hint values setFont( Screen, hintFontName, hintFontSize, hintFontAttrib ) -- need to create a pixmap? if tooltipCovers = 0 then -- create a pixmap for it tooltipCovers = create( Pixmap, "", 0, 0, 0, 0, 0, 0 ) end if -- NEW! 0.45i assign value from tooltopMouseX, not tooltipMouseY -- position of tooltip, relative to mouse tooltipX = tooltipMouseX tooltipY = tooltipMouseY + 16 -- get text and extent text = window_tooltip[ tooltipControl ] extent = getTextExtent( Screen, text ) -- get the size of the tooltip cx = extent[1] + 8 -- adjust size cy = extent[2] + 6 -- size the pixmap setSize( tooltipCovers, cx, cy ) -- copy from screen bitBlt( tooltipCovers, 0, 0, Screen, tooltipX, tooltipY, cx, cy, SRCCOPY ) -- offset cx -= 1 cy -= 1 -- draw the box setPenColor( Screen, getSysColor( COLOR_INFOBK ) ) drawRectangle( Screen, 1, tooltipX, tooltipY, tooltipX+cx, tooltipY+cy ) -- box shadow setPenColor( Screen, getSysColor( COLOR_3DDKSHADOW ) ) drawLine( Screen, tooltipX+cx, tooltipY, tooltipX+cx, tooltipY+cy ) drawLine( Screen, tooltipX+cx, tooltipY+cy, tooltipX, tooltipY+cy ) drawLine( Screen, tooltipX, tooltipY, tooltipX+cx, tooltipY ) drawLine( Screen, tooltipX, tooltipY, tooltipX, tooltipY+cy ) -- text setPenColor( Screen, getSysColor( COLOR_INFOTEXT ) ) setPosition( Screen, tooltipX+4, tooltipY+3 ) wPuts( Screen, text ) -- restore prior font setFont(Screen,priorFont[FontName],priorFont[FontSize],priorFont[FontAttrib]) -- update state tooltipState = TooltipShown end if end if end procedure -- NEW! 0.42 ----------------------------------------------------------------------------- function getKeyState( atom key ) -- return the state Shift, Control, or Menu keys atom result -- get key result = c_func( xGetKeyState, {key} ) -- check the high bit. (low bit is toggle state) if floor( result / 2 ) then return True else return False end if end function -- NEW! 0.42 ----------------------------------------------------------------------------- function getKeyMasks() -- return the state Shift, Control, and Menu keys integer flags -- clear the flags flags = 0 -- shift key if getKeyState( VK_SHIFT ) then flags += ShiftMask end if -- control key if getKeyState( VK_CONTROL ) then flags += ControlMask end if -- alt key if getKeyState( VK_MENU ) then flags += AltMask end if return flags end function -- NEW! 0.46h ----------------------------------------------------------------------------- function isHotKey( integer id, atom event, integer key ) integer window, focus sequence hotkeys -- if there is a control in the hotkey list associated with the -- toplevel parent window, set focus to that control and return -- true. -- -- note that some controls (like TabControl) can have several items -- with the same hotkey, since only one group of controls are enabled -- at a time. -- find the top level window window = id while window_class[ window ] != WINDOW do -- move up window = window_owner[ window ] -- end of list? if window = 0 then -- control is not in a window! return False end if end while -- get the hotkey list hotkeys = window_hotkeys[ window ] -- any controls with same parent have this hotkey? for i = 1 to length ( hotkeys ) do -- matches key? if key = hotkeys[i][1] then -- get item with hotkey focus = hotkeys[i][2] -- is the control enabled and visible? if isEnabled( focus ) and isVisible( focus ) then -- NEW! 0.45o replaced window_handle with getHandle -- change focus c_proc( xSetFocus, { getHandle( focus ) } ) -- return true; hotkey handled return True end if end if end for -- hotkey not handled return False end function -- NEW! 0.46h ----------------------------------------------------------------------------- function isDefaultKey( integer id ) integer window, focus, result sequence hotkeys -- checks the hotkey list of the toplevel parent. if there is -- a control that responds to the Enter key, it's triggered. -- find the top level window window = id while window_class[ window ] != WINDOW do -- move up window = window_owner[ window ] -- end of list? if window = 0 then -- control is not in a window! return False end if end while -- get the hotkey list hotkeys = window_hotkeys[ window ] -- any controls with same parent have this hotkey? for i = 1 to length ( hotkeys ) do -- matches key? if hotkeys[i][1] = VK_RETURN then -- get item with hotkey focus = hotkeys[i][2] -- is the control enabled and visible? if isEnabled( focus ) and isVisible( focus ) then -- NEW! 0.45o replaced window_handle with getHandle -- change focus c_proc( xSetFocus, { getHandle( focus ) } ) -- trigger it result = sendMessage( focus, BM_CLICK, 0, 0 ) -- return true; hotkey handled return True end if end if end for -- hotkey not handled return False end function -- NEW! 0.45k ----------------------------------------------------------------------------- procedure dropFiles(integer id, atom hDrop) -- processes a WM_DROPFILES event. integer bufferSize, index, itemCount, dropRoutine atom buffer sequence fileName -- does this control support drag and drop? dropRoutine = onDragAndDrop[ id ] if dropRoutine > 0 then -- set up data structures index = -1 -- 'return the number of filenames' bufferSize = 256 buffer = allocate_struct( bufferSize ) -- get the count of files itemCount = c_func(xDragQueryFile,{hDrop, index, buffer, bufferSize}) -- DragQueryFileA uses zero based indexing for i = 0 to itemCount - 1 do -- get position of file name in the buffer index = c_func(xDragQueryFile,{hDrop, i, buffer, bufferSize}) -- get the file name fileName = peek({buffer, index}) -- user trap call_proc( dropRoutine, {fileName} ) end for -- free the memory free( buffer ) end if end procedure ----------------------------------------------------------------------------- procedure wmScroll( atom hWnd, atom wParam, atom lParam ) -- scroll event handler integer id, request, pos sequence range -- determine if this is from the parent window's scroll -- bar, or a child scroll bar if lParam = 0 then -- scroll bar of parent id = getId( hWnd ) else -- find the control id = getId( lParam ) end if -- get the request request = lo_word( wParam ) -- get the value of the scroll bar pos = getScrollPos( id ) -- get the range range = getScrollRange( id ) -- NEW! 0.45m only use on scrollbars, trackbar is automatic -- scrollbars need special handling to adjust small/large change if window_type[ id ] = HScroll or window_type[ id ] = VScroll then if request = SB_LINEUP then -- move up by 1 line pos = pos - window_scroll[ id ][ MY_SMALLCHANGE ] elsif request = SB_LINEDOWN then -- move down by 1 line pos = pos + window_scroll[ id ][ MY_SMALLCHANGE ] elsif request = SB_PAGEUP then -- move up by 1 page pos = pos - window_scroll[ id ][ MY_LARGECHANGE ] elsif request = SB_PAGEDOWN then -- move down by 1 page pos = pos + window_scroll[ id ][ MY_LARGECHANGE ] end if end if if request = SB_TOP then -- to top of page pos = range[1] elsif request = SB_BOTTOM then -- to bottom of page pos = range[2] elsif request = SB_THUMBPOSITION or request = SB_THUMBTRACK then -- track thumb position pos = hi_word( wParam ) end if -- clip to range if pos < range[1] then pos = range[1] elsif pos > range[2] then pos = range[2] end if -- call global routine to do the work setScrollPos( id, pos ) end procedure ----------------------------------------------------------------------------- -- NEW! 0.40 procedure resizeWidgets( integer id, integer cx, integer cy ) -- this is called when a window has been resized. -- if there is a toolbar or status bar in the window, -- it needs to be resized integer toolbar, statusbar, y atom result sequence extent -- get controls toolbar = window_toolbar[ id ] statusbar = window_statusbar[ id ] -- is there a toolbar to resize? if toolbar then -- get size of toolbar extent = getExtent( toolbar ) result = c_func( xMoveWindow, { getHandle(toolbar), 0, 0, cx, extent[2], 1 } ) end if -- is there a status bar to resize? if statusbar then -- get size of statusbar extent = getExtent( statusbar ) -- calculate position result = c_func( xMoveWindow, { getHandle(statusbar), 0, cy - extent[2], cx, 0, True } ) end if end procedure -- NEW! 0.45g new routine ----------------------------------------------------------------------------- procedure activateTabItems( integer id ) -- when a tab is activated, all the items that are -- associated with that tab are made visible. integer parent sequence group -- get the group of items in the tab group = window_group[ id ] -- get the parent of the tab parent = window_owner[ id ] for i = 1 to length( window_owner ) do -- NEW! 0.45p added test for TabItem -- owned by the tab's parent and not a tab item? if window_owner[ i ] = parent and window_type[i] != TabItem then -- part of tab group? if find( i, group ) then -- show it setVisible( i, True ) else -- hide it setVisible( i, False ) end if end if end for end procedure -- NEW! 0.45l routine shared by WndProc and CmdProc ----------------------------------------------------------------------------- function wmCommand( atom hWnd, atom iMsg, atom wParam, atom lParam ) -- this handles notification (WM_COMMAND) messages -- this is used by WINDOW and TabControls. integer ok, id, event, action, control, mouseX, mouseY sequence parms -- determine which window sent the message control = getId( lParam ) -- NEW! 0.42e change id -- push new id ok = popSelf() pushSelf( control ) -- this shouldn't happen... if control = 0 then -- NEW! 0.41 return myReturn value return popSelf() end if -- clear parms parms = {} event = hi_word( wParam ) action = -1 -- click? if event = BN_CLICKED then -- button -- get command action = onClick[ control ] -- get mouse position -- mouseX = lo_word( lParam ) -- mouseY = hi_word( lParam ) -- save as parameters parms = {} -- double click? elsif event = LBN_DBLCLK -- list box or event = CBN_DBLCLK -- combo box then -- get command action = onMouse[ control ] -- get mouse position mouseX = shortInt( lo_word( lParam ) ) mouseY = shortInt( hi_word( lParam ) ) -- NEW! 0.42 passes 4 parameters instead of 3 -- save as parameters parms = { LEFT_DOUBLECLICK, mouseX, mouseY, getKeyMasks() } -- change? elsif event = CBN_EDITCHANGE -- combo notify change or event = LBN_SELCHANGE -- list box notify change or event = EN_CHANGE -- editbox notify change then action = onChange[ control ] end if -- action? if action != -1 then call_proc( action, parms ) end if -- NEW! 0.41 return myReturn value return popSelf() end function -- NEW! 0.45l split SubclassedProc into seperate callback ----------------------------------------------------------------------------- function WndProc( atom hWnd, atom iMsg, atom wParam, atom lParam ) -- callback routine to handle Window class -- This routine processes messages sent by Windows -- NEW! 0.43b control, rect, ps hdc moved in as locals integer id, action, mouseX, mouseY, cx, cy, at atom hdc, rect, ps sequence parms object result -- find the control id = getId( hWnd ) -- not one of mine? if id = 0 then -- default processing return c_func( xDefWindowProc, { hWnd, iMsg, wParam, lParam } ) end if -- save the id for getSelf() pushSelf( id ) -- user can process events that Win32Lib doesn't have handlers for. if onEvent[ id ] > 0 then -- call routine call_proc( onEvent[ id ], {iMsg, wParam, lParam} ) -- NEW! 0.41 allow user to override if myReturn[length(myReturn)] != 0 then return popSelf() end if end if if iMsg = WM_MOUSEMOVE or iMsg = WM_LBUTTONDOWN or iMsg = WM_RBUTTONDOWN or iMsg = WM_LBUTTONUP or iMsg = WM_RBUTTONUP or iMsg = WM_LBUTTONDBLCLK or iMsg = WM_RBUTTONDBLCLK then -- NEW! 0.44b -- need to set the mouse cursor? if window_cursor[id] then -- set to the requested style ok = c_func( xSetCursor, {window_cursor[id]} ) end if -- decode parameters mouseX = shortInt( lo_word( lParam ) ) mouseY = shortInt( hi_word( lParam ) ) -- get command if iMsg = WM_LBUTTONDOWN then -- action? action = onClick[ id ] if action != -1 then call_proc( action, {} ) end if end if -- mouse up or down? if iMsg = WM_MOUSEMOVE or iMsg = WM_LBUTTONDOWN or iMsg = WM_RBUTTONDOWN or iMsg = WM_LBUTTONUP or iMsg = WM_RBUTTONUP or iMsg = WM_LBUTTONDBLCLK or iMsg = WM_RBUTTONDBLCLK then -- NEW! 0.41 -- if a tooltip is active, deactivate it deactivateTooltip() -- generate an event? action = onMouse[id] if action != -1 then -- NEW! 0.42 passes 4 parameters instead of 3 -- trigger action call_proc( action, { iMsg, mouseX, mouseY, getKeyMasks() } ) end if end if -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_SIZE then -- decode parameters cx = lo_word( lParam ) cy = hi_word( lParam ) -- resize behavior? if onResize[ id ] != - 1 then call_proc( onResize[ id ], {wParam, cx, cy } ) end if -- NEW! 0.40 -- resize the toolbar and statusbar, if any resizeWidgets( id, cx, cy ) -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_SETFOCUS then -- NEW! 0.45g changed tab order logic -- item to focus on? if length( window_focus_order[id] ) then -- get id of item to focus on result = window_focus[ id ] -- NEW! 0.45g changed tab logic -- no focus? if result = 0 then -- move ahead to first item tab_direction( id, 1 ) else -- move back one item window_focus[ id ] -= 1 -- try to focus on item again tab_direction( id, 1 ) end if end if -- is there a window with modal focus? if modalWindow and id != modalWindow then -- NEW! 0.45o replaced window_handle with getHandle -- set focus c_proc( xSetFocus, { getHandle( modalWindow )} ) else -- call proc? if onGotFocus[ id ] != -1 then call_proc( onGotFocus[ id ], {} ) end if end if -- handled -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_KILLFOCUS then -- NEW! 0.41 -- if tooltip active, deactivate it deactivateTooltip() if onLostFocus[ id ] != -1 then call_proc( onLostFocus[ id ], {} ) end if elsif iMsg = WM_KEYDOWN then if onKeyDown[ id ] != - 1 then -- NEW! 0.42 added shift flags call_proc( onKeyDown[ id ], { wParam, getKeyMasks() } ) end if elsif iMsg = WM_CHAR then if onKeyPress[ id ] != - 1 then -- NEW! 0.42 added shift flags call_proc( onKeyPress[ id ], { wParam, getKeyMasks() } ) end if elsif iMsg = WM_KEYUP then if onKeyUp[ id ] != - 1 then -- NEW! 0.42 added shift flags call_proc( onKeyUp[ id ], { wParam, getKeyMasks() } ) end if elsif ( iMsg = WM_COMMAND and lParam = NULL) then -- menu or accelerator? if hi_word( wParam ) = 1 then -- from accelerator; -- this should not happen -- menu click else -- get the menu id id = lo_word( wParam ) -- NEW! 0.42e change id -- push new id ok = popSelf() pushSelf( id ) -- get the action action = onClick[ id ] -- action? if action != -1 then call_proc( action, {} ) end if end if -- NEW! 0.45k elsif iMsg = WM_DROPFILES then -- process the dropped files dropFiles( id, wParam ) -- NEW! 0.45l encapsulated into wmCommand -- NEW! 0.45m only handles if reciever is direct parent of control elsif iMsg = WM_COMMAND and getId( lParam ) != 0 and window_owner[ getId( lParam ) ] = id then -- notification from control return wmCommand( hWnd, iMsg, wParam, lParam ) elsif iMsg = WM_PAINT then -- NEW! 0.43b moved into code -- allocate structures ps = allocate_struct(SIZEOF_PAINTSTRUCT) -- begin paint hdc = c_func( xBeginPaint, { hWnd, ps } ) -- NEW! 0.43d added paintDC stack -- push id and DC onto top of paintDC stack paintDC = prepend( paintDC, {id,hdc} ) -- get address of update rectangle rect = address( ps, psPaintRect ) -- fetch the update rectangle result = { fetch( rect, rectLeft ), fetch( rect, rectTop ), fetch( rect, rectRight ), fetch( rect, rectBottom ) } -- allow any part of the window to be written to if not c_func( xGetClientRect, {hWnd, rect} ) then warnErr( "GetClientRect in WndProc failed." ) end if -- is there an onPaint routine? if onPaint[ id ] > 0 then -- call routine with update rectangle call_proc( onPaint[ id ], result ) end if -- end of paint c_proc( xEndPaint, { hWnd, ps } ) -- NEW! 0.43d -- pop the paintDC stack paintDC = paintDC[2..length(paintDC)] -- NEW! 0.43b -- free the structure free( ps ) -- NEW! 0.43d checks paintDC stack before releasing -- no more remaining inPaints? if length( paintDC ) = 0 then -- release all held paint resources releasePaintResources() end if -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_VSCROLL or iMsg = WM_HSCROLL then -- scroll handling code wmScroll( hWnd, wParam, lParam ) -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_TIMER then -- timer event -- NEW! 0.41 -- user or tooltip? if wParam = TooltipTimerId then -- trigger a tooltip triggerTooltip() else -- is one set for this window? if onTimer[ id ] > 0 then -- pass it the timer id (in wParam) call_proc( onTimer[ id ], {wParam} ) end if end if -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_SYSCOLORCHANGE then -- system color changed. force a redraw of the window if not c_func( xInvalidateRect, {hWnd, NULL, -1} ) then warnErr( "InvalidateRect in WndProc failed." ) end if -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_CTLCOLORBTN or iMsg = WM_CTLCOLORSTATIC -- or iMsg = WM_CTLCOLOREDIT -- these do NOT adjust the color -- or iMsg = WM_CTLCOLORLISTBOX -- or iMsg = WM_CTLCOLORMSGBOX -- or iMsg = WM_CTLCOLORDLG -- or iMsg = WM_CTLCOLORSCROLLBAR then -- system is about to draw the colors for a control. -- this intercepts the command, and returns the brush we want -- wParam contains the device context of the control -- set text background color to the window background color if c_func(xSetBkColor, {wParam, window_bcolor[id]} ) = CLR_INVALID then warnErr( "SetBkColor in wndProc failed." ) end if -- NEW! 0.45o replaced window_handle with getHandle -- get the parent's background color brush return c_func( xGetClassLong, {getHandle(id), GCL_HBRBACKGROUND} ) elsif iMsg = WM_CREATE then -- the problem here is i don't know what the ID is until it's -- returned! That's why the onOpen action is placed in the -- create window routine, not here. -- force a screen refresh repaintWindow( id ) -- NEW! 0.41 return myReturn value return popSelf() elsif iMsg = WM_CLOSE then -- close modal grab? if modalWindow then popModal() end if -- NEW! 0.31 run onClose action before hiding window -- action? if onClose[id] != -1 then call_proc( onClose[id], {} ) end if -- NEW! 0.45o replaced window_handle with getHandle -- hide the window if not the primary if id != mainWindow then ok = c_func( xShowWindow, {getHandle(id), SW_HIDE} ) -- NEW! 0.41 return myReturn value return popSelf() end if elsif iMsg = WM_DESTROY then -- action? if onDestroy[id] != -1 then call_proc( onDestroy[id], {} ) end if -- close the app c_proc( xPostQuitMessage, { wParam } ) -- NEW! 0.45f elsif iMsg = WM_NOTIFY then -- lParam contains the notification message header iMsg = fetch( lParam, NMHDR_code ) if iMsg = TCN_SELCHANGE then -- get handle hWnd = fetch( lParam, NMHDR_hwndFrom ) -- find the tab control id id = getId( hWnd ) if id != 0 then -- what tab is selected? at = c_func( xSendMessage, {hWnd, TCM_GETCURSEL, 0, 0} ) + 1 -- get id of tab id = window_tabitems[ id ][ at ] -- activate the tab items for the control activateTabItems( id ) -- push new id ok = popSelf() pushSelf( id ) -- is there a click behavior? action = onClick[ id ] if action != -1 then call_proc( action, {} ) end if end if end if end if -- NEW! 0.41 -- pop stack result = popSelf() return c_func( xDefWindowProc, { hWnd, iMsg, wParam, lParam } ) end function -- NEW! 0.45l now independant of WndProc ----------------------------------------------------------------------------- function SubProc(atom hWnd, atom iMsg, atom wParam, atom lParam) -- handle subclassed behaviors for child controls integer id, pointer, tabKey, x, y, parent object result -- NEW! 0.45l moved id, pushSelf and onEvent logic into routine -- find the control id = getId( hWnd ) -- not one of mine? if id = 0 then -- NEW! 0.45l changed return value -- not handled return True end if -- save the id for getSelf() pushSelf( id ) -- user can process events that Win32Lib doesn't have handlers for. if onEvent[ id ] > 0 then -- call routine call_proc( onEvent[ id ], {iMsg, wParam, lParam} ) -- NEW! 0.41 allow user to override if myReturn[length(myReturn)] != 0 then return popSelf() end if end if -- NEW! 0.46h -- system key? if iMsg = WM_SYSKEYDOWN then -- hot key? if isHotKey( id, iMsg, wParam ) then -- processed result = popSelf() return 0 end if end if -- NEW! 0.46h -- activate default key? if iMsg = WM_KEYDOWN and wParam = VK_RETURN then if isDefaultKey( id ) then -- processed result = popSelf() return 0 end if end if -- NEW! 0.45b -- deactiveate tooltip on keys if tooltipState = TooltipShown then if iMsg = WM_KEYUP or iMsg = WM_KEYDOWN -- NEW! 0.46h should catch Alt-Tab or iMsg = WM_SYSKEYDOWN then -- disarm the tooltip deactivateTooltip() end if end if -- NEW! 0.31 uses isTabKey to test; handles MleText better -- tab key? if isTabKey( id, iMsg, wParam, lParam ) then -- ignore KEYUP and WM_CHAR; avoids multiple triggering if iMsg = WM_KEYDOWN then -- is the shift key pressed? result = c_func( xGetKeyState, {VK_SHIFT} ) -- check the high bit. the low order key indicates toggle -- state, so it's dropped. -- NEW! 0.45g tab_direction replaces tab_to if floor( result / 2 ) then -- set focus back tab_direction( id, -1 ) else -- set focus ahead tab_direction( id, 1 ) end if end if -- NEW! 0.41 uses popId instead of 0 return popSelf() end if if iMsg = WM_KEYDOWN then if onKeyDown[ id ] != - 1 then -- NEW! 0.42 added shift flags -- get shift key states and call routines call_proc( onKeyDown[ id ], { wParam, getKeyMasks() } ) end if elsif iMsg = WM_CHAR then if onKeyPress[ id ] != - 1 then -- NEW! 0.42 added shift flags call_proc( onKeyPress[ id ], { wParam, getKeyMasks() } ) end if elsif iMsg = WM_KEYUP then if onKeyUp[ id ] != - 1 then -- NEW! 0.42 added shift flags call_proc( onKeyUp[ id ], { wParam, getKeyMasks() } ) end if elsif iMsg = WM_SETFOCUS then -- store new focus window_focus[ window_owner[ id ] ] = id -- call proc? if onGotFocus[ id ] != -1 then call_proc( onGotFocus[ id ], {} ) end if elsif iMsg = WM_KILLFOCUS then -- NEW! 0.41 deactivateTooltip() if onLostFocus[ id ] != -1 then call_proc( onLostFocus[ id ], {} ) end if -- NEW! 0.45k elsif iMsg = WM_DROPFILES then -- process the dropped files dropFiles( id, wParam ) elsif iMsg = WM_MOUSEMOVE or iMsg = WM_LBUTTONDOWN or iMsg = WM_RBUTTONDOWN or iMsg = WM_LBUTTONUP or iMsg = WM_RBUTTONUP or iMsg = WM_LBUTTONDBLCLK or iMsg = WM_RBUTTONDBLCLK then -- NEW! 0.44b -- need to set the mouse cursor? if window_cursor[id] then -- set to the requested style ok = c_func( xSetCursor, {window_cursor[id]} ) end if -- parse points x = shortInt( lo_word( lParam ) ) y = shortInt( hi_word( lParam ) ) -- NEW! 0.45b tooltip disarmed on mouse events other than moving -- mouse move? if iMsg = WM_MOUSEMOVE then -- NEW! 0.45f added supression logic -- remove suppress flag? if not tooltipShow then -- has the mouse *really* moved? if x != tooltipMouseX or y != tooltipMouseY then -- allow tooltip to be redisplayed tooltipShow = True end if end if -- control currently showing tooltip? if tooltipState = TooltipShown and tooltipControl = id then -- do nothing else -- arm tooltip, if any armTooltip( id, x, y ) end if elsif tooltipState = TooltipShown then -- NEW! 0.45f suppress redisplay -- disarm the tooltip deactivateTooltip() -- new position of mouse tooltipMouseX = x tooltipMouseY = y -- don't redisplay unless mouse moves tooltipShow = False end if -- NEW! 0.41a only traps right button clicks, not all mouse events. -- trap right button clicks if iMsg = WM_RBUTTONDOWN and onMouse[ id ] != -1 then -- NEW! 0.41a passes 3 parameters instead of 2 -- NEW! 0.42 passes 4 parameters instead of 3 -- send the mouse position call_proc( onMouse[ id ], {iMsg, x, y, getKeyMasks() } ) -- NEW! 0.41 uses popId instead of 0 return popSelf() end if -- NEW! 0.45l added to support TabControl -- NEW! 0.45m only handles if reciever is direct parent of control elsif iMsg = WM_COMMAND and getId( lParam ) != 0 and window_owner[ getId( lParam ) ] = id then -- notification from control pushSelf( wmCommand( hWnd, iMsg, wParam, lParam ) ) -- NEW! 0.45m added for supporting scrollbars in tab controls elsif (iMsg = WM_VSCROLL or iMsg = WM_HSCROLL) and getId( lParam ) != 0 and window_owner[ getId( lParam ) ] = id then -- scroll handling code wmScroll( hWnd, wParam, lParam ) -- NEW! 0.45m added to support controls in tab controls elsif iMsg = WM_CTLCOLORBTN or iMsg = WM_CTLCOLORSTATIC then -- system is about to draw the colors for a control. -- this intercepts the command, and returns the brush we want -- wParam contains the device context of the control -- set text background color to the window background color parent = window_owner[ id ] if c_func(xSetBkColor, { wParam, window_bcolor[parent]} ) = CLR_INVALID then warnErr( "SetBkColor in wndProc failed." ) end if -- NEW! 0.45o replaced window_handle with getHandle -- get the parent's background color brush return c_func( xGetClassLong, {getHandle(parent), GCL_HBRBACKGROUND} ) end if -- NEW! 0.41 result = popSelf() if result = 0 then -- run behavior return c_func( xCallWindowProc, { window_func[id], hWnd, iMsg, wParam, lParam } ) else -- return user's value return result end if end function ----------------------------------------------------------------------------- -- store routine id procedure get_proc_address() atom id -- set WndProcAddress callback id = routine_id("WndProc") if id = -1 then abortErr( "routine_id for WndProc failed!\n") end if WndProcAddress = call_back( id ) -- get 32-bit address for callback -- NEW! 0.45l -- set SubProcAddress callback id = routine_id("SubProc") if id = -1 then abortErr( "routine_id for SubProc failed!\n") end if SubProcAddress = call_back( id ) -- get 32-bit address for callback end procedure -- NEW! 0.30 -- added style flag ----------------------------------------------------------------------------- --/topic Attributes --/proc openWindow( window, style ) --/desc Opens a window. -- The /i style flag is one of the following: -- -- /li /b Normal: Original size. -- /li /b Minimize: Minimized into the task bar. -- /li /b Maximize: Fills screen. -- /li /b Modal: Original size, but no other application window can get -- focus until this window is closed. Use to emulate modal -- dialogs. -- /li Win32 Flag: For example, /b SW_SHOWMINNOACTIVE. -- -- The openWindow function will trigger an /onOpen event. -- global procedure openWindow( integer id, integer style ) atom hWnd, styleFlag -- NEW! 0.45o replaced window_handle with getHandle -- get the handle hWnd = getHandle( id ) -- NEW! 0.45l replaced logic, allow using native flags -- convert the style to a Win32 flag if style > 0 then -- real flag styleFlag = style else -- Normal or Modal styleFlag = SW_SHOWNORMAL end if -- set the text and background colors setTextColor( id, getSysColor( COLOR_WINDOWTEXT ) ) setBackColor( id, getSysColor( COLOR_WINDOW ) ) -- action? if onOpen[ id ] != -1 then call_proc( onOpen[ id ], {} ) end if -- need to show menubar? if window_menu[ id ] then ok = c_func( xDrawMenuBar, {hWnd} ) end if -- NEW! 0.45g -- displaying any tab controls? for i = 1 to length( window_owner ) do if window_owner[ i ] = id -- control owned by window and window_type[ i ] = TabControl -- is a tab control and length( window_tabitems[i] ) then -- contains tabs -- activate the first tab's items activateTabItems( window_tabitems[i][1] ) end if end for -- display the window ok = c_func( xShowWindow, { hWnd, styleFlag } ) -- update the window c_proc( xUpdateWindow, { hWnd } ) -- set focus c_proc( xSetFocus, {hWnd} ) -- NEW! 0.30 -- replaces openModal if style = Modal then pushModal( id ) end if end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc WinMain( window, style ) --/desc Run event loop. -- This is the main processing loop for Win32Lib. Call WinMain after -- all the controls have been declared to run the event loop. -- -- The main window is set to /i window. When /i window is closed, -- the application is shut down. -- -- The /i style flag is one of the following: -- -- /li /b Normal: Original size. -- /li /b Minimize: Minimized into the task bar. -- /li /b Maximize: Fills screen. -- /li /b Modal: Original size, but no other application window can get -- focus until this window is closed. Use to emulate modal -- dialogs. -- -- The WinMain function will trigger an /onOpen event. -- -- For example: --/code -- -- set TheWindow as main window, open normally -- /WinMain( MyWindow, Normal ) --/endcode global procedure WinMain( integer id, integer style ) -- main routine atom hWnd atom msg -- allocate a message buffer msg = allocate_struct(SIZEOF_MESSAGE) -- create the default window mainWindow = id openWindow( id, style ) -- message loop while c_func( xGetMessage, { msg, NULL, 0, 0 } ) do c_proc( xTranslateMessage, { msg } ) c_proc( xDispatchMessage, { msg } ) end while -- release all resources releaseAllResources() end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc setFocus( id ) --/desc Set the focus to the specified window or control. -- This will cause the window or control that currently has focus -- to lose it. -- -- The window or control losing focus will get an /onLostFocus event, -- and the window or control that is getting focus will get an /onGotFocus -- event. global procedure setFocus( integer id ) -- NEW! 0.45o replaced window_handle with getHandle -- set the focus c_proc( xSetFocus, {getHandle(id)} ) end procedure ----------------------------------------------------------------------------- --/topic Attributes --/proc setHint( control, text ) --/desc Set the tooltip text for a control. -- If the mouse stays still over a control that has tooltip text -- associated with it, a small window displaying the tooltip text will -- appear. -- -- Any control that can get mouse events can have tooltips associated with -- it, although it tends to work best with /PictureButtons, typically -- in the /ToolBar. -- -- Setting the text to "" effectively removes the tooltip. -- -- Example: --/code -- -- set hint for CloseButton -- /setHint( CloseButton, "Closes the window" ) --/endcode -- NEW! 0.41 global procedure setHint( integer id, sequence text ) -- emulated tooltip window_tooltip[id] = text end procedure ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- NEW! 0.42 XPM support routines built in integer xpmErrFlag -- on error, sets code global constant XPM_OK = 0, -- no error XPM_ERR_FILE = -1, -- file related error XPM_ERR_COLORS = -2, -- too many colors in bitmap XPM_ERR_HEADER = -3, -- error in XPM header XPM_ERR_COLOR = -4 -- couldn't translate color code constant XPM_CODES = " .+@#$%&*=-;>,')!~{]^/(_:<[}|1234567890" & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" ----------------------------------------------------------------------------- function colorToTuple( atom a ) -- convert color atom back into component parts -- this is passed to the XPM for the 'transparent' color atom r,g,b r = and_bits( a, #FF ) a = floor( a/#100 ) g = and_bits( a, #FF ) b = floor( a/#100 ) return {r,g,b} end function sequence transTuple ------------------------------------------------------------------------------ --/topic XPM --/proc setTransparentColor( color ) --/desc Defines what the transparent color is to be. The parameter can -- be an rgb atom, or a sequence in the form {r,g,b}. -- -- The default color is {255,0,255} (a light pink). -- -- For routines that create XPMs, this means that the color specified -- in the XPM as /i None are rendered using this color. -- -- The /transBlt routine uses this value to determine what color /i not -- to render on the destination. -- -- This routine can also be used to make the transparent color of XPMs -- match the system color of buttons. This is useful for /PictureButtons. -- --/code -- -- set transparent colors to match button face color -- setTransparentColor( /getSysColor( COLOR_BTNFACE ) ) --/endcode -- NEW! 0.43 allow sequence as parameter global procedure setTransparentColor( object color ) if sequence( color ) then -- convert to color and save transColor = rgb( color[1], color[2], color[3] ) -- save tuple transTuple = color else -- convert to tuple and save transTuple = colorToTuple( color ) -- set the transparency color transColor = color end if end procedure -- set default color setTransparentColor( rgb(255,0,255) ) -- NEW! 0.42 ------------------------------------------------------------------------------ --/topic XPM --/func createXpm( filename, euphoria bitmap ) --/desc Creates an XPM file from a Euphoria bitmap. --/ret Status code. -- Status codes: -- -- /li /b XPM_OK. File created successfully -- /li /b XPM_ERR_FILE: File related error -- /li /b XPM_ERR_COLORS: Too many colors in bitmap global function createXpm( sequence outFile, sequence euBmp ) -- create an XPM file from a euphoria bitmap integer handle, -- out file handle index, -- convenience counter colors, -- count of colors used in XMP charsWide, -- chars wide of encoding at -- index sequence bmp, -- bitmap portion of data pal, -- pal portion of data code, -- reassignment of codes to palette indexes encode -- encoding of color codes -- get values pal = euBmp[1] bmp = euBmp[2] -- build a set of 'used' flags for the palette code = repeat( 0, length( pal ) ) -- scan through the bitmap, and colors = 0 for i = 1 to length( bmp ) do for j = 1 to length( bmp[i] ) do -- get palette index index = bmp[i][j]+1 -- already assigned an index? if not code[ index ] then -- increment index count colors = colors + 1 -- assign an index code[ index ] = colors end if end for end for -- need 1 or 2 byte codes? if colors > length( XPM_CODES ) then -- need to construct 2 byte codes charsWide = 2 -- initialize sequence encode = repeat( 0, colors ) -- index at = 1 for i = 1 to length( XPM_CODES ) do for j = 2 to length( XPM_CODES ) do -- build a two byte code encode[at] = XPM_CODES[i] & XPM_CODES[j] -- increment at += 1 -- filled? if at > colors then -- leave inner loop exit end if end for -- filled? if at > colors then -- leave outer loop exit end if end for else -- 1 byte coding charsWide = 1 -- list of codes is subset of encode = XPM_CODES[1..colors] end if -- open the file handle = open( outFile, "w" ) if handle = -1 then -- error opening file return XPM_ERR_FILE end if -- header puts( handle, "/* XPM */\n" ) puts( handle, "static char * xpm[] = {\n" ) -- values: width, height, colors, code width printf( handle, "\"%d %d %d %d\",\n", {length(bmp[1]), length(bmp), colors, charsWide} ) -- the color tuples for i = 1 to length( code ) do -- color used? if code[i] then -- create an entry printf( handle, "\"%s c #%02x%02x%02x\",\n", {encode[code[i]]} & pal[i] ) end if end for -- build the xmp data for i = 1 to length( bmp ) do -- " puts( handle, "\"" ) for j = 1 to length( bmp[i] ) do -- get palette index index = bmp[i][j]+1 -- write the code out puts( handle, encode[ code[index] ] ) end for -- end of line if i = length( bmp ) then -- "}; puts( handle, "\"};\n" ) else -- ", puts( handle, "\",\n" ) end if end for -- close the file close( handle ) -- return success return XPM_OK end function ------------------------------------------------------------------------------ --/topic XPM --/func createXpmFromBmpFile( filename, euphoria bitmap ) --/desc Creates an XPM file from a bitmap file. --/ret Status code. -- Status codes: -- -- /li /b XPM_OK. File created successfully -- /li /b XPM_ERR_FILE: File related error -- /li /b XPM_ERR_COLORS: Too many colors in bitmap -- NEW! 0.43 renamed global function createXpmFromBmpFile( sequence inFile, sequence outFile ) -- create an XPM file from a bitmap file object bmp -- read the bitmap in bmp = read_bitmap( inFile ) if integer( bmp ) then -- file error return XPM_ERR_FILE end if -- convert to xpm return createXpm( outFile, bmp ) end function ------------------------------------------------------------------------------ function convertToWords( sequence s ) -- convert s into space delimited words sequence word, words words = {} word = "" s = s & " " for i = 1 to length( s ) do if s[i] = ' ' then if length( word ) then words = append( words, word ) word = "" end if else word = word & s[i] end if end for return words end function -- NEW! 0.42 ------------------------------------------------------------------------------ function xpmConvertToNumber( sequence s ) -- convert a string to a number -- this should only return positive numbers, -- -1 indicates error s = value( s ) if s[1] != GET_SUCCESS then -- flag error xpmErrFlag = 1 end if return s[2] end function ------------------------------------------------------------------------------ function xpmConvertToRGB( sequence s ) -- convert a color code string into an {r,g,b} tuple integer r,g,b if s[1] = '#' then -- hex tuple: #rrggbb -- upper case s = upper( s ) r = xpmConvertToNumber( s[1..3] ) g = xpmConvertToNumber( "#" & s[4..5] ) b = xpmConvertToNumber( "#" & s[6..7] ) -- return tuple return {r,g,b} elsif equal( s, "None" ) then -- set color to clear return transTuple end if -- unable to convert color xpmErrFlag = 1 return {0,0,0} end function -- NEW! 0.42 added for XPM support -- NEW! 0.43 renamed ------------------------------------------------------------------------------ --/topic XPM --/func xpmToEuBmp( xpm ) --/desc Convert XPM data into a standard Euphoria bitmap. --/ret A Euphoria bitmap in a sequence. On failure, an error code. -- The error codes are: -- -- /li /b XPM_ERR_COLORS: Too many colors in bitmap -- /li /b XPM_ERR_HEADER: Error in XPM header -- /li /b XPM_ERR_COLOR: Couldn't translate color code global function xpmToEuBmp( sequence xpm ) integer line, -- current line in file at, -- used to find positions in strings bitsWide, -- width of the xpm bitsTall, -- height of the xpm colors, -- colors in the xpm codeWide -- width of the color code sequence colorCode, -- text of color code colorRGB, -- palette of tuples bits -- bits of image object data -- generic bucket -- clear error flag xpmErrFlag = 0 -- extract the values: " " data = convertToWords( xpm[1] ) bitsWide = xpmConvertToNumber( data[1] ) bitsTall = xpmConvertToNumber( data[2] ) colors = xpmConvertToNumber( data[3] ) codeWide = xpmConvertToNumber( data[4] ) -- error? if xpmErrFlag then -- error in header return XPM_ERR_HEADER end if -- create a palatte and data colorCode = repeat( "", colors ) colorRGB = repeat( {}, colors ) -- start of data line = 2 -- read the color data for i = 1 to colors do -- extract the color code colorCode[i] = xpm[line][1..codeWide] -- get a line data = xpm[line] -- seek to the color data = data[3..length(data)] at = match( "c ", data ) if at = 0 then -- badly formed color definition return XPM_ERR_COLOR end if -- extract the color code data = data[at+2..length(data)] -- convert to an {r,g,b} code colorRGB[i] = xpmConvertToRGB( data ) -- increment line line += 1 end for -- check condition if xpmErrFlag then -- error in call to colorRGB return XPM_ERR_COLOR end if -- create data area bits = repeat( repeat( 0, bitsWide ), bitsTall ) -- convert the text into indexes for i = 1 to bitsTall do -- get a line data = xpm[line] -- convert to lookup at = 0 for j = 1 to length( data ) by codeWide do -- move 1 pixel at a time at += 1 -- find the position, subtract to make base zero bits[i][at] = find( data[j..j+codeWide-1], colorCode ) - 1 end for -- read the next line line += 1 end for return { colorRGB, bits } end function -- NEW! 0.42 added for XPM support ------------------------------------------------------------------------------ global function readXpm( sequence fName ) -- read a file into a sequence -- removes line feeds integer handle, at sequence file object data file = {} -- open the file handle = open( fName, "r" ) if handle = -1 then -- error opening file return XPM_ERR_FILE end if -- check header data = gets( handle ) if not match( "/* XPM */", data ) then return XPM_ERR_HEADER end if -- read to eof while 1 do -- read a line data = gets( handle ) -- eof? if integer( data ) then exit end if -- remove line feed, if any if data[length(data)] = '\n' then data = data[1..length(data)-1] end if -- blank line? if length( data ) = 0 then -- ignore -- not quoted? elsif data[1] != '"' then -- ignore else -- first quote at = find( '"', data ) data = data[at+1..length(data)] -- last quote at = find( '"', data ) data = data[1..at-1] -- add to file file = append( file, data ) end if end while -- close the file close( handle ) -- NEW! 0.43 function renamed -- reads an XPM from disk, returns bitmap return xpmToEuBmp( file ) end function -- NEW! 0.42 added built-in xpm support ----------------------------------------------------------------------------- ------------------------------------------------------------------------------ --/topic XPM --/func xpmToPixmap( xpm ) --/desc Create a /Pixmap from XPM data. -- --/ret A Euphoria bitmap, or an error code. -- The error codes are: -- -- /li /b XPM_ERR_COLORS: Too many colors in bitmap -- /li /b XPM_ERR_HEADER: Error in XPM header -- /li /b XPM_ERR_COLOR: Couldn't translate color code global function xpmToPixmap( sequence xpm ) -- convert xpm to bmp, and then to dib atom pixmap sequence bmp -- NEW! 0.43 function renamed -- convert xpm to bmp using the TransRGB for the transparent color bmp = xpmToEuBmp( xpm ) -- create an empty pixmap pixmap = create( Pixmap, "", 0, 0, 0, 0, 0, 0 ) -- create a dib, and assign it to the pixmap setPixmap( pixmap, createDIB( bmp ) ) return pixmap end function -- NEW! 0.44b ----------------------------------------------------------------------------- ------------------------------------------------------------------------------ --/topic Utilities --/proc shellExecute( command, file, style ) --/desc Launch a Windows application -- -- This is a wrapper around the Win32 /b ShellExecute command. global procedure shellExecute( sequence cmd, sequence file, atom style ) -- call ShellExecute to display a file atom result, file_string, cmd_string -- convert to strings file_string = allocate_string( file ) cmd_string = allocate_string( cmd ) -- call ShellExecute result = c_func( xShellExecute, { getHandle( mainWindow ), cmd_string, file_string, 0, 0, style } ) -- free the strings free( cmd_string ) free( file_string ) end procedure -- NEW! 0.44d changed to a function ----------------------------------------------------------------------------- ------------------------------------------------------------------------------ --/topic Utilities --/func playSound( wave file ) --/desc Play the .WAV file. --/ret /b True if succeeds, /b False if fails. -- -- This is a wrapper around the Win32 /b PlaySound command. global function playSound( sequence fileName ) -- call ShellExecute to display a file atom result, file_string -- convert to strings file_string = allocate_string( fileName ) -- play the sound result = c_func( xPlaySound, {file_string, NULL, or_bits(SND_FILENAME, SND_ASYNC)}) -- free the string free( file_string ) -- return result return result end function ----------------------------------------------------------------------------- -- NEW! 0.41 procedure initialize() -- various housekeeping tasks atom szAppName -- allocate storage for the screen and printer Screen = create( Screen_, "", 0, 0, 0, 0, 0, 0 ) Printer = create( Printer_, "", 0, 0, 0, 0, 0, 0 ) -- get the proc address get_proc_address() -- set the 'clean up' behavior xCleanUp = routine_id("releaseAllResources") end procedure initialize() -- This file (unless modified) is FREE - 0 statements. with 7702576232 -- delete this statement if it causes an error