From: Simon Armstrong Date: Thu, 2 Feb 2017 03:28:25 +0000 (+1300) Subject: separated dpimanifest from xpmanifest for backwards compatability X-Git-Url: https://jcornell.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7ade418355ca5c949b647a9b31c36c6ff8066f9;p=blitzmax.git separated dpimanifest from xpmanifest for backwards compatability --- diff --git a/.gitignore b/.gitignore index fdfb563..4ad413a 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ !mod/brl.mod/blitz.mod/blitz_ex.*.s !mod/brl.mod/blitz.mod/blitz_ftoi.*.s !mod/brl.mod/blitz.mod/blitz_gc.*.s +*.bak diff --git a/mod/maxgui.mod/dpimanifest.mod/dpimanifest.bmx b/mod/maxgui.mod/dpimanifest.mod/dpimanifest.bmx new file mode 100644 index 0000000..75b7113 --- /dev/null +++ b/mod/maxgui.mod/dpimanifest.mod/dpimanifest.bmx @@ -0,0 +1,18 @@ +Rem +bbdoc: MaxGUI Manifest File for DPI-aware Windows 10 systems +End Rem +Module MaxGUI.DPIManifest + +ModuleInfo "Version: 0.01" +ModuleInfo "Author: Simon Armstrong" +ModuleInfo "License: zlib/libpng" + +ModuleInfo "History: 0.01 Release" + +Strict + +?Win32 + +Import "dpimanifest.o" + +? diff --git a/mod/maxgui.mod/dpimanifest.mod/dpimanifest.o b/mod/maxgui.mod/dpimanifest.mod/dpimanifest.o new file mode 100644 index 0000000..6fa7250 Binary files /dev/null and b/mod/maxgui.mod/dpimanifest.mod/dpimanifest.o differ diff --git a/mod/maxgui.mod/dpimanifest.mod/resources/compile.cmd b/mod/maxgui.mod/dpimanifest.mod/resources/compile.cmd new file mode 100644 index 0000000..98cf258 --- /dev/null +++ b/mod/maxgui.mod/dpimanifest.mod/resources/compile.cmd @@ -0,0 +1,2 @@ +@echo off +windres -o ../dpimanifest.o dpi.rc \ No newline at end of file diff --git a/mod/maxgui.mod/dpimanifest.mod/resources/dpi.manifest b/mod/maxgui.mod/dpimanifest.mod/resources/dpi.manifest new file mode 100644 index 0000000..b5d1094 --- /dev/null +++ b/mod/maxgui.mod/dpimanifest.mod/resources/dpi.manifest @@ -0,0 +1,25 @@ + + + + + true + + + + MaxGUI + + + + + + diff --git a/mod/maxgui.mod/dpimanifest.mod/resources/dpi.rc b/mod/maxgui.mod/dpimanifest.mod/resources/dpi.rc new file mode 100644 index 0000000..99afd1b --- /dev/null +++ b/mod/maxgui.mod/dpimanifest.mod/resources/dpi.rc @@ -0,0 +1,4 @@ +#define RT_MANIFEST 24 +#define MANIFEST_ID 1 + +MANIFEST_ID RT_MANIFEST "dpi.manifest" diff --git a/mod/maxgui.mod/win32maxguiex.mod/win32maxguiex.bmx b/mod/maxgui.mod/win32maxguiex.mod/win32maxguiex.bmx index 4e3f8fe..3d7d9c6 100644 --- a/mod/maxgui.mod/win32maxguiex.mod/win32maxguiex.bmx +++ b/mod/maxgui.mod/win32maxguiex.mod/win32maxguiex.bmx @@ -1,5053 +1,5056 @@ -Rem -bbdoc: MaxGUI Drivers/Win32MaxGUIEx -End Rem -Module MaxGUI.Win32MaxGUIEx - -ModuleInfo "Version: 0.75" -ModuleInfo "Author: Simon Armstrong, Seb Hollington" -ModuleInfo "License: zlib/libpng" - -Strict - -?Win32 -Import MaxGUI.MaxGUI -Import "winimports.bmx" - -' Import "xpmanifest.o" - -maxgui_driver = New TWindowsGUIDriver - -Type TWindowsGUIDriver Extends TMaxGUIDriver - - Global GadgetMap:TMap - Global GDIDesktop:TWindowsDesktop - Global GDIFont:TWindowsFont - Global ClassAtom - Global ClassAtom2 - Global KBMessageHook,MouseMessageHook - - Global windowtheme:Short Ptr - Global _cursor, _commoncontrolversion[] - Global _explorerstyle = False - Global _activeWindow:TWindowsWindow = Null - - Global _customcolors[] = [$FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, .. - $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF ] - - Global _hwndTooltips% - - Global intDontReleaseCapture% = False 'See WM_CAPTURECHANGED - - Method New() - - 'Initialize libraries - OleInitialize(Null) - Local icc:TINITCOMMONCONTROLSEX = New TINITCOMMONCONTROLSEX - icc.dwSize = SizeOf(icc) - icc.dwICC = ICC_WIN95_CLASSES|ICC_USEREX_CLASSES'|ICC_COOL_CLASSES'|ICC_DATE_CLASSES - InitCommonControlsEx icc - - 'Initialize Global Variables - GDIFont=TWindowsFont.DefaultFont() - GadgetMap=New TMap - GDIDesktop=New TWindowsDesktop - - 'Set-up Message Hooks - KBMessageHook=SetWindowsHookExW(WH_KEYBOARD,KeyboardProc,GetModuleHandleW(Null),GetCurrentThreadId()) - MouseMessageHook=SetWindowsHookExW(WH_MOUSE,MouseProc,GetModuleHandleW(Null),GetCurrentThreadId()) - - 'Gadget Tooltips - _hwndTooltips = CreateWindowExW( 0,"tooltips_class32","",WS_POPUP|TTS_ALWAYSTIP,0,0,0,0,GDIDesktop._hwnd,0,GetModuleHandleW(Null),Null ) - SendMessageW( _hwndTooltips, TTM_SETMAXTIPWIDTH, 0, 300 ) - SetWindowPos( _hwndTooltips, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE ) - - EndMethod - - Method Delete() - DestroyWindow( _hwndTooltips );_hwndTooltips = 0 - UnhookWindowsHookEx MouseMessageHook - UnhookWindowsHookEx KBMessageHook - EndMethod - - Method UserName$() - Return getenv_("username") - End Method - - Method ComputerName$() - Return getenv_("userdomain") - End Method - - 'Low-level Win32 interface - - Function RegisterHwnd(hwnd,gadget:TWindowsGadget) - GadgetMap.Insert TIntWrapper.Create(hwnd),gadget - EndFunction - - Function RemoveHwnd(hwnd) - GadgetMap.Remove TIntWrapper.Create(hwnd) - EndFunction - - Function GadgetFromHwnd:TWindowsGadget(hwnd) nodebug - Return TWindowsGadget(GadgetMap.ValueForKey(TIntWrapper.Create(hwnd))) - EndFunction - - Function ClassWndProc(hwnd,msg,wp,lp) "win32" - Local owner:TWindowsGadget - Local res - Local nmhdr:Int Ptr - - '?Debug And Win32 - 'Print TWindowsDebug.ReverseLookupMsg(msg) + ", hwnd: " + hwnd + ", wp: " + wp + ", lp: " + lp - '?Win32 - - Select msg - - Case WM_MENUCHAR - - If HotKeyEventFromWp(wp & $FF) Then - Return (MNC_CLOSE Shl 16) - Else - Return (MNC_IGNORE Shl 16) - EndIf - - Case WM_SIZE - - owner = GadgetFromHwnd(hwnd) - If owner And Not TWindowsWindow(owner) Then - If hwnd = owner.Query(QUERY_HWND) Then owner.RethinkClient() - If hwnd = owner.Query(QUERY_HWND_CLIENT) Then owner.LayoutKids() - EndIf - - Case WM_CTLCOLORSTATIC, WM_CTLCOLOREDIT, WM_CTLCOLORBTN - - owner=GadgetFromHwnd(lp) - - Select True - - Case TWindowsLabel(owner) <> Null - - SetBkMode(wp, TRANSPARENT) - If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) - Return owner.CreateControlBrush( owner._hwnd, wp ) - - Case TWindowsPanel(owner) <> Null - - If TWindowsPanel(owner)._type = TWindowsPanel.PANELGROUP Then - - SetBkMode(wp, TRANSPARENT) - If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) - Return owner.CreateControlBrush( lp, wp ) - - EndIf - - Case TWindowsTextField(owner) <> Null, TWindowsComboBox(owner) <> Null - - If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) - If owner.BgBrush() Then SetBkColor(wp, owner.BgColor());Return owner.BgBrush() - - Case TWindowsButton(owner) <> Null, TWindowsSlider(owner) <> Null - - SetBkMode(wp, TRANSPARENT) - If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) - Return owner.CreateControlBrush( owner._hwnd, wp ) - - EndSelect - - owner = Null - - Case WM_COMMAND,WM_HSCROLL,WM_VSCROLL - If lp Then - owner=GadgetFromHwnd(lp) - 'Fix for tab control's up/down arrow. - If Not owner Then owner = GadgetFromHwnd(GetParent_(lp)) - Else - owner=GadgetFromHwnd(hwnd) 'Fixed for menu events - EndIf - - If Not owner Then owner = GadgetFromHwnd(hwnd) - - If owner Then - res=owner.OnCommand(msg,wp) - If Not res And owner._proc And owner._hwnd = hwnd Return CallWindowProcW(owner._proc,hwnd,msg,wp,lp) - Return res - Else - Return DefWindowProcW( hwnd,msg,wp,lp ) - EndIf - - Case WM_NOTIFY - - 'Gadget tooltips - nmhdr=Int Ptr(lp) - owner=GadgetFromHwnd(nmhdr[0]) - If owner Then - Select nmhdr[2] - Case TTN_GETDISPINFOW - If owner._wstrTooltip Then nmhdr[3] = Int(owner._wstrTooltip) - EndSelect - Return owner.OnNotify(wp,lp) - EndIf - - Case WM_SETCURSOR - - If _cursor Then - SetCursor(_cursor) - Return 1 - EndIf - - Case WM_ACTIVATEAPP, WM_ACTIVATE - - SystemEmitOSEvent(hwnd,msg,wp,lp,Null) - - Case WM_DRAWITEM - - Local tmpDrawItemStruct:DRAWITEMSTRUCT = New DRAWITEMSTRUCT - MemCopy tmpDrawItemStruct, Byte Ptr lp, SizeOf(tmpDrawItemStruct) - - owner = GadgetFromHwnd(tmpDrawItemStruct.hwndItem) - If owner And owner.OnDrawItem( tmpDrawItemStruct ) Then Return True - - owner = Null - - 'Allow BRL.System to handle mouse/key events on sensitive gadgets. - - Case WM_CAPTURECHANGED - - 'For preventing problem where controls which called SetCapture() internally - 'had their capture prematurely released by the ReleaseCapture() call in BRL.System. - intDontReleaseCapture = False - 'If SetCapture() is called again after BRL.System's call (when the new - 'capture hwnd [lp] = old hwnd [hwnd]) then we dont want to call ReleaseCapture() in BRL.System - 'when WM_MOUSEBUTTONUP is received by the system hook TWindowsGUIDriver.MouseProc(). - If (lp = hwnd) And (Not intEmitOSEvent) Then intDontReleaseCapture = True - - Default - - 'Added preliminary check to avoid searching for a gadget in GadgetMap un-necessarily. - If (msg = WM_MOUSEWHEEL) Or (msg = WM_MOUSELEAVE) Or (msg>=WM_KEYFIRST And msg<=WM_KEYLAST) Then - owner=GadgetFromHwnd(hwnd) - If owner Then - Select msg - Case WM_MOUSELEAVE, WM_MOUSEWHEEL - If (owner.sensitivity&SENSITIZE_MOUSE) Then SystemEmitOSEvent hwnd,msg,wp,lp,owner - Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP, WM_CHAR, WM_SYSCHAR - If (owner.sensitivity&SENSITIZE_KEYS) And Not GadgetDisabled(owner) Then - SystemEmitOSEvent hwnd,msg,wp,lp,owner - EndIf - If (msg<>WM_CHAR And msg<>WM_SYSCHAR) And HotKeyEventFromWp(wp) Then Return 1 - EndSelect - EndIf - EndIf - - EndSelect - - If Not owner Then owner=GadgetFromHwnd(hwnd) - If owner Return owner.WndProc(hwnd,msg,wp,lp) - - Return DefWindowProcW( hwnd,msg,wp,lp ) - - EndFunction - - Function KeyboardProc( code,wparam,lparam ) "win32" nodebug - Local ev:TEvent, hwnd%, tmpClassName:Short[16], mods:Int, key:Int = wparam - If code>=0 Then - 'Removed: http://www.blitzbasic.com/Community/posts.php?topic=72737 -' Rem - If wparam = $D Then '$D: VK_RETURN - hwnd = GetFocus() - If hwnd And GetClassNameW(hwnd,tmpClassName,tmpClassName.length) And String.FromWString(tmpClassName).ToUpper() = "EDIT" Then - SetFocus(GetParent_(hwnd)) - EndIf - EndIf -' EndRem - - ev = HotkeyEventFromWp(wparam) - If ev - 'Hot-key events shouldn't be emitted if the source gadget is disabled - If Not(TGadget(ev.source) And GadgetDisabled(TGadget(ev.source))) Then - If Not (lparam & $80000000) Then - EmitEvent ev - If ev.mods Then Return 1 'Key press events never reach active panels etc. if we return 1 - EndIf - EndIf - EndIf - EndIf - Return CallNextHookEx( KBMessageHook,code,wparam,lparam ); - EndFunction - - Function HotkeyEventFromWp:TEvent(wparam) - Local key = wparam, mods = KeyMods() - Select wparam - Case VK_SHIFT, $A0, $A1 - If (wparam=VK_SHIFT) Then key = KEY_LSHIFT - mods:&~MODIFIER_SHIFT - Case VK_CONTROL, $A2, $A3 - If (wparam=VK_CONTROL) Then key = KEY_LCONTROL - mods:&~MODIFIER_CONTROL - Case VK_MENU, $A4, $A5 - If (wparam=VK_MENU) Then key = KEY_LALT - mods:&~MODIFIER_ALT - Case VK_LWIN, VK_RWIN - mods:&~MODIFIER_SYSTEM - EndSelect - Return HotKeyEvent( key,mods,GetForegroundWindow() ) - EndFunction - - Global intButtonStates%[3] - - Function MouseProc( code,wparam,lparam ) "win32" nodebug - - If code>=0 And wparam >= WM_MOUSEFIRST And wparam <= WM_MOUSELAST Then 'Not needed as MouseProc only receives mouse messages!!! - - Local MOUSEHOOKSTRUCT:Int Ptr = Int Ptr(lparam), wp, lp, data - Local hwnd% = MOUSEHOOKSTRUCT[2], msg% = wparam, owner:TWindowsGadget - Local point:Int[] = [MOUSEHOOKSTRUCT[0],MOUSEHOOKSTRUCT[1]] - - Select msg - Case WM_LBUTTONDOWN, WM_LBUTTONDBLCLK - data = MOUSE_LEFT - msg = WM_LBUTTONDOWN - intButtonStates[MOUSE_LEFT] = True - Case WM_LBUTTONUP - data = MOUSE_LEFT - intButtonStates[MOUSE_LEFT] = False - Case WM_RBUTTONDOWN, WM_RBUTTONDBLCLK - data = MOUSE_RIGHT - msg = WM_RBUTTONDOWN - intButtonStates[MOUSE_RIGHT] = True - Case WM_RBUTTONUP - data = MOUSE_RIGHT - intButtonStates[MOUSE_RIGHT] = False - Case WM_MBUTTONDOWN, WM_MBUTTONDBLCLK - data = MOUSE_MIDDLE - msg = WM_MBUTTONDOWN - intButtonStates[MOUSE_MIDDLE] = True - Case WM_MBUTTONUP - data = MOUSE_MIDDLE - intButtonStates[MOUSE_MIDDLE] = False - EndSelect - - owner = GadgetFromHwnd(hwnd) - If owner And ScreenToClient( hwnd, point ) Then - - If data And (Not intButtonStates[data]) And TGadget.dragGadget[data-1] Then - PostGuiEvent EVENT_GADGETDROP, owner, data, KeyMods(), point[0], point[1], TGadget.dragGadget[data-1] - TGadget.dragGadget[data-1] = Null - EndIf - - If (owner.sensitivity&SENSITIZE_MOUSE) Then - - 'Fake wp parameter to pass onto bbSystemEmitOSEvent - If intButtonStates[MOUSE_LEFT] Then wp:|MK_LBUTTON - If intButtonStates[MOUSE_MIDDLE] Then wp:|MK_MBUTTON - If intButtonStates[MOUSE_RIGHT] Then wp:|MK_RBUTTON - If GetKeyState(VK_SHIFT)&$8000 Then wp:|MK_SHIFT - If GetKeyState(VK_CONTROL)&$8000 Then wp:|MK_CONTROL - - lp = (Short(point[1]) Shl 16) | Short(point[0]) - 'Sort and determine whether to emit the event - Select msg - Case WM_MOUSEMOVE - If (owner._oldcursorlp<>lp) Then - owner._oldcursorlp=lp - SystemEmitOSEvent hwnd,msg,wp,lp,owner - EndIf - Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP - If intDontReleaseCapture Then - PostGuiEvent EVENT_MOUSEUP, owner, data - Else - SystemEmitOSEvent hwnd,msg,wp,lp,owner - EndIf - Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN - SystemEmitOSEvent hwnd,msg,wp,lp,owner - EndSelect - - EndIf - EndIf - EndIf - Return CallNextHookEx( MouseMessageHook,code,wparam,lparam ) - EndFunction - - Global intEmitOSEvent - - Function SystemEmitOSEvent( hwnd, msg, wp, lp, owner:TGadget ) - intEmitOSEvent:+1 - If owner Then - While owner.source - owner = owner.source - Wend - EndIf - Local tmpResult% = bbSystemEmitOSEvent( hwnd, msg, wp, lp, owner ) - intEmitOSEvent:-1 - Return tmpResult - EndFunction - - Function ClassName$() - Global _name$ - Global _wc:WNDCLASSW - Global _icon - - If Not _name - _name="BLITZMAX_WINDOW_CLASS" - _icon=LoadIconW(GetModuleHandleW(Null),Short Ptr(101)) - _wc=New WNDCLASSW - _wc.style=CS_OWNDC|CS_HREDRAW|CS_VREDRAW - _wc.lpfnWndProc=ClassWndProc - _wc.hInstance=GetModuleHandleW(Null) - _wc.hIcon=_icon - _wc.hCursor=LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) - _wc.hbrBackground=COLOR_BTNSHADOW - _wc.lpszMenuName=Null - _wc.lpszClassName=_name.ToWString() - _wc.cbWndExtra=DLGWINDOWEXTRA - ClassAtom=RegisterClassW(_wc) - EndIf - Return _name - EndFunction - - Function DialogClassName$() - Global _dname$ - Global _dc:WNDCLASSW - - If Not _dname - _dname="BLITZMAX_DIALOG_CLASS" - _dc=New WNDCLASSW - _dc.style=CS_OWNDC|CS_HREDRAW|CS_VREDRAW - _dc.lpfnWndProc=ClassWndProc - _dc.hInstance=GetModuleHandleW(Null) - _dc.hCursor=LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) - _dc.hbrBackground=COLOR_BTNSHADOW - _dc.lpszMenuName=Null - _dc.lpszClassName=_dname.ToWString() - _dc.cbWndExtra=DLGWINDOWEXTRA - ClassAtom2=RegisterClassW(_dc) - EndIf - Return _dname - EndFunction - - 'TMaxGuiDriver interface - - Method CreateGadget:TGadget(class,Text$,x,y,w,h,group:TGadget,style) - - Select class - Case GADGET_WINDOW - If Not group group=GDIDesktop - End Select - - Local gadget:TGadget = GadgetInstanceFromClass(class,group,style,Text) - - Select class - Case GADGET_DESKTOP, GADGET_MENUITEM, GADGET_NODE - Return gadget - End Select - - If LocalizationMode() & LOCALIZATION_OVERRIDE Then - LocalizeGadget(gadget,Text,"") - Else - gadget.SetText(Text) - EndIf - - If group Then gadget._SetParent group - If class <> GADGET_TOOLBAR Then gadget.SetShape(x,y,w,h) - - 'v0.51: Gadgets are now only shown when they have been sized, and the text set. - If TWindowsGadget(gadget) Then - If Not TWindowsWindow(gadget) - gadget.SetFont(GDIFont) - If TWindowsGadget(group) Then - TWindowsGadget(gadget)._forceDisable = Not( TWindowsGadget(group)._enabled And Not TWindowsGadget(group)._forceDisable ) - gadget.SetEnabled(Not (gadget.State()&STATE_DISABLED)) - EndIf - gadget.SetShow(True) - ElseIf Not (style & WINDOW_HIDDEN) Then - gadget.SetShow(True) - EndIf - EndIf - - If TWindowsGadget(gadget) Then TWindowsGadget(gadget).Sensitize() - - Return gadget - EndMethod - - Method GadgetInstanceFromClass:TGadget(class, group:TGadget, style = 0, Text$ = "") - - Local gadget:TGadget - - Select class - Case GADGET_DESKTOP - gadget=GDIDesktop - Case GADGET_MENUITEM - gadget=New TWindowsMenu.Create(group,style,Text) - Case GADGET_WINDOW - gadget=New TWindowsWindow.Create(group,style) - Case GADGET_BUTTON - gadget=New TWindowsButton.Create(group,style) - Case GADGET_TEXTFIELD - gadget=New TWindowsTextField.Create(group,style,Text) - Case GADGET_TEXTAREA - gadget=New TWindowsTextArea.Create(group,style) - Case GADGET_COMBOBOX - gadget=New TWindowsComboBox.Create(group,style,Text) - Case GADGET_LISTBOX - gadget=New TWindowsListBox.Create(group,style) - Case GADGET_TOOLBAR - gadget=New TWindowsToolBar.Create(group,style,Text) - Case GADGET_TABBER - gadget=New TWindowsTabber.Create(group,style) - Case GADGET_NODE - gadget=New TWindowsTreeNode.Create(group,style,Text) - Case GADGET_TREEVIEW - gadget=New TWindowsTreeView.Create(group,style) - Case GADGET_LABEL - gadget=New TWindowsLabel.Create(group,style) - Case GADGET_SLIDER - gadget=New TWindowsSlider.Create(group,style) - Case GADGET_PROGBAR - gadget=New TWindowsProgressBar.Create(group,style) - Case GADGET_PANEL - gadget=New TWindowsPanel.Create(group,style) - Case GADGET_CANVAS - gadget=New TWindowsPanel.Create(group,style|PANEL_CANVAS|PANEL_ACTIVE) - Case GADGET_HTMLVIEW - gadget=New TWindowsHTMLView.Create(group,style) - End Select - - Return gadget - - EndMethod - - Method ActiveGadget:TGadget() - Local tmpHwnd:Int = GetFocus(), tmpGadget:TGadget - While tmpHwnd - tmpGadget = GadgetFromHwnd( tmpHwnd ) - If tmpGadget Then Exit - tmpHwnd = GetParent_(tmpHwnd) - Wend - Return tmpGadget - EndMethod - - Method RequestColor(red,green,blue) - Local cc:CHOOSECOLOR = New CHOOSECOLOR - cc.lStructSize=SizeOf(cc) - cc.hwndOwner=GetActiveHwnd() - cc.rgbResult=(red)|(green Shl 8)|(blue Shl 16) - cc.lpCustColors=_customcolors - cc.Flags=CC_RGBINIT|CC_FULLOPEN|CC_ANYCOLOR - Local hwnd = GetFocus() - Local n = ChooseColorW(cc) - SetFocus(hwnd) - If Not n Return 0 - n = ((cc.rgbResult Shr 16)&$ff) | (cc.rgbResult&$ff00) | ((cc.rgbResult Shl 16)&$ff0000) - Return n|$ff000000 - EndMethod - - Method LookupColor( colorindex:Int, red:Byte Var, green:Byte Var, blue:Byte Var ) - - Select colorindex - Case GUICOLOR_WINDOWBG - colorindex = COLOR_BTNFACE - Case GUICOLOR_GADGETBG - colorindex = COLOR_WINDOW - Case GUICOLOR_GADGETFG - colorindex = COLOR_WINDOWTEXT - Case GUICOLOR_LINKFG - colorindex = COLOR_HOTLIGHT - Case GUICOLOR_SELECTIONBG - colorindex = COLOR_HIGHLIGHT - Default - Return Super.LookupColor( colorindex, red, green, blue ) - EndSelect - - Local tmpColor:Int = GetSysColor( colorindex ) - red = tmpColor & $FF - green = (tmpColor Shr 8) & $FF - blue = (tmpColor Shr 16) & $FF - - Return True - - EndMethod - - Method LoadFont:TGuiFont(name$,size,flags) - Return New TWindowsFont.Load(name,Double(size),flags) - EndMethod - - Method LoadFontWithDouble:TGuiFont(name$,size:Double,flags) - Return New TWindowsFont.Load(name,size,flags) - EndMethod - - Method LibraryFont:TGuiFont( pFontType% = GUIFONT_SYSTEM, pFontSize:Double = 0, pFontStyle% = FONT_NORMAL ) - If pFontType = GUIFONT_SYSTEM Then Return TWindowsFont.DefaultFont( pFontSize, pFontStyle ) Else Return Super.LibraryFont( pFontType, pFontSize, pFontStyle ) - EndMethod - - Method RequestFont:TGuiFont(font:TGuiFont) - Return TWindowsFont.Request(font) - EndMethod - - Method SetPointer(shape) - Global winptrs[]=[0,32512,32513,32514,32515,32516,32642,32643,32644,32645,32646,32648,32649,32650,32651] - If shape<1 Or shape>14 Then _cursor = LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) Else _cursor=LoadCursorW(0,Short Ptr(winptrs[shape])) - SetCursor(_cursor) - If TWindowsTextArea._oldCursor Then TWindowsTextArea._oldCursor = _cursor - If shape = 0 Then _cursor = 0 - EndMethod - - Method LoadIconStrip:TIconStrip(source:Object) - Return TWindowsIconStrip.Create(source) - EndMethod - - Function CheckCommonControlVersion() 'Returns True if supports alpha/themes etc. or False if not. - If Not _commoncontrolversion Then - Local libComCtl = LoadLibraryW("comctl32.dll") - Local GetCommonControlVersion( pDllVersionInfo:Byte Ptr ) "win32" = GetProcAddress(libComCtl, "DllGetVersion") - If GetCommonControlVersion Then - Local tmpDllVersion:DLLVERSIONINFO2 = New DLLVERSIONINFO2 - GetCommonControlVersion( tmpDllVersion ) - _commoncontrolversion = [tmpDllVersion.dwMajorVersion,tmpDllVersion.dwMinorVersion,tmpDLLVersion.dwBuildNo] - EndIf - GetCommonControlVersion = Null - FreeLibrary( libComCtl ) - EndIf - If _commoncontrolversion And _commoncontrolversion[0] >= 6 Then - If (_commoncontrolversion[0] > 6) Or (_commoncontrolversion[1] > 0) Then Return 2 Else Return 1 - EndIf - EndFunction - - Function GetThemeHandle(hwnd, pClass$ = "WINDOW") - If OpenThemeData And CheckCommonControlVersion() Then Return OpenThemeData(hwnd, pClass) - EndFunction - - Function CloseThemeHandle(hTheme) - If CloseThemeData Then Return CloseThemeData(hTheme) - EndFunction - - Function CreateExplorerStyleGadgets( pDisable = False ) - _explorerstyle = (pDisable <> True) - EndFunction - - Function GetActiveHwnd() - If _activeWindow Then Return _activeWindow._hwnd Else Return GetActiveWindow() - EndFunction - -EndType - -Type TWindowsGadget Extends TGadget - - 'Flag that determines whether gadgets should redraw when they are resized (see Rethink()). - Global _resizeRedraw = True - - 'Generic Unicode Strings to prevent memory-leak - Global _wstrEmpty:Short Ptr = "".ToWString() - Global _wstrSpace:Short Ptr = " ".ToWString() - Global _wstrExplorer:Short Ptr = "Explorer".ToWString() - - 'Important gadget fields that store OS control handles etc.. - - Field _class, _hwnd, _hwndclient, _tooltips - Field _proc(hwnd,msg,wp,lp) "win32" - Field _hotkey:THotKey - Field _oldcursorlp 'Should track events - - Field _sensitive% = False 'Determines whether gadgets should generate events. - 'Not to be confused with the sensitivity field of TGadget - 'which specifies which type of events are fired. - - 'Aesthetics - Field _bgbrush, _fgcolor = -1, _bgcolor = -1 'Background colour - Field _hbrush, _hbitmap 'Background colour - Field _bitmap 'Background bitmap - Field _iconBitmap 'Icon bitmap - Field _hTheme 'Open handle to XP Theme API (for use in button's WM_DRAWITEM etc.) - Field _font:TWindowsFont 'Font (needs to be stored, otherwise it may be collected by GC) - Field _wstrTooltip:Short Ptr, _toolAdded = False - Field _clientX:Int, _clientY:Int, _enabled:Int = True, _forcedisable:Int = False - - Method Create:TWindowsGadget(group:TGadget, style, Text$="") Abstract - - Method SetColor(red,green,blue) - If _bgbrush Then DeleteObject _bgbrush - _bgcolor = (blue Shl 16) | (green Shl 8) | red - _bgbrush=CreateSolidBrush(_bgcolor) - RedrawGadget(Self) - EndMethod - - Method RemoveColor() - If _bgbrush Then DeleteObject _bgbrush - _bgbrush=0 - RedrawGadget(Self) - EndMethod - - Method FgColor() - Return _fgcolor - EndMethod - - Method BgColor() - Return _bgcolor - EndMethod - - Method BgBrush() - Return _bgbrush - EndMethod - - Method SetTextColor(r,g,b) - _fgcolor = (b Shl 16) | (g Shl 8) | r - RedrawGadget(Self) - EndMethod - - Method Query(queryid) - Select queryid - Case QUERY_HWND - Return _hwnd - Case QUERY_HWND_CLIENT - If _hwndclient Return _hwndclient - Return _hwnd - End Select - EndMethod - - Method Register(class,hwnd,hwndclient=0,tips=False) - _class=class - _hwnd=hwnd - _hwndclient=hwndclient - TWindowsGUIDriver.RegisterHwnd(_hwnd,Self) - If _hwndclient TWindowsGUIDriver.RegisterHwnd(_hwndclient,Self) - Local atom=GetClassLongW(hwnd,GCW_ATOM) - If atom<>TWindowsGUIDriver.ClassAtom And atom<>TWindowsGUIDriver.ClassAtom2 And Not _proc - _proc=Byte Ptr(SetWindowLongW(hwnd,GWL_WNDPROC,Int Byte Ptr TWindowsGUIDriver.ClassWndProc)) - EndIf - If tips Then SetupToolTips() - EndMethod - - Method SetupToolTips() - If _tooltips Then DestroyWindow _tooltips;TWindowsGUIDriver.RemoveHwnd(_tooltips);_tooltips = 0 - _tooltips = CreateWindowExW( 0,"tooltips_class32","",TTS_ALWAYSTIP,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,_hwnd,0,GetModuleHandleW(Null),Null ) - SendMessageW _tooltips,TTM_SETMAXTIPWIDTH,0,300 - TWindowsGUIDriver.RegisterHwnd( _tooltips, Self ) - EndMethod - - Method isTabbable() - Local style:Int = GetWindowLongW(_hwnd,GWL_STYLE)&(WS_TABSTOP|WS_CHILD) - Return (style=(WS_TABSTOP|WS_CHILD)) - EndMethod - - Method isControl() - Return (GetWindowLongW(_hwnd,GWL_STYLE)&(WS_CHILD)=WS_CHILD) - EndMethod - - Method Activate(cmd) - Select cmd - Case ACTIVATE_FOCUS - If isTabbable() - DefDlgProcW GetParent_(_hwnd),WM_NEXTDLGCTL,_hwnd,1 - Return 1 - EndIf - Return SetFocus(_hwnd) - Case ACTIVATE_BACK - Return SendMessageW(_hwnd,WM_NEXTDLGCTL,1,0) - Case ACTIVATE_FORWARD - Return SendMessageW(_hwnd,WM_NEXTDLGCTL,0,0) - Case ACTIVATE_REDRAW - RefreshLook() - Return RedrawWindow( _hwnd, Null, Null, RDW_INVALIDATE | RDW_ERASE | RDW_FRAME | RDW_ALLCHILDREN ) - End Select - EndMethod - - Method Rethink() - QueueResize(_hwnd,xpos,ypos,width,height) - EndMethod - - Method RethinkClient(forceRedraw:Int = False) - EndMethod - - Method SetArea(x,y,w,h) - SetRect(x,y,w,h) - Rethink() - EndMethod - - Method LayoutKids() - - StartResize() - - 'Implemented hack to speed-up drawing considerably... - Local tmpOldState = TWindowsGadget._resizeredraw - TWindowsGadget._resizeredraw = False - - 'Child windows are laid-out like normal... - Super.LayoutKids() - - 'Reposition all child gadgets together. - EndResize() - - 'If this control is the first parent who started the resizing, then redraw parent and all controls now. - If tmpOldState Then - If (Not kids.IsEmpty()) Then Activate(ACTIVATE_REDRAW) - TWindowsGadget._resizeredraw = True - EndIf - - EndMethod - - Method ClientWidth() - Local Rect[] = [xpos,ypos,xpos+width,ypos+height] - SendMessageW Query(QUERY_HWND), WM_NCCALCSIZE, False, Int Byte Ptr Rect - Return Rect[2]-Rect[0]-_clientX - EndMethod - - Method ClientHeight() - Local Rect[] = [xpos,ypos,xpos+width,ypos+height] - SendMessageW Query(QUERY_HWND), WM_NCCALCSIZE, False, Int Byte Ptr Rect - Return Rect[3]-Rect[1]-_clientY - EndMethod - - Method SetText(Text$) - Desensitize() - SetWindowTextW _hwnd, Text - Sensitize() - EndMethod - - Method GetText$() - Local strText:Short[GetWindowTextLengthW(_hwnd)+1] 'Must include NULL terminator. - GetWindowTextW _hwnd, strText, strText.length - Return String.FromWString( strText ) - EndMethod - - Method SetFont(font:TGuiFont) - If TWindowsFont(font) Then _font = TWindowsFont(font) Else _font = TWindowsGUIDriver.GDIFont - SendMessageW _hwnd,WM_SETFONT,font.handle,1 - EndMethod - - Method SetShow(show) - If show - ShowWindow _hwnd,SW_SHOW - Else - 'Requester fix - ShowWindow activates the last activated window when an active window is hidden, so if - 'a file requester/child gadget was the last window to be activated, then the program will lose focus as it is - 'trying to activate a non-existent window. - If parent And HasDescendant(ActiveGadget()) Then ActivateGadget(parent) - ShowWindow _hwnd,SW_HIDE - EndIf - EndMethod - - Method SetEnabled(enable) - _enabled = enable - enable = enable And Not _forceDisable - If Not((EnableWindow(_hwnd,enable)<>0) ~ enable) Then - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget._forceDisable = Not enable - If tmpGadget.isControl() Then tmpGadget.SetEnabled(tmpGadget._enabled) - Next - EndIf - EndMethod - - Method SetTooltip( pTooltip$ ) - - If _wstrTooltip Then MemFree _wstrTooltip;_wstrTooltip = Null - - Local tmpToolInfo:TOOLINFOW = New TOOLINFOW - tmpToolInfo.cbSize = SizeOf(tmpToolInfo) - tmpToolInfo.hwnd = GetParent_(_hwnd) - tmpToolInfo.hinst = GetModuleHandleW(Null) - tmpToolInfo.uID = _hwnd - - If pTooltip Then - _wstrTooltip = pTooltip.Replace("~r","").Replace("~n","~r~n").ToWString() - - tmpToolInfo.uFlags = TTF_IDISHWND|TTF_TRANSPARENT|TTF_SUBCLASS - tmpToolInfo.lpszText = _wstrTooltip - - If Not _toolAdded Then - _toolAdded = SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_ADDTOOLW, 0, Int Byte Ptr tmpToolInfo) - Else - SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_UPDATETIPTEXTW, 0, Int Byte Ptr tmpToolInfo) - EndIf - ElseIf _tooladded Then - SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_DELTOOLW, 0, Int Byte Ptr tmpToolInfo ) - _toolAdded = 0 - EndIf - - EndMethod - - Method GetTooltip$() - If _wstrTooltip Then Return String.FromWString(_wstrTooltip) - EndMethod - - Method State() - Local t, style = GetWindowLongW(_hwnd, GWL_STYLE) - If Not (style&WS_VISIBLE) Then t:|STATE_HIDDEN - If Not _enabled Then t:|STATE_DISABLED - Return t - EndMethod - - Method Free() - If _tooltips Then DestroyWindow _tooltips;_tooltips=0 - SetTooltip("") 'Free any tooltip memory allocations - If _hwnd Then DestroyWindow _hwnd;TWindowsGUIDriver.RemoveHwnd(_hwnd);_hwnd=0 - If _hwndclient Then TWindowsGUIDriver.RemoveHwnd(_hwndclient);_hwndclient=0 - FlushBrushes(False) - If _hotKey Then RemoveHotKey(_hotKey);_hotKey = Null - If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 - If _bitmap Then DeleteObject(_bitmap);_bitmap = 0 - If _bgbrush Then DeleteObject(_bgbrush);_bgbrush = 0 - If _htheme Then TWindowsGUIDriver.CloseThemeHandle(_hTheme);_hTheme = 0 - _font = Null - _SetParent Null - EndMethod - - Method OnNotify(wp,lp) - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_WINDOWPOSCHANGING - FlushBrushes() - EndSelect - If _proc And _hwnd = hwnd Then - Return CallWindowProcW(_proc,hwnd,msg,wp,lp) 'fixed auto scrollbars - EndIf - Return DefWindowProcW( hwnd,msg,wp,lp ) - EndMethod - - Method OnCommand(msg,wp) - EndMethod - - Method OnDrawItem( pDrawItemStruct:DRAWITEMSTRUCT ) - EndMethod - - Method SetHotKey(key,modifier) - Local ev:TEvent = CreateEvent( EVENT_GADGETACTION,Self ) - If _hotKey Then RemoveHotKey(_hotKey);_hotKey = Null - If key Then _hotkey=SetHotKeyEvent(key,modifier,ev,FindGadgetWindowHwnd(Self)) - EndMethod - - 'Slow back-up code for mimicking transparency for PANEL_GROUPs and when - 'DrawThemeParentBackground() is not available (i.e. on Windows 9x/2000). - Method CreateControlBrush( hWndControl, hdc = 0 ) - - Local xOffset, yOffset - Local hwndWindow = GetParent_(hwndControl) - Local rectWindow[4], rectControl[4], rectClient[4] - - If _hbrush Then Return _hbrush - - If BgBrush() Then - If hdc Then SetBkColor(hdc, BgColor()) - Return BgBrush() - EndIf - - Local tmpDC = GetDC( hwndWindow ) - - 'Fix required to offset background when controls are drawn with WS_EX_CLIENTEDGE (e.g. panel with PANEL_SUNKEN/PANEL_RAISED set) - If GetWindowLongW(hwndWindow,GWL_EXSTYLE)&(WS_EX_CLIENTEDGE|WS_EX_WINDOWEDGE) Then - xOffset = -GetSystemMetrics(SM_CXEDGE) - yOffset = -GetSystemMetrics(SM_CYEDGE) - EndIf - - GetClientRect( hwndControl, rectClient ) - GetWindowRect( hwndWindow, rectWindow ) - GetWindowRect( hwndControl, rectControl ) - - Local x = rectControl[0]-rectWindow[0] - Local y = rectControl[1]-rectWindow[1] - Local w = rectControl[2]-rectControl[0] - Local h = rectControl[3]-rectControl[1] - - Local dcBitmap = CreateCompatibleDC( tmpDC ) - Local bkgndBitmap = CreateCompatibleBitmap( tmpDC, rectWindow[2]-rectWindow[0], rectWindow[3]-rectWindow[1] ) - SelectObject( dcBitmap, bkgndBitmap ) - - 'InvalidateRect( hwndWindow, Null, False ) - SendMessageW hwndWindow, WM_ERASEBKGND, dcBitmap, 0 - - Local bkgndClientBitmap = CreateCompatibleBitmap( tmpDC, w, h ) - Local dcClientBitmap = CreateCompatibleDC( tmpDC ) - SelectObject( dcClientBitmap, bkgndClientBitmap ) - - BitBlt( dcClientBitmap, 0,0 , w, h, dcBitmap, x+xOffset, y+yOffset, ROP_SRCCOPY ) - - DeleteObject( bkgndBitmap ) - DeleteDC( dcBitmap ) - DeleteDC( dcClientBitmap ) - - _hbrush = CreatePatternBrush( bkgndClientBitmap ) - _hbitmap = bkgndClientBitmap - - ReleaseDC( hwndWindow, tmpDC ) - - Return _hbrush - - EndMethod - - 'Clears the parent background brushes. - Method FlushBrushes(pRecurse:Int = True) - Local tmpChanges:Int = 0 - If _hbrush Then - DeleteObject( _hbrush ) - _hbrush = 0 - tmpChanges:|True - EndIf - If _hBitmap Then - DeleteObject( _hBitmap ) - _hBitmap = 0 - tmpChanges:|True - EndIf - Return tmpChanges - EndMethod - - 'Method that returns a brush for drawing backgrounds. - Method DrawBackground( hdc, hwnd ) - - If BgBrush() Then SetBkColor(hdc, BgColor());Return BgBrush() - - Return DrawParentBackground( hdc, hwnd ) - - EndMethod - - 'Another method which mimics transparency on Windows Controls. - Function DrawParentBackground( hdc, hwndControl, pForceHack = False ) - - Local rectWindow[4], rectControl[4], rectClient[4] - Local hwndWindow = GetParent_(hwndControl) - - GetClientRect( hwndControl, rectClient ) - GetClientRect( hwndWindow, rectWindow ) - GetWindowRect( hwndControl, rectControl ) - - 'Ensures that the the drawing context is returned in exactly the same state that it was passed. - Local tmpSaveState = SaveDC( hdc ) - - If DrawThemeParentBackground And Not pForceHack Then - - DrawThemeParentBackground(hwndControl,hdc,rectClient) - - Else 'Again, slow back-up code in case DrawThemeParentBackground() is not available. - - Local tmpDC, xOffset, yOffset - - 'Fix required to offset background when controls are drawn with WS_EX_CLIENTEDGE (e.g. panel with PANEL_BORDER set) - If GetWindowLongW(hwndWindow,GWL_EXSTYLE)&WS_EX_CLIENTEDGE Then - xOffset = -GetSystemMetrics(SM_CXEDGE) - yOffset = -GetSystemMetrics(SM_CYEDGE) - EndIf - - tmpDC = GetDC( hwndWindow ) - - ScreenToClient( hwndWindow, rectControl ) - ScreenToClient( hwndWindow, Int Ptr (rectControl)+2 ) - - Local x = rectControl[0]+rectClient[0] - Local y = rectControl[1]+rectClient[1] - Local w = rectClient[2]-rectClient[0] - Local h = rectClient[3]-rectClient[1] - - Local bkgndBitmap = CreateCompatibleBitmap( tmpDC, rectWindow[2]-rectWindow[0], rectWindow[3]-rectWindow[1] ) - Local dcBitmap = CreateCompatibleDC( tmpDC ) - SelectObject( dcBitmap, bkgndBitmap ) - - InvalidateRect( hwndWindow, Null, False ) - SendMessageW hwndWindow, WM_ERASEBKGND, dcBitmap, 0 - - BitBlt( hdc, 0,0 , w, h, dcBitmap, x+xOffset, y+yOffset, ROP_SRCCOPY ) - - DeleteObject( bkgndBitmap ) - DeleteDC( dcBitmap ) - ReleaseDC( hwndWindow, tmpDC ) - - EndIf - - 'Ensures that the the drawing context is returned in exactly the same state that it was passed. - RestoreDC( hdc, tmpSaveState ) - - Return GetStockObject( NULL_BRUSH ) - - EndFunction - - Method Sensitize() - _sensitive = True - EndMethod - - Method DeSensitize() - _sensitive = False - EndMethod - - Method PostGuiEvent( pID%, pData%=0, pMods%=0, pX%=0, pY%=0, pExtra:Object = Null) - - Select True - Case TWindowsListBox(Self) <> Null, TWindowsTabber(Self) <> Null, TWindowsToolbar(Self) <> Null, TWindowsCombobox(Self) <> Null - If pData>-1 Then - If (ItemFlags(pData) & GADGETITEM_TOGGLE) Then SelectItem(pData,2) - EndIf - End Select - - If _sensitive Then MaxGUI.MaxGUI.PostGuiEvent( pID, Self, pData, pMods, pX, pY, pExtra ) - - EndMethod - - 'Resize Methods - - Field hdwpStruct - - Method StartResize() - If Not hdwpStruct Then - Local tmpCount = kids.Count() - If tmpCount Then hdwpStruct = BeginDeferWindowPos( tmpCount ) - EndIf - EndMethod - - Method QueueResize( hwnd, xpos, ypos, width, height ) - If parent And GetParent_(hwnd) = parent.Query(QUERY_HWND_CLIENT) And TWindowsGadget(parent).hdwpStruct Then - Local tmpFlags = SWP_NOOWNERZORDER | SWP_NOZORDER | SWP_NOACTIVATE' | SWP_NOCOPYBITS - If Not _resizeRedraw Then tmpFlags:| SWP_NOREDRAW - TWindowsGadget(parent).hdwpStruct = DeferWindowPos( TWindowsGadget(parent).hdwpStruct, hwnd, Null, xpos, ypos, width, height, tmpFlags ) - Else - MoveWindow( hwnd, xpos, ypos, width, height, _resizeRedraw ) - HasResized() - EndIf - EndMethod - - Method EndResize() - If hdwpStruct Then - EndDeferWindowPos( hdwpStruct );hdwpStruct = 0 - For Local tmpGadget:TWindowsGadget = EachIn kids - Sensitize() - tmpGadget.HasResized() - Next - EndIf - EndMethod - - 'Required for resizing columns in listboxes (has to be done outside WM_SIZE) - Method HasResized() - EndMethod - - 'Required to ensure problematic controls are updated when parent aesthetics are changed: - Method RefreshLook() - FlushBrushes(False) - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget.RefreshLook() - Next - EndMethod - -Rem - Method StartDoubleBuffer() - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget.StartDoubleBuffer() - Next - EndMethod - - Method EndDoubleBuffer() - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget.EndDoubleBuffer() - Next - EndMethod -EndRem -EndType - - -Type TWindowsDesktop Extends TWindowsGadget - - Method New() - Local Rect[4] - Local hwnd = GetDesktopWindow() - Register(GADGET_DESKTOP,hwnd,0,False) - GetClientRect hwnd,Rect - SetShape 0,0,Rect[2]-Rect[0],Rect[3]-Rect[1] - EndMethod - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Return Self - EndMethod - - Method SetTooltip( pTooltip$ ) - 'Shouldn't have tool-tips. - EndMethod - - Method Free() - 'Can't be free'd. - EndMethod - - Method Class() - Return GADGET_DESKTOP - EndMethod - - Method ClientHeight() - Local Rect[4] - If Super.ClientHeight() = height And SystemParametersInfoW( SPI_GETWORKAREA, 0, Int Byte Ptr Rect, 0 ) - Return Rect[3]-Rect[1] - Else - Return Super.ClientHeight() - EndIf - EndMethod - - Method ClientWidth() - Local Rect[4] - If Super.ClientWidth() = width And SystemParametersInfoW( SPI_GETWORKAREA, 0, Int Byte Ptr Rect, 0 ) - Return Rect[2]-Rect[0] - Else - Return Super.ClientWidth() - EndIf - EndMethod - -EndType - -Type TWindowsWindow Extends TWindowsGadget - - Field _wstyle, _xstyle - Field _minwidth,_minheight,_maxwidth = -1,_maxheight = -1 - Field _menu:TWindowsMenu - Field _hmenu - Field _status - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local hwnd, parent, client - Local classname$ = TWindowsGUIDriver.ClassName() - - Self.style = style - _wstyle=WS_CLIPSIBLINGS|WS_CLIPCHILDREN - If group Then parent = group.Query(QUERY_HWND) - - If (style&WINDOW_TITLEBAR) - _wstyle:|WS_OVERLAPPED|WS_SYSMENU - If style&WINDOW_RESIZABLE _wstyle:|WS_MINIMIZEBOX|WS_MAXIMIZEBOX - If group <> TWindowsGUIDriver.GDIDesktop And Not (style&WINDOW_TOOL) Then - classname$ = TWindowsGUIDriver.DialogClassName() - _xstyle:|WS_EX_DLGMODALFRAME - EndIf - Else - _wstyle:|WS_POPUP - EndIf - - If style&WINDOW_RESIZABLE Then _wstyle:|WS_SIZEBOX - If style&WINDOW_MENU Then _hmenu=CreateMenu_();AppendMenuW( _hmenu,MF_STRING,Null,_wstrEmpty ) - If style&WINDOW_TOOL Then _xstyle:|WS_EX_TOOLWINDOW - - ' Note: No WINDOW_HIDDEN case as gadgets are always created hidden to hide initial resize flicker. - ' TWindowsGUIDriver.CreateGadget() will later show window if WINDOW_HIDDEN is not specified. - - hwnd=CreateWindowExW(_xstyle,classname,"",_wstyle,0,0,0,0,parent,_hmenu,GetModuleHandleW(Null),Null) - - If style&WINDOW_STATUS - _status=CreateWindowExW(0,"msctls_statusbar32","",WS_CHILD|WS_VISIBLE,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) - SetWindowPos( _status, HWND_TOPMOST,0,0,0,0,SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOSIZE) - EndIf - - client=CreateWindowExW(0,TWindowsGUIDriver.ClassName(),"",WS_CHILD|WS_VISIBLE|WS_CLIPCHILDREN|WS_CLIPSIBLINGS,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) - - Register GADGET_WINDOW,hwnd,client,False - - If style&WINDOW_ACCEPTFILES Then DragAcceptFiles _hwnd,True - _wstyle = GetWindowLongW( hwnd, GWL_STYLE ) - - Return Self - EndMethod - - Method SetAlpha( alpha# ) - If SetLayeredWindowAttributes Then - Local tmpStyle% = GetWindowLongW(_hwnd, GWL_EXSTYLE) - If alpha = 1.0 Then - SetLayeredWindowAttributes( _hwnd, 0, Byte(alpha*255), LWA_ALPHA) - If (tmpStyle & WS_EX_LAYERED) Then SetWindowLongW(_hwnd, GWL_EXSTYLE, tmpStyle&~WS_EX_LAYERED) - Else - If Not (tmpStyle & WS_EX_LAYERED) Then SetWindowLongW(_hwnd, GWL_EXSTYLE, tmpStyle|WS_EX_LAYERED) - SetLayeredWindowAttributes( _hwnd, 0, Byte(alpha*255), LWA_ALPHA) - EndIf - RedrawGadget(Self) - EndIf - EndMethod - - Method Rethink() - Local dimensions[] = [xpos,ypos,width,height] - ConvertToContainerDimensions( dimensions[0], dimensions[1], dimensions[2], dimensions[3] ) - MoveWindow _hwnd, dimensions[0], dimensions[1], dimensions[2], dimensions[3], True - RethinkClient(True) - EndMethod - - Method RethinkClient(forceRedraw:Int = False) - If _hwndClient Then - MoveWindow _hwndClient, _clientx,_clienty,ClientWidth(),ClientHeight(),forceRedraw - EndIf - LayoutKids() - EndMethod - - - Method ClientWidth() - If (style & WINDOW_CLIENTCOORDS) Then Return width - Local Rect:Int[4] - GetClientRect _hwnd, Rect - Return Max(Rect[2]-Rect[0]-_clientX,0) - EndMethod - - Method ClientHeight() - If (style & WINDOW_CLIENTCOORDS) Then Return height - Local h:Int = height, Rect:Int[] = [0,0,width,height] - AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) - h:-(Rect[3]-Rect[1]+_clientY-height) - If _status Then GetWindowRect _status,Rect;h:-(Rect[3]-Rect[1]) - Return Max(h,0) - End Method - - Method Class() - Return GADGET_WINDOW - EndMethod - - Method State() - Local t = Super.State() - If IsIconic(_hwnd) t:|STATE_MINIMIZED - If IsZoomed(_hwnd) t:|STATE_MAXIMIZED - Return t - EndMethod - - Method SetEnabled(enable) - _enabled = enable - EnableWindow(_hwnd,enable) - EndMethod - - Method SetMinimumSize(w,h) - 'Set minimum size for current window style - _minwidth=w;_minheight=h - 'Get window style - Local tmpWStyle% = GetWindowLongW( _hwnd, GWL_STYLE ) - 'Update size border - If (_maxwidth = _minwidth And _maxheight = _minheight) Then tmpWStyle:&~WS_SIZEBOX ElseIf (style&WINDOW_RESIZABLE) Then tmpWStyle:|WS_SIZEBOX - 'Set new window style if necessary - If tmpWStyle <> GetWindowLongW( _hwnd, GWL_STYLE ) Then - SetWindowLongW( _hwnd, GWL_STYLE, tmpWStyle ) - Rethink() - SetWindowPos( _hwnd, Null, 0, 0, 0, 0, SWP_DRAWFRAME|SWP_FRAMECHANGED|SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOZORDER|SWP_NOSIZE ) - EndIf - EndMethod - - Method SetMaximumSize(w,h) - 'Set maximum size for current window style - _maxwidth=w;_maxheight=h - 'Get window style - Local tmpWStyle% = GetWindowLongW( _hwnd, GWL_STYLE )&~WS_MAXIMIZEBOX - 'Update size border - If (_maxwidth = _minwidth And _maxheight = _minheight) Then tmpWStyle:&~WS_SIZEBOX ElseIf (style&WINDOW_RESIZABLE) Then tmpWStyle:|WS_SIZEBOX - 'Set new window style if necessary - If tmpWStyle <> GetWindowLongW( _hwnd, GWL_STYLE ) Then - SetWindowLongW( _hwnd, GWL_STYLE, tmpWStyle ) - Rethink() - SetWindowPos( _hwnd, Null, 0, 0, 0, 0, SWP_DRAWFRAME|SWP_FRAMECHANGED|SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOZORDER|SWP_NOSIZE ) - EndIf - EndMethod - - Method GetMenu:TGadget() - If Not _menu Then - _menu = New TWindowsMenu.Create(Null,0,"") - _menu._setParent Self - EndIf - Return _menu - EndMethod - - Method UpdateMenu() - - Local hmenu, oldMenu - If _menu - _menu.FreeKids - _menu.Open - hmenu=_menu._hmenu - EndIf - - oldMenu = GetMenu_( _hwnd ) - SetMenu _hwnd,hmenu - DrawMenuBar _hwnd - DestroyMenu oldMenu - - EndMethod - - Field _statustext$ - - Method GetStatusText$() - If _status - Return _statustext - EndIf - EndMethod - - Method SetStatusText(Text$) - If _status - _statustext = Text - If (style&WINDOW_RESIZABLE) Then Text:+" " 'Cludge for size handle obfuscation - Local tmpWString:Short Ptr = Text.ToWString() - SendMessageW _status,WM_SETTEXT,0,Int(tmpWString) - MemFree tmpWString - EndIf - EndMethod - - Field popupextra:Object - - Method PopupMenu(menu:TGadget,extra:Object) - Local pt[2], wmenu:TWindowsMenu = TWindowsMenu(menu), tmpLink:TLink - If wmenu - - GetCursorPos_ pt - popupextra = extra - wmenu.Open(True) - - Local hmenu:Int = TrackPopupMenu( wmenu._hmenu,TPM_LEFTALIGN|TPM_TOPALIGN|TPM_RETURNCMD|TPM_NONOTIFY,pt[0],pt[1],0,_hwnd,0 ) - If hmenu Then HandleMenuEvent( WM_COMMAND, hmenu ) - - wmenu.Close() - popupextra = Null - - EndIf - EndMethod - - Function EnumChildProc(hwnd,lp) "win32" - Local winfo:WINDOWINFO = New WINDOWINFO - winfo.cbSize=SizeOf winfo - GetWindowInfo hwnd,winfo - If winfo.dwStyle&WS_TABSTOP - _firsttab=hwnd - Else - EnumChildWindows hwnd,EnumChildProc,0 - EndIf - If _firsttab Return 0 - Return 1 - EndFunction - - Global _firsttab - - Method Activate(cmd) - Select cmd - Case ACTIVATE_FOCUS - _firsttab=0 - EnumChildWindows _hwnd,EnumChildProc,0 - If Not _firsttab _firsttab=_hwnd - SetFocus _firsttab - Case ACTIVATE_MINIMIZE - ShowWindow _hwnd,SW_MINIMIZE - Case ACTIVATE_MAXIMIZE - ShowWindow _hwnd,SW_MAXIMIZE - Case ACTIVATE_RESTORE - ShowWindow _hwnd,SW_RESTORE - Case ACTIVATE_REDRAW - RefreshLook() - Return RedrawWindow( _hwnd, Null, Null, RDW_INVALIDATE | RDW_UPDATENOW | RDW_ERASE | RDW_FRAME | RDW_ALLCHILDREN ) - End Select - EndMethod - - Method OnCommand(msg,wp) - If wp>100 Then HandleMenuEvent(msg,wp) - EndMethod - - Method HandleMenuEvent( msg, wp ) - - Local tmpMenuSource:TWindowsMenu = TWindowsMenu.GetMenuFromKey(wp), tmpMenuID - If tmpMenuSource Then tmpMenuID = tmpMenuSource._tag - - Local tmpPopupExtra:Object = popupextra - popupextra = Null - - MaxGUI.MaxGUI.PostGuiEvent EVENT_MENUACTION,tmpMenuSource,tmpMenuID,0,0,0,tmpPopupExtra - - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Local x,y,w,h - Local move,size - Local Rect[4] - Local winrect[4] - - Select msg - - Case WM_ERASEBKGND - If BgBrush() Then - Local Rect[4] - If Not GetUpdateRect( hwnd, Rect, False ) Then GetClipBox( wp, Rect ) - FillRect( wp, Rect, BgBrush() ) - Return 1 - EndIf - - Case WM_SIZE - - If (hwnd = _hwnd) And (wp <> SIZE_MINIMIZED) Then - - If _status Then SendMessageW _status,WM_SIZE,0,0 - - If (style & WINDOW_CLIENTCOORDS) Then - GetClientRect _hwnd,Rect - w=Rect[2] - h=Rect[3] - AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) - x=-Rect[0] - y=-Rect[1] - GetWindowRect _hwnd,Rect - x:+Rect[0] - y:+Rect[1] - If _status Then - GetWindowRect _status,Rect - h:-(Rect[3]-Rect[1]) - EndIf - x:+_clientX;y:+_clientY - w:-_clientX;h:-_clientY - Else - GetWindowRect(_hwnd,Rect) - x=Rect[0];y=Rect[1] - w=Rect[2]-Rect[0] - h=Rect[3]-Rect[1] - EndIf - - If x<>xpos Or y<>ypos Then move = True - If w<>width Or h<>height Then size = True - - SetRect x,y,w,h - - If size Then RethinkClient() - - If move PostGuiEvent EVENT_WINDOWMOVE,0,0,x,y - If size PostGuiEvent EVENT_WINDOWSIZE,0,0,w,h - - EndIf - - Case WM_MOVE - If (hwnd = _hwnd) And Not (IsZoomed(hwnd) Or IsIconic(hwnd)) Then - - If (style & WINDOW_CLIENTCOORDS) Then - GetClientRect _hwnd,Rect - w=Rect[2] - h=Rect[3] - AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) - x=-Rect[0] - y=-Rect[1] - GetWindowRect _hwnd,Rect - x:+Rect[0]+_clientX - y:+Rect[1]+_clientY - Else - GetWindowRect(_hwnd,Rect) - x=Rect[0];y=Rect[1] - w=Rect[2]-Rect[0] - h=Rect[3]-Rect[1] - EndIf - - If x<>xpos Or y<>ypos Then - SetRect x,y,width,height - PostGuiEvent EVENT_WINDOWMOVE,0,0,x,y - EndIf - - EndIf - - Case WM_GETMINMAXINFO - If hwnd = _hwnd And lp Then - Local minmax:Int Ptr = Int Ptr(lp), tmpZero% = 0 - - minmax[6]=_minwidth - minmax[7]=_minheight - ConvertToContainerDimensions(tmpZero,tmpZero,minmax[6],minmax[7]) - - If (_maxwidth >= _minwidth) And (_maxheight >= _minheight) Then - minmax[8]=_maxwidth - minmax[9]=_maxheight - ConvertToContainerDimensions(tmpZero,tmpZero,minmax[8],minmax[9]) - EndIf - - EndIf - - Case WM_ACTIVATE - If (wp = WA_ACTIVE) Or (wp = WA_CLICKACTIVE) Then - TWindowsGUIDriver._ActiveWindow = Self - PostGuiEvent EVENT_WINDOWACTIVATE - EndIf - - Case WM_COMMAND - If wp>100 Then HandleMenuEvent(wp,msg) - - Case WM_CLOSE - PostGuiEvent EVENT_WINDOWCLOSE - Return 1 - - Case WM_DROPFILES - Local hdrop,pt[2],path$ - Local pbuffer:Short[MAX_PATH] - Local i,n,l - DragQueryPoint wp,pt - n=DragQueryFileW(wp,$ffffffff,Null,0); - For i=0 Until n - l=DragQueryFileW(wp,i,pbuffer,MAX_PATH) - path=String.FromShorts(pbuffer,l) - PostGuiEvent EVENT_WINDOWACCEPT,0,0,pt[0],pt[1],path - Next - DragFinish wp - - End Select - - Return Super.WndProc(hwnd,msg,wp,lp) - - EndMethod - - Method DoLayout() - 'Don't do anything! - EndMethod - - Method SetTooltip( pTooltip$ ) - 'Windows shouldn't have tool-tips! - EndMethod - - Method SetSensitivity(flags) - 'Problems with resizing/moving sensitive windows. - Super.SetSensitivity(flags&~SENSITIZE_MOUSE) - 'Easy to create an active panel in client area as a work around. - EndMethod - - Method SetPixmap(pPixmap:TPixmap, pFlags) - If Not (pFlags & GADGETPIXMAP_ICON) Then Return False - If _iconBitmap Then DestroyIcon(_iconBitmap);_iconBitmap = 0 - If pPixmap Then _iconBitmap = TWindowsGraphic.IconFromPixmap32( pPixmap ) - SendMessageW (_hwnd, WM_SETICON, 0, _iconBitmap) - SendMessageW (_hwnd, WM_SETICON, 1, _iconBitmap) - Return True - EndMethod - - ' Needed otherwise SetEnabled() locks if modal child window is opened and parent is disabled. - Method isControl() - Return False - EndMethod - - Method ConvertToContainerDimensions%( pX Var, pY Var, pW Var , pH Var ) - - If Not (style & WINDOW_CLIENTCOORDS) Then Return 0 - - Local Rect[4], menu = GetMenu_(_hwnd) - - If menu Then menu = True - If _status Then GetWindowRect _status,Rect;pH:+(Rect[3]-Rect[1]) - pW:+_clientX;pH:+_clientY;pX:-_clientX;pY:-_clientY - - Rect = [pX,pY,pX+pW,pY+pH] - AdjustWindowRectEx Rect,GetWindowLongW(_hwnd, GWL_STYLE),menu,GetWindowLongW(_hwnd, GWL_EXSTYLE) - - pX = Rect[0];pY = Rect[1];pW = Rect[2]-Rect[0];pH = Rect[3]-Rect[1] - - Return 1 - - EndMethod - - Method FlushBrushes(pRecurse:Int = True) - Super.FlushBrushes() - If Not pRecurse Then Return - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget.FlushBrushes() - Next - EndMethod - -EndType - -Type TWindowsButton Extends TWindowsGadget - - Field _buttonImageList[] = [-1,0,0,0,0,0], _strButtonText$, _mouseoverbutton - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - Self.style = style - wstyle=WS_CHILD|WS_TABSTOP|WS_CLIPSIBLINGS|BS_MULTILINE - Select style&7 - Case 0 wstyle:|BS_PUSHBUTTON;style = BUTTON_PUSH - Case BUTTON_CHECKBOX wstyle:|BS_3STATE;If (style&BUTTON_PUSH) Then wstyle:|BS_PUSHLIKE - Case BUTTON_RADIO wstyle:|BS_AUTORADIOBUTTON;If (style&BUTTON_PUSH) Then wstyle:|BS_PUSHLIKE - Case BUTTON_OK wstyle:|BS_DEFPUSHBUTTON;hotkey=IDOK - Case BUTTON_CANCEL wstyle:|BS_PUSHBUTTON;hotkey=IDCANCEL - End Select - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"BUTTON","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - Register GADGET_BUTTON,hwnd - Return Self - EndMethod - - Method SetTextColor(r,g,b) - If Not (style&7) Then - SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)|BS_OWNERDRAW) - If Not _hTheme Then _hTheme = TWindowsGUIDriver.GetThemeHandle( _hwnd, "Button" ) - ElseIf Not (style&BUTTON_PUSH) And ((style&7=BUTTON_CHECKBOX) Or (style&7=BUTTON_RADIO)) - If SetWindowThemeW Then SetWindowThemeW(_hwnd,_wstrSpace,_wstrSpace) - EndIf - Super.SetTextColor(r,g,b) - EndMethod - - Method SetColor(r,g,b) - If Not (style&7) Then - SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)|BS_OWNERDRAW) - If Not _hTheme Then _hTheme = TWindowsGUIDriver.GetThemeHandle( _hwnd, "Button" ) - EndIf - Super.SetColor(r,g,b) - EndMethod - - Method RemoveColor() - If Not (style&7) Then - SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)&~BS_OWNERDRAW) - _hTheme=0 - EndIf - Super.RemoveColor() - EndMethod - - Method State() - Local t=Super.State() - Select SendMessageW( _hwnd,BM_GETCHECK,0,0 ) - Case BST_CHECKED;t:|STATE_SELECTED - Case BST_INDETERMINATE;t:|STATE_INDETERMINATE - EndSelect - Return t - EndMethod - - Method SetSelected(bool) - Local state = BST_UNCHECKED - If bool Then - If (style&7 = BUTTON_CHECKBOX) And (bool = CHECK_INDETERMINATE) Then - state = BST_INDETERMINATE - Else - state = BST_CHECKED - EndIf - EndIf - SendMessageW _hwnd,BM_SETCHECK,state,0 - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_THEMECHANGED - If _hTheme Then - TWindowsGUIDriver.CloseThemeHandle(_hTheme) - _hTheme = TWindowsGUIDriver.GetThemeHandle(_hwnd,"BUTTON") - EndIf - Case WM_LBUTTONDBLCLK - PostMessageW(_hwnd, WM_LBUTTONDOWN, wp, lp) - Case WM_MOUSEMOVE - If Not _mouseoverbutton Then - _mouseoverbutton = True - InvalidateRect(_hwnd,Null,False) - Local tmpTrackMouseEvent:Int[] = [ 16, $2, hwnd, 0 ] 'TME_LEAVE: $2 - _TrackMouseEvent( tmpTrackMouseEvent ) - EndIf - Case WM_MOUSELEAVE - If _mouseoverbutton Then - _mouseoverbutton = False - InvalidateRect(_hwnd,Null,False) - EndIf - Case WM_ERASEBKGND - Return 1 - EndSelect - - Return Super.WndProc(hwnd,msg,wp,lp) - - EndMethod - - Method OnDrawItem(pDrawItemStruct:DRAWITEMSTRUCT) - - Local tmpDc = pDrawItemStruct.hDc, txtWidth%, txtHeight% - Local tmpDcState = SaveDC(tmpDC) - - ' button state - Local tmpIsPressed = (pDrawItemStruct.ItemState & ODS_SELECTED) - Local tmpIsFocused = (pDrawItemStruct.ItemState & ODS_FOCUS) - Local tmpIsDisabled = (pDrawItemStruct.ItemState & ODS_DISABLED) - Local tmpDrawFocusRect = Not (pDrawItemStruct.ItemState & ODS_NOFOCUSRECT) - - Local itemRect:Int Ptr = Int Ptr Varptr pDrawItemStruct.rcItem_left, txtRect:Int[4], clientRect:Int[4] - - Local tmpBgMode = SetBkMode(tmpDc, TRANSPARENT) - - ' Prepare draw... paint button background - - If _hTheme Then - - Local tmpState = PBS_NORMAL - If tmpIsDisabled Then - tmpState = PBS_DISABLED - ElseIf tmpIsPressed Then - tmpState = PBS_PRESSED - ElseIf _mouseoverbutton Then - tmpState = PBS_HOT - ElseIf tmpIsFocused Then - tmpState = PBS_DEFAULTED - EndIf - - If IsThemeBackgroundPartiallyTransparent(_hTheme, BP_PUSHBUTTON, tmpState) Then - DrawThemeParentBackground( _hwnd, tmpDc, itemRect ) - EndIf - DrawThemeBackground(_hTheme, tmpDc, BP_PUSHBUTTON, tmpState, itemRect, Null) - GetThemeBackgroundContentRect(_hTheme, tmpDc, BP_PUSHBUTTON, tmpState, itemRect, clientRect) - - Else - - clientRect = [itemRect[0], itemRect[1], itemRect[2], itemRect[3]] - InflateRect(clientRect, -GetSystemMetrics(SM_CXEDGE), -GetSystemMetrics(SM_CYEDGE)) - - If tmpIsFocused Then - - Local tmpBr = CreateSolidBrush($000000) - FrameRect(tmpDc, itemRect , tmpBr) - InflateRect(itemRect, -1, -1) - DeleteObject(tmpBr) - - EndIf - - Local crColor - If BgColor() < 0 Then crColor = GetSysColor(COLOR_BTNFACE) Else crColor = BgColor() - - Local brBackground = CreateSolidBrush(crColor) - - FillRect(tmpDc, itemRect, brBackground) - - DeleteObject(brBackground) - - ' Draw pressed button - If tmpIsPressed - - Local brBtnShadow = CreateSolidBrush(GetSysColor(COLOR_BTNSHADOW)) - FrameRect(tmpDc, itemRect, brBtnShadow) - DeleteObject(brBtnShadow) - - OffsetRect( clientRect, 1, 1 ) - - Else ' ...Else draw non pressed button - - Local tmpUState = DFCS_BUTTONPUSH - If _mouseoverbutton Then tmpUState :| DFCS_HOT - If tmpIsPressed Then tmpUState :| DFCS_PUSHED - - DrawFrameControl(tmpDc, itemRect, DFC_BUTTON, tmpUState) - - EndIf - - EndIf - - If BgColor() > -1 Then - Local brBackground = CreateSolidBrush(BgColor()) - FillRect(tmpDc, clientRect, brBackground) - DeleteObject(brBackground) - EndIf - - txtRect = clientRect[..] - - clientRect[RECT_RIGHT]:-clientRect[RECT_LEFT] - clientRect[RECT_BOTTOM]:-clientRect[RECT_TOP] - - ' Read the button's title - Local tmpText$ = Super.GetText() - - ' Draw the icon - 'DrawTheIcon(GetDlgItem(hDlg, IDC_OWNERDRAW_BTN), &dc, bHasTitle, &lpDIS.rcItem, &captionRect, bIsPressed, bIsDisabled) - - ' Write the button title (if any) - If tmpText Then - - Local tmpFlags = DT_CENTER|DT_WORDBREAK - - DrawTextW( tmpDc, tmpText, -1, txtRect, DT_CALCRECT|tmpFlags ) - - txtWidth = txtRect[RECT_RIGHT]-txtRect[RECT_LEFT] - txtHeight = txtRect[RECT_BOTTOM]-txtRect[RECT_TOP] - - txtRect[RECT_LEFT] = clientRect[RECT_LEFT] + (clientRect[RECT_RIGHT] - txtWidth)/2 - txtRect[RECT_TOP] = clientRect[RECT_TOP] + (clientRect[RECT_BOTTOM] - txtHeight)/2 - txtRect[RECT_RIGHT] = txtRect[RECT_LEFT] + txtWidth - txtRect[RECT_BOTTOM] = txtRect[RECT_TOP] + txtHeight - - Local tmpTextColor - If tmpIsDisabled Then - tmpTextColor = GetSysColor(COLOR_GRAYTEXT) - Else - If FgColor() < 0 Then tmpTextColor = GetSysColor(COLOR_BTNTEXT) Else tmpTextColor = FgColor() - EndIf - tmpTextColor = SetTextColor_(tmpDc,tmpTextColor) - - DrawTextW( tmpDc, tmpText, -1, txtRect, tmpFlags ) - - SetTextColor_(tmpDc,tmpTextColor) - - EndIf - - RestoreDC(tmpDc,tmpDcState) - - ' Draw the focus rect - If tmpIsFocused And tmpDrawFocusRect Then - Local focusRect:Int[4] - CopyRect(focusRect, itemRect) - InflateRect(focusRect, -3, -3) - SetMapMode(tmpDc, MM_TEXT) - DrawFocusRect(tmpDc, focusRect) - EndIf - - Return True - EndMethod - - Method OnCommand(msg,wp) - Select wp Shr 16 - Case BN_CLICKED - Select (style&7) - Case BUTTON_CHECKBOX - Select State()&STATE_INDETERMINATE - Case 0, STATE_INDETERMINATE - SetSelected(True) - Case STATE_SELECTED - SetSelected(False) - EndSelect - EndSelect - - PostGuiEvent EVENT_GADGETACTION,ButtonState(Self) - - 'Fix so that tooltips reappear on Windows XP - Local tmpTooltip$ = GetTooltip() - If tmpTooltip Then SetTooltip("");SetTooltip(tmpTooltip) - - EndSelect - EndMethod - - Method SetPixmap(pixmap:TPixmap,pFlags) - - Local tmpWindowStyle = GetWindowLongW(_hwnd,GWL_STYLE) - - If (pFlags & GADGETPIXMAP_ICON) And (((style&BUTTON_PUSH)=BUTTON_PUSH) Or (style = BUTTON_CANCEL)) Then - - 'To remove an image from a button, a handle-list of -1 should be passed. - If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]);_buttonImageList[0] = -1 - If pixmap Then _buttonImageList[0] = BuildImageList( pixmap ) - - If (pFlags & GADGETPIXMAP_NOTEXT) Then - _buttonImageList[5] = BUTTON_IMAGELIST_ALIGN_CENTER - Else - _buttonImageList[5] = BUTTON_IMAGELIST_ALIGN_LEFT - EndIf - - 'If running Windows XP/Vista, let's use BCM_SETIMAGELIST - - If Not SendMessageW (_hwnd, BCM_SETIMAGELIST, 0, Int Byte Ptr _buttonImageList) Then - 'Otherwise, if this fails we should use BM_SETIMAGE. - - If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]);_buttonImageList[0] = -1 - - If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 - If pixmap Then _iconBitmap = TWindowsGraphic.BitmapFromPixmap( pixmap, True ) - - SendMessageW (_hwnd, BM_SETIMAGE, IMAGE_BITMAP, _iconBitmap) - - EndIf - - 'Show the text if there isn't a pixmap or if we haven't specified GADGETPIXMAP_NOTEXT. - If (Not pixmap) Or Not(pFlags & GADGETPIXMAP_NOTEXT) Then - tmpWindowStyle:&(~BS_BITMAP) - - 'Text isn't hidden on XP image buttons regardless of whether BS_BITMAP is set - 'so we have to hack this in - they must have fixed it on Vista though as it works fine there. - - Super.SetText( GetText() ) - Else - tmpWindowStyle:|BS_BITMAP - - 'Text isn't hidden on XP image buttons regardless of whether BS_BITMAP is set - 'so we have to hack this in - they must have fixed it on Vista though as it works fine there. - - Super.SetText( "" ) - EndIf - - SetWindowLongW _hwnd,GWL_STYLE,tmpWindowStyle - - InvalidateRect _hwnd, Null, False - - Return True - - EndIf - - EndMethod - - Method SetText(pText$) - Local oldText$ = _strButtonText - _strButtonText = pText - If (_buttonImageList[0] < 0 And Not _iconBitmap) Or (oldText = Super.GetText()) Then Super.SetText(pText) - EndMethod - - Method GetText$() - Return _strButtonText - EndMethod - - Method Free() - If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]) - If _iconBitmap Then DestroyIcon( _iconBitmap );_iconBitmap = 0 - _buttonImageList = Null - Super.Free() - EndMethod - - Function BuildImageList(pixmap:TPixmap) - Local bitmap,imagelist,mask - If TWindowsGUIDriver.CheckCommonControlVersion() And (Pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888) - imagelist=ImageList_Create(pixmap.width,pixmap.height,ILC_COLOR32,0,1) - If imagelist - bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, True) - ImageList_Add(imagelist,bitmap,0) - EndIf - EndIf - If imagelist=0 - bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, False) - mask=TWindowsGraphic.BitmapMaskFromPixmap(pixmap) - imagelist=ImageList_Create(pixmap.width,pixmap.height,ILC_COLOR24|ILC_MASK,0,1) - ImageList_Add(imagelist,bitmap,mask) - DeleteObject(mask) - EndIf - DeleteObject(bitmap) - Return imagelist - EndFunction - - Method Class() - Return GADGET_BUTTON - EndMethod - -EndType - -Type TWindowsTextField Extends TWindowsGadget - - Field _busy - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - Self.style = style - xstyle=WS_EX_CLIENTEDGE - wstyle=WS_CHILD|WS_TABSTOP|ES_AUTOHSCROLL|WS_CLIPSIBLINGS - If style&TEXTFIELD_PASSWORD Then wstyle:|ES_PASSWORD - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"EDIT","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - 'SendMessageW hwnd,WM_SETFONT,TWindowsGUIDriver.GDIFont.handle,1 - Register GADGET_TEXTFIELD,hwnd - SetColor(255,255,255) - Return Self - EndMethod - - Method SetText(Text$) - Local p0,p1 - _busy:+1 - SendMessageW _hwnd,EM_GETSEL,Int Byte Ptr Varptr p0,Int Byte Ptr Varptr p1 - Super.SetText(Text) - SendMessageW _hwnd,EM_SETSEL,p0,p1 - _busy:-1 - EndMethod - - Method Activate(cmd) - Select cmd - Case ACTIVATE_CUT - SendMessageW _hwnd,WM_CUT,0,0 - Case ACTIVATE_COPY - SendMessageW _hwnd,WM_COPY,0,0 - Case ACTIVATE_PASTE - SendMessageW _hwnd,WM_PASTE,0,0 - Case ACTIVATE_FOCUS - SendMessageW _hwnd,EM_SETSEL,0,-1 - End Select - Return Super.Activate(cmd) - EndMethod - - Method OnCommand(msg,wp) - If Not _busy - Select (wp Shr 16) - Case EN_UPDATE - PostGuiEvent EVENT_GADGETACTION - Case EN_KILLFOCUS - SendMessageW _hwnd,EM_SETSEL,0,0 - End Select - EndIf - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Local event:TEvent - Select msg - Case WM_ERASEBKGND - Return 1 - Case WM_KEYDOWN - If eventfilter<>Null - event=CreateEvent(EVENT_KEYDOWN,Self,wp,keymods()) - If Not eventfilter(event,context) Return True - EndIf - Case WM_CHAR - If eventfilter<>Null - event=CreateEvent(EVENT_KEYCHAR,Self,wp,keymods()) - If Not eventfilter(event,context) Return True - EndIf - Case WM_KILLFOCUS - PostGuiEvent EVENT_GADGETLOSTFOCUS - End Select - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method Class() - Return GADGET_TEXTFIELD - EndMethod - -EndType - -Type TWindowsTextArea Extends TWindowsGadget - - Global _ClassName:String = Null 'See InitializeLibrary(). - - Global _pagemargin# = 0.5 'Page margin for print-out in inches - - Field _locked - - Field cr1:CHARRANGE=New CHARRANGE - Field cr2:CHARRANGE=New CHARRANGE - Field cf:CHARFORMATW=New CHARFORMATW - - Field ole:IRichEditOLE - Field idoc:ITextDocument - Field busy,readonly - - Field IID_ITextDocument:GUID = New GUID - - Function _InitializeLibrary() - - If Not _ClassName Then - - 'Load RichEdit DLL - If Not LoadLibraryW("msftedit.dll") Then - If LoadLibraryW("riched20.dll") _ClassName = "RichEdit20W" - Else - _ClassName = "RICHEDIT50W" - EndIf - - EndIf - - EndFunction - - Method New() - _InitializeLibrary() - EndMethod - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - Local res - - xstyle=WS_EX_CLIENTEDGE - wstyle=WS_CHILD|WS_VSCROLL|WS_CLIPSIBLINGS - wstyle:|ES_MULTILINE|ES_NOOLEDRAGDROP|ES_NOHIDESEL|ES_LEFT - If Not (style&TEXTAREA_WORDWRAP) wstyle:|WS_HSCROLL|ES_AUTOHSCROLL -' If (style&TEXTAREA_READONLY) wstyle:|ES_READONLY - If (style&TEXTAREA_READONLY) readonly=True - - Self.style = style - - parent=group.query(QUERY_HWND_CLIENT) - - 'RichText control should be made have dimensions of 1x1 pixels to fix Windows XP vertical scrollbar drawing bug. - hwnd=CreateWindowExW(xstyle,_ClassName,"",wstyle,0,0,1,1,parent,hotkey,GetModuleHandleW(Null),Null) - - SendMessageW hwnd,EM_SETLIMITTEXT,4*1024*1024,0 - SendMessageW hwnd,EM_SETEVENTMASK,0,ENM_CHANGE|ENM_MOUSEEVENTS|ENM_SELCHANGE|ENM_KEYEVENTS - SendMessageW hwnd,EM_SETUNDOLIMIT,0,0 - - SendMessageW hwnd,EM_GETOLEINTERFACE,0,Int Byte Ptr Varptr ole - res=IIDFromString(ITextDocument_UUID,IID_ITextDocument) - - res=ole.QueryInterface(IID_ITextDocument,Varptr idoc) - - Register GADGET_TEXTAREA,hwnd - Return Self - EndMethod - - Method Free() - If ole Then ole.Release_ - If idoc Then idoc.Release_ - Super.Free() - EndMethod - - Method Activate(cmd) - Select cmd - Case ACTIVATE_CUT - SendMessageW _hwnd,WM_CUT,0,0 - Case ACTIVATE_COPY - SendMessageW _hwnd,WM_COPY,0,0 - SetFocus _hwnd - Case ACTIVATE_PASTE - DoPaste - Case ACTIVATE_PRINT - DoPrint - Default - Return Super.Activate(cmd) - End Select - EndMethod - - Method DoPaste() - Local h,handle,n - Local w:Short Ptr,cp:Short Ptr - Local tp:Byte Ptr,bp:Byte Ptr - - If OpenClipboard(_hwnd) - If IsClipboardFormatAvailable(CF_UNICODETEXT) - handle=GetClipboardData(CF_UNICODETEXT) - n=GlobalSize(handle) - w=Short Ptr GlobalLock(handle) - h=GlobalAlloc(GMEM_MOVEABLE,n) - cp=Short Ptr GlobalLock(h) - memcpy_(cp,w,n) - If cp[n/2-2]=10 Then cp[n/2-2]=13 - GlobalUnlock h - GlobalUnlock handle - If h - EmptyClipboard - SetClipboardData CF_UNICODETEXT,h - EndIf - ElseIf IsClipboardFormatAvailable(CF_OEMTEXT) - handle=GetClipboardData(CF_OEMTEXT) - n=GlobalSize(handle) - tp=Byte Ptr GlobalLock(handle) - h=GlobalAlloc(GMEM_MOVEABLE,n) - bp=Byte Ptr GlobalLock(h) - memcpy_(bp,tp,n) - If bp[n-2]=10 Then bp[n-2]=13 - GlobalUnlock h - GlobalUnlock handle - If h - EmptyClipboard - SetClipboardData CF_OEMTEXT,h - EndIf - EndIf - CloseClipboard - SendMessageW _hwnd,WM_PASTE,0,0 - SetFocus _hwnd - EndIf - EndMethod - - Method DoPrint() - - Local tmpTextSelLen = TextAreaSelLen(Self) - - Local tmpPrintDialog:PRINTDLGW = New PRINTDLGW - - tmpPrintDialog.flags = PD_RETURNDC | PD_HIDEPRINTTOFILE | PD_NOPAGENUMS - If Not tmpTextSelLen Then tmpPrintDialog.flags:|PD_NOSELECTION - - tmpPrintDialog.hwndOwner = _hwnd - - If Not PrintDlg( Byte Ptr tmpPrintDialog ) Then Return 0 - - Local hdcPrinter = tmpPrintDialog.hdc - - Local tmpDoc:DOCINFOW = New DOCINFOW - Local tmpDocTitle:Short Ptr = AppTitle.ToWString() - tmpDoc.lpszDocName = tmpDocTitle - - Local tmpSuccess = (StartDocW( hdcPrinter, Byte Ptr tmpDoc ) > 0) - - If tmpSuccess Then - - Local _cursor = TWindowsGUIDriver._cursor - - SetPointer( POINTER_WAIT ) - - SetMapMode( hdcPrinter, MM_TEXT ) - - Local wPage = GetDeviceCaps( hdcPrinter, PHYSICALWIDTH ) - Local hPage = GetDeviceCaps( hdcPrinter, PHYSICALHEIGHT ) - Local xPPI = GetDeviceCaps( hdcPrinter, LOGPIXELSX ) - Local yPPI = GetDeviceCaps( hdcPrinter, LOGPIXELSY ) - - Local tmpTextLengthStruct[] = [GTL_DEFAULT,1200] - Local tmpTextLength = SendMessageW (_hwnd, EM_GETTEXTLENGTHEX, Int Byte Ptr tmpTextLengthStruct, 0) - - Local tmpTextPrinted, tmpFormatRange:FORMATRANGE = New FORMATRANGE - - tmpFormatRange.hdc = hdcPrinter - tmpFormatRange.hdcTarget = hdcPrinter - - tmpFormatRange.rcPageRight = (wPage*1440:Long)/xPPI - tmpFormatRange.rcPageBottom = (hPage*1440:Long)/yPPI - - tmpFormatRange.rcLeft = (1440*_pagemargin);tmpFormatRange.rcTop = (1440*_pagemargin) - tmpFormatRange.rcRight = tmpFormatRange.rcPageRight - (2880*_pagemargin) - tmpFormatRange.rcBottom = tmpFormatRange.rcPageBottom - (2880*_pagemargin) - - If tmpPrintDialog.flags & PD_SELECTION Then - tmpTextPrinted = TextAreaCursor(Self) - tmpFormatRange.CHARRANGE_cpMax = tmpTextPrinted+tmpTextSelLen - Else - tmpFormatRange.CHARRANGE_cpMax = tmpTextLength - EndIf - - SendMessageW (_hwnd, EM_FORMATRANGE, False, 0) - - While tmpSuccess And ( tmpTextPrinted < tmpFormatRange.CHARRANGE_cpMax ) - - tmpFormatRange.CHARRANGE_cpMin = tmpTextPrinted - - tmpSuccess = (StartPage(hdcPrinter) > 0) - If Not tmpSuccess Then Exit - - tmpTextPrinted = SendMessageW( _hwnd, EM_FORMATRANGE, True, Int Byte Ptr tmpFormatRange ) - - tmpSuccess = (EndPage(hdcPrinter) > 0) - - Wend - - If tmpSuccess Then EndDoc( hdcPrinter ) Else AbortDoc( hdcPrinter ) - - SendMessageW (_hwnd, EM_FORMATRANGE, False, 0) - - TWindowsGUIDriver._cursor = _cursor - SetCursor _cursor - - EndIf - - GlobalFree( tmpPrintDialog.hDevMode ) - GlobalFree( tmpPrintDialog.hDevNames ) - DeleteDC( hdcPrinter ) - - MemFree tmpDocTitle - - Return tmpSuccess - - EndMethod - - Global gt[] = [GTL_DEFAULT, CP_ACP] - - Method CharCount() - Return SendMessageW(_hwnd,EM_GETTEXTLENGTHEX,Int Byte Ptr gt,0) - EndMethod - - Method SetStyle(r,g,b,flags,pos,length,units) - Local iifont:ITextFont - Local iirange:ITextRange - Local res, tmpOutput - If units=TEXTAREA_LINES - Local n=pos - pos=CharAt(pos) - If length>=0 length=CharAt(n+length)-pos - EndIf - If length<0 length=charcount()-pos - busy:+1 - res=idoc.Range(pos,pos+length,iirange) - res=iirange.GetFont(iifont) - res=iifont.SetForeColor(((b Shl 16)|(g Shl 8)|r)) - If (flags&TEXTFORMAT_BOLD) Then iifont.SetBold(TOMTRUE) Else iifont.SetBold(TOMFALSE) - If (flags&TEXTFORMAT_ITALIC) Then iifont.SetItalic(TOMTRUE) Else iifont.SetItalic(TOMFALSE) - If (flags&TEXTFORMAT_UNDERLINE) Then iifont.SetUnderline(TOMSINGLE) Else iifont.SetUnderline(TOMFALSE) - If (flags&TEXTFORMAT_STRIKETHROUGH) Then iifont.SetStrikeThrough(TOMTRUE) Else iifont.SetStrikeThrough(TOMNONE) - iifont.Release_ - iirange.Release_ - busy:-1 - EndMethod - - Method InsertText(Text$,pos,count) - Local iirange:ITextRange - Local bstr:Short Ptr, tmpWString:Short Ptr = Text.toWString() - Local res, bool - busy:+1 - res=idoc.Range(pos,pos+count,iirange) - bstr=SysAllocStringLen(tmpWString,Text.length);MemFree tmpWString - LockText() - res=iirange.SetText(bstr) - UnlockText() - SysFreeString bstr - iirange.Release_ - busy:-1 - EndMethod - - Method ReplaceText(pos,length,Text$,units) - If units=TEXTAREA_LINES - Local n=pos - pos=CharAt(pos) - If length>=0 length=CharAt(n+length)-pos - EndIf - If length<0 Then length=charcount()-pos - InsertText Text,pos,length - EndMethod - - Method AreaText$(pos,length,units) - Local iirange:ITextRange - Local bstr:Short Ptr - - If units=TEXTAREA_LINES - Local n=pos - pos=CharAt(pos) - If length>=0 length=CharAt(n+length)-pos - EndIf - If length<0 length=charcount()-pos - idoc.Range(pos,pos+length,iirange) - iirange.GetText(Varptr bstr) - Local Text$=String.FromWString(bstr) - SysFreeString bstr - iirange.Release_ - Text=Text.Replace(Chr(13),Chr(10)) - Return Text - EndMethod - - Method SetSelection(pos,length,units) - If units=TEXTAREA_LINES - Local n=pos - pos=CharAt(pos) - If length>0 - length=CharAt(n+length) - length=length-pos - EndIf - EndIf - If length<0 length=charcount()-pos - Local cr:CHARRANGE = New CHARRANGE - cr.cpMin=pos - cr.cpMax=pos+length - Desensitize() - SendMessageW _hwnd,EM_EXSETSEL,0,Int Byte Ptr(cr) - Sensitize() - EndMethod - - Method SetMargins(leftmargin) - SendMessageW _hwnd,EM_SETMARGINS,EC_LEFTMARGIN,leftmargin - EndMethod - - ' 72 points per inch - - Method SetTabs(tabs) - Local hdc=GetDC( 0 ) - idoc.SetDefaultTabStop tabs * 72.0 / GetDeviceCaps( hdc,LOGPIXELSX ) - ReleaseDC 0,hdc - EndMethod - - Method SetTextColor(r,g,b) - cf.cbSize=SizeOf(CHARFORMATW) - cf.dwMask=CFM_COLOR|CFM_BOLD|CFM_ITALIC - cf.crTextColor=(b Shl 16)|(g Shl 8)|r - SendMessageW _hwnd,EM_SETCHARFORMAT,SCF_DEFAULT,Int Byte Ptr cf - SendMessageW _hwnd,EM_SETCHARFORMAT,SCF_ALL,Int Byte Ptr cf - EndMethod - - Method SetColor(r,g,b) - SendMessageW _hwnd,EM_SETBKGNDCOLOR,0,((b Shl 16)|(g Shl 8)|r) - EndMethod - - Method RemoveColor() - SendMessageW _hwnd,EM_SETBKGNDCOLOR,1,0 - EndMethod - - Method GetCursorPos(units) - Local cr:CHARRANGE = New CHARRANGE - SendMessageW _hwnd,EM_EXGETSEL,0,Int Byte Ptr(cr) - Local pos=cr.cpMin - If units=TEXTAREA_LINES pos=LineAt(pos) - Return pos - EndMethod - - Method GetSelectionLength(units) - Local cr:CHARRANGE = New CHARRANGE - SendMessageW _hwnd,EM_EXGETSEL,0,Int Byte Ptr(cr) - If units=TEXTAREA_LINES - Return LineAt(cr.cpMax-1)-LineAt(cr.cpMin)+1 - Else - Return cr.cpMax-cr.cpMin - EndIf - EndMethod - - Method CharAt(Line) - If Line<0 Return - If Line>AreaLen(TEXTAREA_LINES) Return charcount() - Return SendMessageW(_hwnd,EM_LINEINDEX,Line,0) - EndMethod - - Method LineAt(pos) - If pos<0 Return - If pos>charcount() Return AreaLen(TEXTAREA_LINES) - Return SendMessageW(_hwnd,EM_EXLINEFROMCHAR,0,pos) - EndMethod - - Method AreaLen(units) - If units=TEXTAREA_LINES Return LineAt(charcount()) - Return charcount() - EndMethod - - Method CharX( char ) - Local tmpPoint[2] - SendMessageW(_hwnd, EM_POSFROMCHAR, Int Byte Ptr tmpPoint, char ) - Return tmpPoint[0] - EndMethod - - Method CharY( char ) - Local tmpPoint[2] - SendMessageW(_hwnd, EM_POSFROMCHAR, Int Byte Ptr tmpPoint, char ) - Return tmpPoint[1] - EndMethod - - Method SetText(Text$) - InsertText Text,0,charcount() - EndMethod - - Method AddText(Text$) - InsertText Text,charcount(),0 - Local cr:CHARRANGE = New CHARRANGE - Local p = charcount() - cr.cpMin=p - cr.cpMax=p - SendMessageW _hwnd,EM_EXSETSEL,0,Int Byte Ptr(cr) - EndMethod - - Method GetText$() - Return AreaText(0,charcount(),TEXTAREA_CHARS) - EndMethod - - Global _oldCursor = 0 - Field _oldSelPos%, _oldSelLen% = 0 - - Method LockText() - - If Not idoc.Freeze(_locked) - _oldSelPos = GetCursorPos(TEXTAREA_CHARS) - _oldSelLen = GetSelectionLength(TEXTAREA_CHARS) - If Not _oldCursor Then _oldCursor = GetCursor() - EndIf - - EndMethod - - Method UnlockText() - - If idoc.Unfreeze(_locked) = S_OK Then - SetSelection( _oldSelPos, _oldSelLen, TEXTAREA_CHARS ) - If _oldCursor And (_oldCursor <> GetCursor()) Then - SetCursor(_oldCursor) - EndIf - _oldCursor = 0 - EndIf - - EndMethod - - Method OnCommand(msg,wp) - If busy Then Return - Select wp Shr 16 - Case EN_CHANGE - If Not _locked Then PostGuiEvent EVENT_GADGETACTION - End Select - EndMethod - - Method OnNotify(wp,lp) - Local nmhdr:Int Ptr - Local event:TEvent - - Super.OnNotify(wp,lp) 'Tooltip - - nmhdr=Int Ptr(lp) - Select nmhdr[2] -' Case EN_PROTECTED -' DebugStop - Case EN_SELCHANGE - If Not (busy Or _locked) - PostGuiEvent EVENT_GADGETSELECT - EndIf - Case EN_MSGFILTER - Select nmhdr[3] - Case WM_RBUTTONDOWN - If GetSelectionLength(TEXTAREA_CHARS)=0 nmhdr[3]=WM_LBUTTONDOWN - Case WM_RBUTTONUP - Local mx=nmhdr[5] & $ffff - Local my=nmhdr[5] Shr 16 - PostGuiEvent EVENT_GADGETMENU,0,0,mx,my - Case WM_KEYDOWN - - Local k=nmhdr[4] - - 'Filtering out special shortcut combinations - If (keymods()&MODIFIER_CONTROL) Then - Select k - Case 76,69,82 'ctrl+l, ctrl+e, ctrl+r - Return 1 'Alignment shortcuts - - Case 188,190 'ctrl+<, ctrl+> - 'Font size shortcuts - If (keymods()&MODIFIER_SHIFT) Then Return 1 - EndSelect - EndIf - - 'Read-only - If readonly - If k>=33 And k<=40 Return 0 'selection keys - If (keymods()&MODIFIER_CONTROL) Then - Select k - Case 65, 67;Return 0 'ctrl-a, ctrl+c - EndSelect - EndIf - Return 1 - EndIf - - 'Event Filter - If eventfilter<>Null - event=CreateEvent(EVENT_KEYDOWN,Self,k,keymods()) - Return Not eventfilter(event,context) - EndIf - - Case WM_CHAR - If readonly Return 1 - If eventfilter<>Null - event=CreateEvent(EVENT_KEYCHAR,Self,nmhdr[4],keymods()) - Return Not eventfilter(event,context) - EndIf - End Select - End Select - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - - Case WM_MOUSEWHEEL - If (wp&MK_CONTROL) Then SendMessageW _hwnd, EM_SETZOOM, 0, 0 - - Case WM_KILLFOCUS - PostGuiEvent EVENT_GADGETLOSTFOCUS - - End Select - - Return Super.WndProc(hwnd,msg,wp,lp) - - EndMethod - - Method Class() - Return GADGET_TEXTAREA - EndMethod - -EndType - -Type TWindowsListBox Extends TWindowsGadget - - Field _icons:TWindowsIconStrip - Field _selected = -1 - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - - Self.style = style - - xstyle=WS_EX_CLIENTEDGE - wstyle=WS_CHILD|WS_TABSTOP|LVS_REPORT|LVS_NOCOLUMNHEADER|LVS_SHOWSELALWAYS|LVS_SHAREIMAGELISTS - wstyle:|WS_CLIPSIBLINGS - - If (style&LISTBOX_MULTISELECT<>LISTBOX_MULTISELECT) Then wstyle:|LVS_SINGLESEL - - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"SysListView32","",wstyle,0,0,20,20,parent,hotkey,GetModuleHandleW(Null),Null) - - Local column:LVCOLUMNW - column=New LVCOLUMNW - SendMessageW hwnd,LVM_INSERTCOLUMNW,0,Int Byte Ptr(column) - - SendMessageW hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,LVS_EX_FULLROWSELECT|LVS_EX_INFOTIP,LVS_EX_FULLROWSELECT|LVS_EX_INFOTIP - - If TWindowsGUIDriver.CheckCommonControlVersion() Then SendMessageW hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,LVS_EX_DOUBLEBUFFER,LVS_EX_DOUBLEBUFFER - - Register GADGET_LISTBOX,hwnd,0,False 'Set to True for normal Tooltips - - If TWindowsGUIDriver._explorerstyle Then UseExplorerTheme() - - Return Self - EndMethod - - Method SetColor(r,g,b) - SendMessageW _hwnd,LVM_SETBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r - SendMessageW _hwnd,LVM_SETTEXTBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - Method RemoveColor() - SendMessageW _hwnd,LVM_SETBKCOLOR ,1,0 - SendMessageW _hwnd,LVM_SETTEXTBKCOLOR ,1,0 - EndMethod - - Method SetTextColor(r,g,b) - SendMessageW _hwnd,LVM_SETTEXTCOLOR,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - 'Hack: When image lists are removed from listviews, the items don't - 'reposition themselves automatically. Hack involves first setting a tiny - 'blank image-list to update item size, before attempting to remove it. - Method SetIconStrip(iconstrip:TIconStrip) - Local imagelist - If Not iconstrip Then - _icons = TWindowsIconStrip.CreateBlank() - Else - _icons = TWindowsIconStrip(iconstrip) - EndIf - If _icons Then imagelist = _icons._imagelist - SendMessageW _hwnd,LVM_SETIMAGELIST,LVSIL_SMALL,imagelist - If Not iconstrip Then - SendMessageW _hwnd,LVM_SETIMAGELIST,LVSIL_SMALL,0 - _icons = Null - EndIf - EndMethod - - Method ClearListItems() - _selected=-1 - DeSensitize() - SendMessageW _hwnd,LVM_DELETEALLITEMS,0,0 - If Not IsSingleSelect() Then SelectionChanged() - Sensitize() - EndMethod - - Method InsertListItem(index,Text$,tip$,icon,tag:Object) - - Local it:LVITEMW - it=New LVITEMW - it.mask=LVIF_TEXT|LVIF_DI_SETITEM - it.iItem=index - it.pszText=Text.toWString() - - 'If icon>=0 Then - it.mask:|LVIF_IMAGE - it.iImage=icon - 'EndIf - - Desensitize() - SendMessageW _hwnd,LVM_INSERTITEMW,0,Int Byte Ptr(it) - SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 - If Not IsSingleSelect() Then SelectionChanged() - Sensitize() - MemFree it.pszText - - EndMethod - - Method SetListItem(index,Text$,tip$,icon,tag:Object) - Local tmpReselect - If ListItemState(index) & STATE_SELECTED Then tmpReselect = True - RemoveListItem index - InsertListItem index,Text,tip,icon,tag - If tmpReselect Then SetItemState(index,STATE_SELECTED) - EndMethod - - Method RemoveListItem(index) - Desensitize() - If ListItemState(index) & STATE_SELECTED Then _selected = -1 - SendMessageW _hwnd,LVM_DELETEITEM,index,0 - SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 - If Not IsSingleSelect() Then SelectionChanged() - Sensitize() - EndMethod - - Method SetListItemState(index,state) - Local it:LVITEMW = New LVITEMW - it.mask=LVIF_STATE - it.iItem=index - If state&STATE_SELECTED - it.state=LVIS_SELECTED - If IsSingleSelect() Then _selected=index - ElseIf _selected=index - _selected=-1 - EndIf - it.stateMask=LVIS_SELECTED - Desensitize() - SendMessageW _hwnd,LVM_SETITEMSTATE,index,Int Byte Ptr(it) - If it.state Then SendMessageW _hwnd,LVM_ENSUREVISIBLE,index,False - If Not IsSingleSelect() Then SelectionChanged() - Sensitize() - EndMethod - - Method ListItemState(index) - Local state = SendMessageW(_hwnd,LVM_GETITEMSTATE,index,LVIS_SELECTED) - If state&LVIS_SELECTED Return STATE_SELECTED - EndMethod - - Method SetTooltip( pTooltip$ ) - 'ToolTips should be set on an item-by-item basis instead. - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_MAXGUILISTREFRESH - Local index - - If IsSingleSelect() Then - index=SendMessageW(_hwnd,LVM_GETNEXTITEM,-1,LVNI_SELECTED) - Else - index = SelectionChanged() - EndIf - If index <> _selected Then - If IsSingleSelect() Then _selected = index - Local item:TGadgetItem = New TGadgetItem - If index>=0 And index=0 And index-1 - _selected=-1 - PostGuiEvent EVENT_GADGETSELECT,-1 - EndIf - Case NM_RCLICK - index=nmhdr[3] - Local item:TGadgetItem - If index>=0 And indexLISTBOX_MULTISELECT) - EndMethod - - Method Class() - Return GADGET_LISTBOX - EndMethod - - Method HasResized() - SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 - EndMethod - - Method UseExplorerTheme() - If TWindowsGUIDriver.CheckCommonControlVersion() And SetWindowThemeW Then SetWindowThemeW( _hwnd, _wstrExplorer, Null ) - EndMethod - -EndType - -Type TWindowsComboBox Extends TWindowsGadget - - Field _icons:TWindowsIconStrip - Field _editHwnd, _comboHwnd - Field _selected = -1 - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey,hwnd - Local parent,editstyle,combostyle - - Self.style = style - wstyle=WS_CHILD|WS_TABSTOP|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|CBS_AUTOHSCROLL - If (style & COMBOBOX_EDITABLE) Then wstyle:|CBS_DROPDOWN Else wstyle:|CBS_DROPDOWNLIST - - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"ComboBoxEx32","",wstyle,0,0,0,180,parent,hotkey,GetModuleHandleW(Null),Null) - - If (style & COMBOBOX_EDITABLE) Then - _editHwnd=SendMessageW(hwnd,CBEM_GETEDITCONTROL,0,0) - If _editHwnd Then - editstyle=GetWindowLongW(_editHwnd,GWL_STYLE) - SetWindowLongW _editHwnd,GWL_STYLE,editstyle|WS_TABSTOP - EndIf - EndIf - - _comboHwnd=SendMessageW(hwnd,CBEM_GETCOMBOCONTROL,0,0) - comboStyle=GetWindowLongW(_comboHwnd,GWL_STYLE) - SetWindowLongW _comboHwnd,GWL_STYLE,comboStyle|WS_TABSTOP - - Register GADGET_COMBOBOX,hwnd - - TWindowsGUIDriver.RegisterHwnd(_combohwnd,Self) - If _edithwnd Then TWindowsGUIDriver.RegisterHwnd(_edithwnd,Self) - - SetColor(255,255,255) - - Return Self - - EndMethod - - Method SetText(Text$) - If Not _editHwnd Then - Local tmpWString:Short Ptr = Text.ToWString() - Local tmpResult = SendMessageW(_comboHwnd, CB_SETCUEBANNER, 0, Int(tmpWString)) - MemFree tmpWString;Return tmpResult - Else - Return Super.SetText(Text) - EndIf - EndMethod - - Method GetText$() - If Not _editHwnd Then - If _selected > -1 Then Return items[_selected].Text Else Return "" - Else - Return Super.GetText() - EndIf - EndMethod - - Method Activate(cmd) - If _editHwnd Then - Select cmd - Case ACTIVATE_CUT - SendMessageW _editHwnd,WM_CUT,0,0 - Case ACTIVATE_COPY - SendMessageW _editHwnd,WM_COPY,0,0 - SetFocus _hwnd - Case ACTIVATE_PASTE - SendMessageW _editHwnd,WM_PASTE,0,0 - Case ACTIVATE_FOCUS - SendMessageW _editHwnd,EM_SETSEL,0,-1 - End Select - EndIf - Return Super.Activate(cmd) - EndMethod - - Method SetIconStrip(iconstrip:TIconStrip) - Local imagelist - _icons=TWindowsIconStrip(iconstrip) - If _icons Then imagelist = _icons._imagelist - SendMessageW _hwnd,CBEM_SETIMAGELIST,LVSIL_SMALL,imagelist - EndMethod - - Method ClearListItems() - _selected=-1 - Desensitize() - SendMessageW _hwnd,CB_RESETCONTENT,0,0 - Sensitize() - EndMethod - - Method InsertListItem(index,Text$,tip$,icon,tag:Object) - Local it:COMBOBOXEXITEMW = New COMBOBOXEXITEMW - it.mask=CBEIF_TEXT - it.iItem=index - it.pszText=Text.toWString() - If icon>=0 - it.mask:|CBEIF_IMAGE|CBEIF_SELECTEDIMAGE - it.iImage=icon - it.iSelectedImage=icon - EndIf - Desensitize() - SendMessageW(_hwnd,CBEM_INSERTITEMW,0,Int Byte Ptr(it)) - Sensitize() - MemFree it.pszText - EndMethod - - Method SetListItem(index,Text$,tip$,icon,tag:Object) - Local it:COMBOBOXEXITEMW = New COMBOBOXEXITEMW - it.mask=CBEIF_TEXT - it.iItem=index - it.pszText=Text.toWString() - If _icons And icon>-1 - it.mask:|CBEIF_IMAGE|CBEIF_SELECTEDIMAGE - it.iImage=icon - it.iSelectedImage=icon - EndIf - Desensitize() - SendMessageW(_hwnd,CBEM_SETITEMW,0,Int Byte Ptr(it)) - Sensitize() - MemFree it.pszText - EndMethod - - Method RemoveListItem(index) - Desensitize() - SendMessageW _hwnd,CBEM_DELETEITEM,index,0 - Sensitize() - EndMethod - - Method SetListItemState(index,state) - If state&STATE_SELECTED - _selected=index - Else - If _selected=index _selected=-1 - index=-1 - EndIf - Desensitize() - SendMessageW _hwnd,CB_SETCURSEL,index,0 - Sensitize() - EndMethod - - Method ListItemState(index) - Local Current,state - Current=SendMessageW(_hwnd,CB_GETCURSEL,0,0) - If Current=CB_ERR Current=-1 - If Current=index state=STATE_SELECTED - Return state - EndMethod - - Method OnCommand(msg,wp) - Local index - Select wp Shr 16 - Case CBN_SELCHANGE - index=SendMessageW(_hwnd,CB_GETCURSEL,0,0) - If index=CB_ERR - index=-1 - Else - If _selected<>index 'user generated event - _selected=index - Local extra:Object - If index>=0 And index tmpHeight Then - TWindowsGadget(parent)._clientY = tmpHeight - parent.Rethink() - TWindowsGadget(parent).RethinkClient() - parent.LayoutKids() - EndIf - EndMethod - - Method DoLayout() - Rethink() - EndMethod - - Method SetTooltip( pTooltip$ ) - 'ToolTips should be set on an item-by-item basis instead. - EndMethod - - Method ClearListItems() - While SendMessageW(_hwnd,TB_BUTTONCOUNT,0,0) - RemoveListItem(0) - Wend - EndMethod - - Method InsertListItem(index,Text$,tip$,icon,tag:Object) - Local but:TBBUTTON - but=New TBBUTTON - but.fsState=TBSTATE_ENABLED - If icon = -2 Or (icon>-1 And _icons.IsBlankIcon(icon)) - but.idCommand=0 - but.fsStyle=TBSTYLE_SEP - Else - but.iBitmap=icon - but.idCommand=index+1 - but.fsStyle=TBSTYLE_BUTTON - EndIf - Desensitize() - SendMessageW _hwnd,TB_INSERTBUTTON,index,Int Byte Ptr(but) - Sensitize() - If tip - Local ti:TOOLINFOW=New TOOLINFOW - ti.cbSize=SizeOf(ti) - ti.uFlags=TTF_SUBCLASS - ti.hwnd=_hwnd - ti.lpszText=tip.towstring() - ti.uId=index+1 - SendMessageW _hwnd,TB_GETITEMRECT,index,Int(Varptr ti.rect_left) - SendMessageW _tooltips,TTM_ADDTOOLW,0,Int Byte Ptr(ti) - MemFree ti.lpszText - EndIf - EndMethod - - Method SetListItem(index,Text$,tip$,icon,tag:Object) - Local tmpState:Int = ListItemState(index) - RemoveListItem index - InsertListItem index,Text,tip,icon,tag - SetListItemState(index,tmpState) - EndMethod - - Method RemoveListItem(index) - Local ti:TOOLINFOW=New TOOLINFOW - ti.cbSize=SizeOf(ti) - ti.hwnd=_hwnd - ti.uId=index+1 - Desensitize() - SendMessageW _tooltips,TTM_DELTOOLW,0,Int(Varptr ti) - SendMessageW _hwnd,TB_DELETEBUTTON,index,0 - Sensitize() - EndMethod - - Method SetListItemState(index,state) - Local enable,pressed - If state&STATE_DISABLED=0 enable=$1 - If state&STATE_SELECTED pressed=$1 - SendMessageW _hwnd,TB_ENABLEBUTTON,index+1,enable - SendMessageW _hwnd,TB_CHECKBUTTON,index+1,pressed - EndMethod - - Method ListItemState(index) - Local state,flags - state=SendMessageW(_hwnd,TB_GETSTATE,index+1,0) - If state=-1 Return 0 - If Not (state&TBSTATE_ENABLED) flags:|STATE_DISABLED - If state&TBSTATE_CHECKED flags:|STATE_SELECTED - Return flags - EndMethod - - Method OnCommand(msg,wp) - Local index=wp-1 - Local extra:Object - If index>=0 And indexRect[0] Then Return Rect[2]-Rect[0] - EndMethod - - Method ClientHeight() - Local Rect[] = [0,0,width,height] - SendMessageW _hwnd,TCM_ADJUSTRECT,False,Int Byte Ptr(Rect) - If Rect[3]>Rect[1] Then Return Rect[3]-Rect[1] - EndMethod - - Method ClearListItems() - _tabcount=0 - _selected=-1 - Desensitize() - SendMessageW _hwnd,TCM_DELETEALLITEMS, 0, 0 - Sensitize() - RethinkClient() - EndMethod - - Method InsertListItem(index,Text$,tip$,icon,tag:Object) - If _tabcount=0 SendMessageW _hwnd,TCM_DELETEALLITEMS,0,0 - Local t:TCITEMW=New TCITEMW - t.mask=TCIF_TEXT|TCIF_IMAGE - t.pszText=Text.toWString() - t.iImage=icon - Desensitize() - SendMessageW _hwnd,TCM_INSERTITEMW,index,Int Byte Ptr(t) - Sensitize() - MemFree t.pszText - _tabcount:+1 - RethinkClient() - EndMethod - - Method SetListItem(index,Text$,tip$,icon,tag:Object) - Local t:TCITEMW=New TCITEMW - t.mask=TCIF_TEXT|TCIF_IMAGE - t.pszText=Text.toWString() - t.iImage=icon - Desensitize() - SendMessageW _hwnd,TCM_SETITEMW,index,Int Byte Ptr(t) - Sensitize() - MemFree t.pszText - RethinkClient() - EndMethod - - Method RemoveListItem(index) - Desensitize() - SendMessageW _hwnd,TCM_DELETEITEM,index,0 - _tabcount:-1 - _selected=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) - If _tabcount=0 SendMessageW _hwnd,TCM_INSERTITEMW,0,Int(_blank) - Sensitize() - RethinkClient() - EndMethod - - Method SetListItemState(index,state) - Desensitize() - If state&STATE_SELECTED - _selected=index - SendMessageW _hwnd,TCM_SETCURSEL,index,0 - ElseIf _selected=index - _selected=-1 - EndIf - Sensitize() - EndMethod - - Method ListItemState(index) - Local state,Current - Current=-1 - If _tabcount Current=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) - If Current=index state:|STATE_SELECTED - Return state - EndMethod - - Method OnNotify(wp,lp) - Local nmhdr:Int Ptr 'hwnd,id,code - Local index - nmhdr=Int Ptr(lp) - Select nmhdr[2] - - Case TTN_GETDISPINFOW - - Local TCHITTESTINFO[3], Rect[4] - - GetCursorPos_( TCHITTESTINFO );GetWindowRect( _hwnd, Rect ) - TCHITTESTINFO = [TCHITTESTINFO[0]-Rect[0],TCHITTESTINFO[1]-Rect[1],0] - - Local tmpItem = SendMessageW( _hwnd, TCM_HITTEST, 0, Int Byte Ptr TCHITTESTINFO ) - - If (tmpItem > -1) And (tmpItem < items.length) Then - Local tmpTooltip$ = items[tmpItem].tip - If (items[tmpItem].flags&GADGETITEM_LOCALIZED) Then tmpTooltip = LocalizeString(tmpTooltip) - SetTipBuffer( tmpTooltip ) - If tmpTooltip Then nmhdr[3] = Int(_tipbuffer) - EndIf - - Case TCN_SELCHANGE - If _tabcount - index=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) - If index<>_selected - Local extra:Object - If index>=0 And index= items.length) Then index = -1 Else extra = items[index].extra - - PostGuiEvent EVENT_GADGETMENU,index,0,TCHITTESTINFO[0],TCHITTESTINFO[1],extra - - EndSelect - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_ERASEBKGND - Select hwnd - Case _hwndclient - If DrawThemeParentBackground Then - DrawParentBackground(wp,hwnd) - Return 1 - EndIf - EndSelect - End Select - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method RethinkClient(forceRedraw:Int = False) - Local Rect[] = [0,0,width,height] - SendMessageW _hwnd,TCM_ADJUSTRECT,False, Int Byte Ptr(Rect) - MoveWindow _hwndclient,Rect[RECT_LEFT],Rect[RECT_TOP],Rect[RECT_RIGHT]-Rect[RECT_LEFT],Rect[RECT_BOTTOM]-Rect[RECT_TOP],forceRedraw - EndMethod - - Method SetTipBuffer( pTip$ ) - If _tipbuffer Then MemFree _tipbuffer - If pTip Then _tipbuffer = pTip.ToWString() - EndMethod - - Method SetTooltip( pTooltip$ ) - 'ToolTips should be set on an item-by-item basis instead. - EndMethod - - Method Class() - Return GADGET_TABBER - EndMethod - -EndType - -Type TWindowsTreeNode Extends TGadget - Field _parent:TWindowsTreeNode - Field _tree 'HWND - Field _item 'HTREEITEM - Field _expanded - Field _icon - Field _handle - - Method Activate(cmd) - Local tmpTree:TWindowsTreeView = TWindowsTreeView(TWindowsGUIDriver.GadgetFromHwnd(_tree)) - If tmpTree Then tmpTree.Desensitize() - Select cmd - Case ACTIVATE_SELECT - If _item <> TVI_ROOT Then - SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,_item - Else - SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,0 - EndIf - Case ACTIVATE_EXPAND - SendMessageW _tree,TVM_EXPAND,TVE_EXPAND,_item - _expanded=True - Case ACTIVATE_COLLAPSE - SendMessageW _tree,TVM_EXPAND,TVE_COLLAPSE,_item - _expanded=False - Case ACTIVATE_REDRAW - RedrawNode() - End Select - If tmpTree Then tmpTree.Sensitize() - EndMethod - - Method CreateRoot:TWindowsTreeNode(owner:TWindowsTreeView) - _tree=owner._hwnd - _item=TVI_ROOT - Return Self - EndMethod - - Method CountKids() - Return kids.count() - EndMethod - - Method Create:TWindowsTreeNode(group:TGadget,style,Text$="",index=-1,icon = -1) - _parent=TWindowsTreeNode(group) - If Not _parent Throw "Parent isn't a treeview node. Use TreeViewRoot() when creating a root node." - Self.style = style - _tree=_parent._tree - _icon = icon - Spawn(Text,index) - _SetParent group,index - If (LocalizationMode()&LOCALIZATION_OVERRIDE) Then - LocalizeGadget(Self, Text, "") - EndIf - Return Self - EndMethod - - Method GetText$() - Local item[10] - Local buffer:Short[260] - item[0]=TVIF_TEXT - item[1]=_item - item[4]=Int Byte Ptr buffer - item[5]=256 - SendMessageW _tree,TVM_GETITEMW,0,Int Byte Ptr(item) - Return String.FromWString(buffer) - EndMethod - - Method SetText(Text$) - Local tv:TVITEMW=New TVITEMW - tv.mask=TVIF_HANDLE|TVIF_TEXT - tv.hItem = _item - If _icon > -1 Then - tv.mask:|TVIF_IMAGE|TVIF_SELECTEDIMAGE - tv.iImage=_icon - tv.iSelectedImage=tv.iImage - EndIf - tv.pszText=Text.ToWString() - SendMessageW(_tree,TVM_SETITEMW,0,Int Byte Ptr tv) - MemFree tv.pszText - EndMethod - - Method DoLayout() - 'Don't do anything! - EndMethod - - Method Free() - 'If we don't have a parent then the node must have previously been freed. - If Not _parent Then Return - 'Avoid firing events when freeing a treenode that is selected. - If SendMessageW(_tree,TVM_GETNEXTITEM,TVGN_CARET,0) Then DeSelect() - 'Free treenode - If _item Then SendMessageW(_tree,TVM_DELETEITEM,0,_item);_item=0 - 'Redraw parent if we were its last child node - If Not SendMessageW(_tree, TVM_GETNEXTITEM, TVGN_CHILD, _parent._item) Then _parent.RedrawNode() - 'Cleanup variables that could be circular references - _parent = Null;_tree = 0;_SetParent Null - 'Release any handle we created using HandleFromObject() in Spawn() - If _handle Then Release _handle - EndMethod - - Method DeSelect() - SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,0 - EndMethod - - Method InsertNode:TGadget(index,Text$,icon) - Return New TWindowsTreeNode.Create(Self,0,Text,index,icon) - EndMethod - - Method ModifyNode(Text$,icon) - _icon = icon - SetText Text - EndMethod - - Method tviatindex(index) - If kids.IsEmpty() Then Return TVI_FIRST - If index<0 Or index>=kids.count() Return TVI_LAST - Local child:TWindowsTreeNode - child=TWindowsTreeNode(kids.valueatindex(index)) - Return child._item - EndMethod - - Method Spawn(name$,index=-1) - - Local it:TVINSERTSTRUCTW - Local hitem - it=New TVINSERTSTRUCTW - it.hParent=_parent._item - If index = 0 Then - it.hInsertAfter = TVI_FIRST - Else - it.hInsertAfter=_parent.tviatindex(index-1) - EndIf - it.item_mask=TVIF_TEXT|TVIF_PARAM - - If _icon > -1 Then - it.item_mask:|TVIF_IMAGE|TVIF_SELECTEDIMAGE - it.item_iImage=_icon - it.item_iSelectedImage=it.item_iImage - EndIf - - Local tmpParentHadKids = SendMessageW(_tree, TVM_GETNEXTITEM, TVGN_CHILD, _parent._item) - - it.item_pszText=name.ToWString() - it.item_lparam=HandleFromObject(Self) - - 'Make sure that we store handle so we can release it later. - If _handle Then Release _handle - _handle = it.item_lparam - - _item=SendMessageW(_tree,TVM_INSERTITEMW,0,Int Byte Ptr it) - - MemFree it.item_pszText - - 'Fix for tree-view parent status update problem. - If Not tmpParentHadKids Then _parent.RedrawNode() - - Return _item - - EndMethod - - Method RedrawNode() - - If _item = TVI_ROOT Then - InvalidateRect _tree, Null, True - Else - Local Rect[] = [_item,0,0,0] - If SendMessageW(_tree, TVM_GETITEMRECT, False, Int Byte Ptr Rect) Then - InvalidateRect _tree, Rect, True - EndIf - EndIf - - EndMethod - - Method SetTooltip( pTooltip$ ) - 'At the moment, nodes don't support tooltips. - EndMethod - - Method Class() - Return GADGET_NODE - EndMethod - -EndType - -Type TWindowsTreeView Extends TWindowsGadget - - Field _root:TWindowsTreeNode - Field _selected:TWindowsTreeNode - Field _icons:TWindowsIconStrip - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - - Self.style = style - xstyle=WS_EX_CLIENTEDGE - wstyle=WS_CHILD|TVS_HASLINES|TVS_HASBUTTONS|TVS_LINESATROOT|TVS_SHOWSELALWAYS|TVS_NOTOOLTIPS|WS_CLIPSIBLINGS - If Not(style&TREEVIEW_DRAGNDROP) wstyle:|TVS_DISABLEDRAGDROP - - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"SysTreeView32","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - If TWindowsGUIDriver.CheckCommonControlVersion() Then SendMessageW hwnd, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER - Register GADGET_TREEVIEW,hwnd - _root=New TWindowsTreeNode.CreateRoot(Self) - - If TWindowsGUIDriver._explorerstyle Then UseExplorerTheme() - - Return Self - - EndMethod - - Method SetIconStrip(iconstrip:TIconStrip) - _icons=TWindowsIconStrip(iconstrip) - SendMessageW _hwnd,TVM_SETIMAGELIST,TVSIL_NORMAL,_icons._imagelist - EndMethod - - Method SetColor(r,g,b) - SendMessageW _hwnd,TVM_SETBKCOLOR,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - Method RemoveColor() - SendMessageW _hwnd,TVM_SETBKCOLOR,1,0 - EndMethod - - Method SetTextColor(r,g,b) - SendMessageW _hwnd,TVM_SETTEXTCOLOR,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - Method RootNode:TGadget() - Return _root - EndMethod - - Method SelectedNode:TGadget() - Return _selected - EndMethod - - Method CountKids() - Return _root.CountKids() - EndMethod - - Method OnNotify(wp,lp) - Local nmhdr:Int Ptr - Local itemnew:Int Ptr - Local node:TWindowsTreeNode - - Super.OnNotify(wp,lp) 'Tool-tips - - nmhdr=Int Ptr(lp) - Select nmhdr[2] 'code - - 'MSLU glitch requires handling of ANSI equivalent - Case TVN_SELCHANGEDW, TVN_SELCHANGEDA - itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew - If itemnew[1]=TVI_ROOT 'hItem - _selected=_root - Else - _selected=TWindowsTreeNode(HandleToObject(itemnew[9])) 'lParaM - EndIf - PostGuiEvent EVENT_GADGETSELECT,0,0,0,0,_selected - - Case TVN_ITEMEXPANDEDW, TVN_ITEMEXPANDEDA - itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew.TVITEM - If itemnew[1]=TVI_ROOT 'hItem - node=_root - Else - node=TWindowsTreeNode(HandleToObject(itemnew[9] )) 'lParaM - EndIf - Select nmhdr[3] 'action itemnew[2]&TVIS_EXPANDED 'state - Case 1 - PostGuiEvent EVENT_GADGETCLOSE,0,0,0,0,node - node._expanded=False - Case 2 - PostGuiEvent EVENT_GADGETOPEN,0,0,0,0,node - node._expanded=True - End Select - Return True - - Case TVN_BEGINDRAGW, TVN_BEGINRDRAGW, TVN_BEGINDRAGA, TVN_BEGINRDRAGA - - If (style&TREEVIEW_DRAGNDROP) Then - - Local data% = 1 - If (nmhdr[2] = TVN_BEGINRDRAGW) Or (nmhdr[2] = TVN_BEGINRDRAGA) Then data = 2 - - itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew - - If itemnew[1]<>TVI_ROOT Then - TGadget.dragGadget[data-1]=TWindowsTreeNode(HandleToObject(itemnew[9])) - PostGuiEvent EVENT_GADGETDRAG, data, KeyMods(), itemnew[10], itemnew[11], TGadget.dragGadget[data-1] - Else - TGadget.dragGadget[data-1]=Null - EndIf - - EndIf - - Case NM_DBLCLK, NM_RETURN - PostGuiEvent EVENT_GADGETACTION,0,0,0,0,_selected - - Case NM_RCLICK - Local Rect[4] - Local pt[2] - Local hittest[4] - Local item[10] - GetWindowRect _hwnd,Rect - GetCursorPos_ pt - hittest[0]=pt[0]-Rect[0] - hittest[1]=pt[1]-Rect[1] - If SendMessageW(_hwnd,TVM_HITTEST,0,Int Byte Ptr(hittest)) - If hittest[3]=TVI_ROOT - node=_root - Else - item[0]=TVIF_PARAM - item[1]=hittest[3] - SendMessageW _hwnd,TVM_GETITEMW,0,Int Byte Ptr(item) - node=TWindowsTreeNode(HandleToObject(item[9])) - EndIf - PostGuiEvent EVENT_GADGETMENU,0,hittest[0],hittest[1],0,node - EndIf - Return True - - EndSelect - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - 'If we are using Vista's common controls, then the treeview will be double-buffered and so - 'we don't need to clear the background when redrawing (performance tweak). - Case WM_ERASEBKGND - If TWindowsGUIDriver.CheckCommonControlVersion() >= 2 Then Return 1 - EndSelect - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method UseExplorerTheme() - - If TWindowsGUIDriver.CheckCommonControlVersion() And SetWindowThemeW Then - SetWindowThemeW( _hwnd, _wstrExplorer, Null ) - SendMessageW _hwnd, TVM_SETEXTENDEDSTYLE, TVS_EX_FADEINOUTEXPANDOS, TVS_EX_FADEINOUTEXPANDOS - EndIf - - EndMethod - - Method Class() - Return GADGET_TREEVIEW - EndMethod - -EndType - -Type TWindowsLabel Extends TWindowsGadget - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - - Self.style = style - wstyle=WS_CHILD|SS_NOPREFIX|WS_CLIPSIBLINGS|SS_NOTIFY - - Select style&24 - Case LABEL_LEFT wstyle:|SS_LEFT - Case LABEL_RIGHT wstyle:|SS_RIGHT - Case LABEL_CENTER wstyle:|SS_CENTER - End Select - Select style&7 - Case LABEL_FRAME wstyle:|WS_BORDER - Case LABEL_SUNKENFRAME wstyle:|SS_SUNKEN - Case LABEL_SEPARATOR wstyle:|SS_SUNKEN|SS_GRAYRECT - End Select - - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"STATIC","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - Register GADGET_LABEL,hwnd - - Return Self - EndMethod - - Method SetArea(x,y,w,h) - If ((style & 7) = LABEL_SEPARATOR) Then - If (w > h) Then h = 2 Else w = 2 - EndIf - Return Super.SetArea(x,y,w,h) - EndMethod - - Method SetText(Text$) - If ((style & 7) <> LABEL_SEPARATOR) Then Return Super.SetText(Text) - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_ERASEBKGND - Return 1 - EndSelect - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method Class() - Return GADGET_LABEL - EndMethod - -EndType - -Type TWindowsSlider Extends TWindowsGadget - Field _slidertype,_ishorizontal,_visible = 5,_total = 10,_value - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,class$ - Local hwnd,parent,hotkey - - _slidertype=style&$fffc - _ishorizontal=style&SLIDER_HORIZONTAL - - Self.style = style - wstyle=WS_CHILD|WS_CLIPSIBLINGS|WS_CLIPCHILDREN - parent=group.query(QUERY_HWND_CLIENT) - Select _slidertype - Case SLIDER_SCROLLBAR - If _ishorizontal wstyle:|SBS_HORZ;Else wstyle:|SBS_VERT - class$="SCROLLBAR" - Case SLIDER_TRACKBAR - wstyle:|TBS_AUTOTICKS|WS_TABSTOP - xstyle:|WS_EX_COMPOSITED 'Reduces flicker when resizing (doesn't like scrollbars/up-down controls) - If _ishorizontal wstyle:|TBS_HORZ Else wstyle:|TBS_VERT - class$=TRACKBAR_CLASS - Case SLIDER_STEPPER - If _ishorizontal wstyle:|UDS_HORZ - class$="msctls_updown32" - Default - Return Null - End Select - - hwnd=CreateWindowExW(xstyle,class,"",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - Register GADGET_SLIDER,hwnd - RefreshLook() - - Return Self - EndMethod - - Method SetRange(visible,total) - _visible = visible - _total = total - Local tmpEnabled:Int = Not( State() & STATE_DISABLED ) - Desensitize() - Select _slidertype - Case SLIDER_SCROLLBAR - Local info:SCROLLINFO=New SCROLLINFO - info.cbSize=SizeOf(SCROLLINFO) - info.fMask=SIF_PAGE|SIF_RANGE - info.nMax=total-1 - info.nPage=visible - SendMessageW _hwnd,SBM_SETSCROLLINFO,True,Int Byte Ptr info - Case SLIDER_TRACKBAR - - SendMessageW _hwnd,TBM_SETRANGEMIN,False,visible - SendMessageW _hwnd,TBM_SETRANGEMAX,True,total - - ' Aesthetic tweak that should stop black tick bands forming when - ' large ranges are used on small trackbars. - - Local tmpFirstTick% = SendMessageW( _hwnd, TBM_GETTICPOS, 0, 0 ) - Local tmpNumTicks% = SendMessageW( _hwnd, TBM_GETNUMTICS, 0, 0) - Local tmpLastTick% = SendMessageW( _hwnd, TBM_GETTICPOS, tmpNumTicks-3, 0 ) - If Not( tmpLastTick < 0 Or tmpFirstTick < 0 Or (total-visible-2) < 1) Then - If (tmpLastTick-tmpFirstTick)/(total-visible-2) < 4 Then - SendMessageW( _hwnd, TBM_CLEARTICS, True, 0 ) - EndIf - EndIf - - Case SLIDER_STEPPER - SendMessageW _hwnd,UDM_SETRANGE32,visible,total - End Select - _value = GetProp() - SetEnabled(tmpEnabled) - Sensitize() - EndMethod - - Method SetProp(value) - Desensitize() - Select _slidertype - Case SLIDER_SCROLLBAR - Local info:SCROLLINFO=New SCROLLINFO - info.cbSize=SizeOf(SCROLLINFO) - info.fMask=SIF_POS - info.nPos=value - SendMessageW _hwnd,SBM_SETSCROLLINFO,True,Int Byte Ptr info - Case SLIDER_TRACKBAR - If _ishorizontal Then - SendMessageW _hwnd,TBM_SETPOS,True,value - Else - 'Flip the value so that the scale starts from the bottom - SendMessageW _hwnd,TBM_SETPOS,True,_visible + _total - value - EndIf - Case SLIDER_STEPPER - SendMessageW _hwnd,UDM_SETPOS,True,value - End Select - _value = value - Sensitize() - EndMethod - - Method GetProp() - Local value - Select _slidertype - Case SLIDER_SCROLLBAR - value=GetScrollPos(_hwnd,SB_CTL) - Case SLIDER_TRACKBAR - value=SendMessageW(_hwnd,TBM_GETPOS,0,0) - 'Flip the value so that the scale starts from the bottom - If Not _ishorizontal Then value = _visible + _total - value - Case SLIDER_STEPPER - value=SendMessageW(_hwnd,UDM_GETPOS32,0,Null) - End Select - Return value - EndMethod - - Method OnCommand(msg,wp) - If _slidertype=SLIDER_SCROLLBAR - If msg=WM_COMMAND Return - Local info:SCROLLINFO=New SCROLLINFO - info.cbSize=SizeOf(SCROLLINFO) - Select wp&$ffff - Case SB_THUMBTRACK,SB_THUMBPOSITION - info.fMask=SIF_TRACKPOS - SendMessageW _hwnd,SBM_GETSCROLLINFO,0,Int Byte Ptr info - SetScrollPos _hwnd,SB_CTL,info.nTrackPos,True - Default - info.fMask=SIF_POS|SIF_PAGE|SIF_RANGE - SendMessageW _hwnd,SBM_GETSCROLLINFO,0,Int Byte Ptr info - Local pos=info.nPos - Local vis=info.nPage - Select wp&$ffff - Case SB_LINEUP pos:-1 - Case SB_LINEDOWN pos:+1 - Case SB_PAGEUP pos:-vis - Case SB_PAGEDOWN pos:+vis - Default Return 0 - End Select - SetScrollPos _hwnd,SB_CTL,pos,True - End Select - EndIf - Local index=GetProp() - If (index <> _value) Then - PostGuiEvent EVENT_GADGETACTION,index - _value = index - EndIf - Return 1 - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - Case WM_ERASEBKGND - Return 1 - EndSelect - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method RefreshLook() - Super.RefreshLook() - SetRange(_visible,_total) - EndMethod - - Method Class() - Return GADGET_SLIDER - EndMethod - -EndType - -Type TWindowsProgressBar Extends TWindowsGadget - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,parent - Self.style = style - wstyle=WS_CHILD|PBS_SMOOTH|WS_CLIPSIBLINGS - parent=group.query(QUERY_HWND_CLIENT) - hwnd=CreateWindowExW(xstyle,"msctls_progress32","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - Register GADGET_PROGBAR,hwnd - Return Self - EndMethod - - Method SetValue(value#) - SendMessageW _hwnd,PBM_SETPOS,value*100,0 - EndMethod - - Method SetColor(r,g,b) - 'Only works in Classic mode, but it's better than nothing. - SendMessageW _hwnd,PBM_SETBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - Method RemoveColor() - 'Only works in Classic mode, but it's better than nothing. - SendMessageW _hwnd,PBM_SETBKCOLOR ,1,0 - EndMethod - - Method SetTextColor(r,g,b) - 'Only works in Classic mode, but it's better than nothing. - SendMessageW _hwnd,PBM_SETBARCOLOR ,0,(b Shl 16)|(g Shl 8)|r - EndMethod - - Method Class() - Return GADGET_PROGBAR - EndMethod - -EndType - -Type TWindowsPanel Extends TWindowsGadget - - Const PANELPANEL=0 - Const PANELGROUP=1 - Const PANELCANVAS=2 - - Field _type - Field _alpha#=1.0 - Field _bitmapwidth,_bitmapheight,_bitmapflags - Field _canvas:TGraphics - Field _hasalpha - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Local xstyle,wstyle,hotkey - Local hwnd,client,parent - Self.style = style - - parent=group.query(QUERY_HWND_CLIENT) - If (style&3=PANEL_GROUP) Then - _type=PANELGROUP - hwnd=CreateWindowExW(WS_EX_CONTROLPARENT,"BUTTON","",BS_GROUPBOX|WS_CHILD|WS_CLIPSIBLINGS|WS_CLIPCHILDREN,0,0,0,0,parent,0,GetModuleHandleW(Null),Null ) - client=CreateWindowExW(WS_EX_CONTROLPARENT,TWindowsGUIDriver.ClassName(),"",WS_CHILD|WS_VISIBLE|WS_CLIPCHILDREN|WS_CLIPSIBLINGS,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) - Else - _type=PANELPANEL - xstyle=WS_EX_CONTROLPARENT - wstyle=WS_CHILD|WS_CLIPCHILDREN|WS_CLIPSIBLINGS - Select (style&3) - Case PANEL_SUNKEN xstyle:|WS_EX_CLIENTEDGE - Case PANEL_RAISED xstyle:|WS_EX_WINDOWEDGE ; wstyle:|WS_DLGFRAME - EndSelect - If (style&PANEL_CANVAS) Then _type=PANELCANVAS - hwnd=CreateWindowExW(xstyle,TWindowsGUIDriver.ClassName(),"",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) - EndIf - - Register GADGET_PANEL,hwnd,client - If (style & PANEL_ACTIVE) Then sensitivity = SENSITIZE_ALL - - Return Self - EndMethod - - Method SetAlpha( alpha# ) - _alpha=alpha - RedrawGadget(Self) - EndMethod - - Method Activate( cmd ) - Select cmd - Case ACTIVATE_REDRAW - If (_type = PANELCANVAS) Then - InvalidateRect _hwnd, Null, False - Return True - EndIf - EndSelect - Return Super.Activate(cmd) - EndMethod - - Method SetPixmap(pixmap:TPixmap,flags) - If _bitmap Then DeleteObject _bitmap;_bitmap = 0 - If pixmap Then - If pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888 - _bitmap=TWindowsGraphic.PreMultipliedBitmapFromPixmap32( pixmap ) - EndIf - If _bitmap - _hasalpha=True - Else - _bitmap=TWindowsGraphic.BitmapFromPixmap( pixmap, False ) - _hasalpha=False - EndIf - _bitmapflags=flags - _bitmapwidth=pixmap.width - _bitmapheight=pixmap.height - EndIf - RedrawGadget(Self) - EndMethod - - Method AttachGraphics:TGraphics( flags ) - _canvas=brl.Graphics.AttachGraphics( _hwnd,flags ) - EndMethod - - Method CanvasGraphics:TGraphics() - Return _canvas - EndMethod - - Method Free() - If _canvas Then CloseGraphics(_canvas);_canvas = Null - Super.Free() - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - - Case WM_ERASEBKGND - - If _type = PANELCANVAS Then Return 1 - - Local hdc=wp,hdcCanvas,hdcBitmap,srcw,srch,x,y,xoffset,yoffset - Local clientRect[4], updateRect[4], clipRect[4], windowRect[4] - - GetClipBox( hdc, clipRect ) - GetWindowRect( hwnd, windowRect) - GetClientRect( hwnd, clientRect ) - - If Not GetUpdateRect( hwnd, updateRect, False) Then updateRect = clipRect - If IsRectEmpty(updateRect) Then updateRect = [0,0,windowRect[2]-windowRect[0],windowRect[3]-windowRect[1]] - - 'If we are drawing a bitmap or using alpha then let's do some double-buffering stuff - - If (hwnd <> _hwndclient) And ((_bitmap And _bitmapwidth And _bitmapheight) Or _alpha<1.0) Then - - hdc = CreateCompatibleDC(wp) - hdcCanvas = CreateCompatibleBitmap(wp,windowRect[2]-windowRect[0],windowRect[3]-windowRect[1]) - SelectObject( hdc, hdcCanvas ) - - EndIf - - 'Fill the drawing context with the background colour, or the background of the parent - - If BgBrush() And (hwnd <> _hwndclient) Then FillRect(hdc,updateRect,BgBrush()) Else DrawParentBackground(hdc,hwnd) - - 'If we aren't drawing to a bitmap or using alpha, then we can return now. - - If Not ((hwnd <> _hwndclient) And ((_bitmap And _bitmapwidth And _bitmapheight) Or _alpha<1.0)) Then Return 1 - - If _bitmap And _bitmapwidth And _bitmapheight - hdcBitmap=CreateCompatibleDC(hdc) - SelectObject(hdcBitmap,_bitmap) - srcw=_bitmapwidth - srch=_bitmapheight - Select (_bitmapflags & (GADGETPIXMAP_ICON-1)) - Case PANELPIXMAP_TILE - While ymy Then - If (_bitmapflags&(GADGETPIXMAP_ICON-1)) = PANELPIXMAP_FIT Then mx=my Else my=mx - EndIf - Local w=mx*srcw - Local h=mx*srch - x=(windowRect[RECT_RIGHT]-windowRect[RECT_LEFT]-w)/2 - y=(windowRect[RECT_BOTTOM]-windowRect[RECT_TOP]-h)/2 - SetStretchBltMode hdc,COLORONCOLOR - - If _hasalpha - AlphaBlend_ hdc,x,y,w,h,hdcBitmap,0,0,srcw,srch,$01ff0000 - Else - StretchBlt hdc,x,y,w,h,hdcBitmap,0,0,srcw,srch,ROP_SRCCOPY - EndIf - - Case PANELPIXMAP_STRETCH - SetStretchBltMode hdc,COLORONCOLOR - - If _hasalpha - AlphaBlend_ hdc,0,0,windowRect[RECT_RIGHT]-windowRect[RECT_LEFT],windowRect[RECT_BOTTOM]-windowRect[RECT_TOP],hdcBitmap,0,0,srcw,srch,$01ff0000 - Else - StretchBlt hdc,0,0,windowRect[RECT_RIGHT]-windowRect[RECT_LEFT],windowRect[RECT_BOTTOM]-windowRect[RECT_TOP],hdcBitmap,0,0,srcw,srch,ROP_SRCCOPY - EndIf - - EndSelect - - DeleteDC(hdcBitmap) - - EndIf - - If _alpha < 1.0 Then - - DrawParentBackground( wp, hwnd ) - Local blendfunction = ((Int(_alpha*255)&$FF) Shl 16) - AlphaBlend_(wp,updateRect[0],updateRect[1],updateRect[2]-updateRect[0],updateRect[3]-updateRect[1],hdc,updateRect[0],updateRect[1],updateRect[2]-updateRect[0],updateRect[3]-updateRect[1],blendfunction) - - Else - - BitBlt(wp,0,0,windowRect[2]-windowRect[0],WindowRect[3]-windowRect[1],hdc,0,0,ROP_SRCCOPY) - - EndIf - - Assert hdc <> wp, "hdc == wp! Please post a MaxGUI bug report." - - DeleteObject( hdcCanvas ) - DeleteDC( hdc ) - - Return 1 - - Case WM_PAINT - - Select _type - Case PANELCANVAS - PostGuiEvent EVENT_GADGETPAINT - ValidateRect _hwnd, Null - Return 1 - EndSelect - - Case WM_LBUTTONDOWN - - SetFocus Query(QUERY_HWND_CLIENT) - - End Select - - Return Super.WndProc(hwnd,msg,wp,lp) - - EndMethod - - Method FlushBrushes(pRecurse:Int = True) - Super.FlushBrushes() - If Not pRecurse Then Return - For Local tmpGadget:TWindowsGadget = EachIn kids - tmpGadget.FlushBrushes() - Next - EndMethod - - Method ClientWidth() - If _hwndClient Then Return (Super.ClientWidth()-8) Else Return Super.ClientWidth() - EndMethod - - Method ClientHeight() - If _hwndClient Then Return (Super.ClientHeight()-20) Else Return Super.ClientHeight() - EndMethod - - Method RethinkClient(forceRedraw:Int = False) - If _hwndClient Then - MoveWindow( _hwndClient, 4+_clientX,16+_clientY,ClientWidth(),ClientHeight(),forceRedraw) - EndIf - EndMethod - - Method Class() - If _type = PANELCANVAS Then Return GADGET_CANVAS Else Return GADGET_PANEL - EndMethod - -EndType - - -Type TWindowsHTMLView Extends TWindowsGadget - - Field mshtml - Field browser:IWebBrowser2 - - Field IID_IHTMLDocument2:GUID=New GUID - - Method Create:TWindowsGadget(group:TGadget,style,Text$="") - Self.style = style - Local parent=group.query(QUERY_HWND_CLIENT) - mshtml=msHtmlCreate(Self,TWindowsGUIDriver.ClassName(),parent,style) - browser=msHTMLBrowser(mshtml) - Register GADGET_HTMLVIEW,msHtmlHwnd(mshtml) - - Local res = IIDFromString(IHTMLDocument2_UUID,IID_IHTMLDocument2) - - Return Self - EndMethod - - Method Rethink() - msHtmlSetShape mshtml,xpos,ypos,width,height - EndMethod - - Method SetText(Text$) 'sets document url - If Text Then msHtmlGo mshtml,Text - EndMethod - - Method GetText$() - Local bstr:Short Ptr - browser.lfget_LocationURL(Varptr bstr) - Local result$ = String.FromWString(bstr) - SysFreeString(bstr) - Return result - EndMethod - - Method GetTitleText$() 'returns document title - - Local bstr:Short Ptr - Local res - - Local disp:IDispatch - Local doc:IHTMLDOCUMENT2 - - res=browser.lfget_Document(Varptr disp) - If res RuntimeError "no document" - - res=disp.QueryInterface(IID_IHTMLDocument2,Varptr doc) - If res RuntimeError "no document2 interface" - - If doc - doc.get_Title(Varptr bstr) - Else - browser.lfget_LocationName(Varptr bstr) - EndIf - - Local result$ = String.FromWString(bstr) - SysFreeString(bstr) - Return result - - End Method -Rem - Method Run$(script$) - Local res - Local disp:IDispatch - Local doc:IHTMLDOCUMENT2 - Local win:IHTMLWindow2 - Local result:VARIANT - - res=browser.lfget_Document(Varptr disp) - If res RuntimeError "no document" - res=disp.QueryInterface(IID_IHTMLDocument2,Varptr doc) - If res RuntimeError "no document2 interface" - res=doc.get_parentWindow(Varptr win) - If res RuntimeError "no parent window" - result=New VARIANT - result.vt=VT_EMPTY - Local bstr:Short Ptr - bstr=SysAllocStringLen(script.toWString(),script.length) - res=win.execScript(bstr,Null,result) - SysFreeString bstr - Return res - End Method - -EndRem - Method Activate(cmd) - Return msHtmlActivate(mshtml,cmd) - EndMethod - - Method State() - Return msHtmlStatus(mshtml) - EndMethod - - Method Run$(script$) - msHtmlRun(mshtml,script) - EndMethod - - Method WndProc(hwnd,msg,wp,lp) - Select msg - 'Reduces flicker on HTMLViews - Case WM_ERASEBKGND - Return 1 - EndSelect - Return Super.WndProc(hwnd,msg,wp,lp) - EndMethod - - Method Class() - Return GADGET_HTMLVIEW - EndMethod - -EndType - -Type TWindowsMenu Extends TGadget - Field _hmenu - Field _pmenu - Field _item - Field _state - Field _tag - Field _hotkeycode - Field _modifier - Field _shortcut$ - Field _hotkey:THotKey - Field _key = SetNewKey() - Field _iconBitmap - - Global iteminfo:MENUITEMINFOW - - Global keymap:TMap=New TMap 'key,gadget - Global keycount=100 - - Method SetNewKey%() - keycount:+1 - keymap.Insert( TIntWrapper.Create(keycount), Self ) - Return keycount - EndMethod - - Function GetMenuFromKey:TWindowsMenu(pKey%) - Return TWindowsMenu(keymap.ValueForKey(TIntWrapper.Create(pKey))) - EndFunction - - Method SetText(pText$) - name = pText - EndMethod - - Method GetText$() - Return name - EndMethod - - Method Free() - Close - _setparent Null - keymap.Remove(TIntWrapper.Create(_key)) - If _iconBitmap Then DeleteObject(_iconBitmap) - EndMethod - - Method DoLayout() - 'Don't do anything! - EndMethod - - Method State() - Return _state - EndMethod - - Method SetEnabled(enable) - If enable - If _pmenu EnableMenuItem(_pmenu,_item,MF_BYPOSITION|MF_ENABLED) - _state:&~STATE_DISABLED - Else - If _pmenu EnableMenuItem(_pmenu,_item,MF_BYPOSITION|MF_GRAYED) - _state:|STATE_DISABLED - EndIf - EndMethod - - Method SetSelected(bool) - If bool - If _pmenu CheckMenuItem(_pmenu,_item,MF_BYPOSITION|MF_CHECKED) - _state:|STATE_SELECTED - Else - If _pmenu CheckMenuItem(_pmenu,_item,MF_BYPOSITION|MF_UNCHECKED) - _state:&~STATE_SELECTED - EndIf - EndMethod - - Method SetHotKey(keycode,modifier) - _hotkeycode=keycode - _modifier=modifier - - Local pre$, suf$, m$ - - If LocalizationMode()&LOCALIZATION_ON Then - pre="{{" - suf="}}" - EndIf - - If keycode>=KEY_0 And keycode<=KEY_9 - m$=Chr(keycode) - ElseIf keycode>=KEY_A And keycode<=KEY_Z - m$=Chr(keycode) - ElseIf keycode>=KEY_F1 And keycode<=KEY_F12 - m$="F"+(keycode+1-KEY_F1) - ElseIf keycode>=KEY_NUM0 And keycode<=KEY_NUM9 - m$="Num "+(keycode+1-KEY_NUM0) - Else - Select keycode - Case KEY_BACKSPACE;m = pre+"Backspace"+suf - Case KEY_TAB;m = pre+"Tab"+suf - Case KEY_ESCAPE;m = pre+"Esc"+suf - Case KEY_SPACE;m = pre+"Space"+suf - Case KEY_ENTER;m = pre+"Enter"+suf - Case KEY_PAGEUP;m = pre+"PageUp"+suf - Case KEY_PAGEDOWN;m = pre+"PageDown"+suf - Case KEY_END;m = pre+"End"+suf - Case KEY_HOME;m = pre+"Home"+suf - Case KEY_LEFT;m = pre+"Left"+suf - Case KEY_RIGHT;m = pre+"Right"+suf - Case KEY_UP;m = pre+"Up"+suf - Case KEY_DOWN;m = pre+"Down"+suf - Case KEY_INSERT;m = pre+"Insert"+suf - Case KEY_DELETE;m = pre+"Delete"+suf - Case KEY_TILDE;m = "~~" - Case KEY_MINUS;m = "-" - Case KEY_EQUALS;m = "=" - Case KEY_OPENBRACKET;m = "[" - Case KEY_CLOSEBRACKET;m = "]" - Case KEY_BACKSLASH;m = "\" - Case KEY_SEMICOLON;m = ";" - Case KEY_QUOTES;m = "'" - Case KEY_COMMA;m = "," - Case KEY_PERIOD;m = "." - Case KEY_SLASH;m = "/" - Case KEY_NUMMULTIPLY;m = "Num *" - Case KEY_NUMADD;m = "Num +" - Case KEY_NUMSUBTRACT;m = "Num -" - Case KEY_NUMDECIMAL;m = "Num ." - Case KEY_NUMDIVIDE;m = "Num /" - EndSelect - EndIf - - If m - If modifier&MODIFIER_SHIFT m$=pre+"Shift"+suf+"+"+m$ - If modifier&MODIFIER_CONTROL m$=pre+"Ctrl"+suf+"+"+m$ - If modifier&MODIFIER_ALT m$=pre+"Alt"+suf+"+"+m$ - m="~t"+m - EndIf - _shortcut$=LocalizeString(m) - - If Not iteminfo - iteminfo=New MENUITEMINFOW - iteminfo.cbSize=SizeOf(iteminfo) - EndIf - iteminfo.fMask=MIIM_TYPE - iteminfo.dwTypeData=(name+_shortcut).toWString() - SetMenuItemInfoW _pmenu,_item,True,iteminfo - - MemFree iteminfo.dwTypeData - - Local ev:TEvent=CreateEvent( EVENT_MENUACTION, Self,_tag ) - If _hotKey RemoveHotKey(_hotKey);_hotKey = Null - If keycode Then _hotkey=SetHotKeyEvent(keycode,modifier,ev,FindGadgetWindowHwnd(Self)) - EndMethod - - Method Create:TWindowsMenu(group:TGadget,tag,Text$="") - If Not iteminfo Then - iteminfo=New MENUITEMINFOW - iteminfo.cbSize=SizeOf(iteminfo) - EndIf - name=Text - _tag=tag - Local window:TWindowsWindow = TWindowsWindow(group) - If window group=window.GetMenu() - _SetParent(group) - If (LocalizationMode()&LOCALIZATION_OVERRIDE) Then - LocalizeGadget(Self, name, "") - EndIf - Return Self - EndMethod - - Method Open(popup=False) - - Local dad:TWindowsMenu = TWindowsMenu(parent) - - If dad - _pmenu=dad._hmenu - If Not _pmenu Throw "Parent doesn't have a handle - the desktop heap may have run out of memory!" - _item=GetMenuItemCount(_pmenu) - If name - Local tmpWString:Short Ptr = (LocalizeString(name)+_shortcut).ToWString() - AppendMenuW _pmenu,MF_STRING,_key,tmpWString - MemFree tmpWString - Else - AppendMenuW _pmenu,MF_SEPARATOR,_key,Null - EndIf - If kids.count() - _hmenu=CreateMenu_() - Local tmpMenuInfo:MENUINFO = New MENUINFO - - tmpMenuInfo.fMask = MIM_APPLYTOSUBMENUS|MIM_STYLE - tmpMenuInfo.dwStyle = MNS_CHECKORBMP|MNS_MODELESS - SetMenuInfo(_hmenu, tmpMenuInfo) - - iteminfo.fMask=MIIM_SUBMENU - iteminfo.hSubMenu=_hmenu - SetMenuItemInfoW _pmenu,_item,True,iteminfo - EndIf - - If _state&STATE_DISABLED SetEnabled(False) - If _state&STATE_SELECTED SetSelected(True) - - If _iconBitmap Then SetMenuItemBitmaps(_pMenu,_key,MF_BYCOMMAND,_iconBitmap,Null) - Else - If popup - _hmenu=CreatePopupMenu() - Else - If kids _hmenu=CreateMenu_() - EndIf - EndIf - - For Local kid:TWindowsMenu = EachIn kids - kid.Open - Next - - EndMethod - - Method FreeKids() - For Local kid:TWindowsMenu = EachIn kids - kid.Close - Next - EndMethod - - Method Close() - FreeKids() - If _hmenu - DestroyMenu _hmenu - _hmenu=0 - EndIf - EndMethod - - Method SetPixmap(pixmap:TPixmap,pFlags) - If Not (pFlags & GADGETPIXMAP_ICON) Then Return - If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 - If pixmap Then - pixmap = PixmapWindow(pixmap,0,0,Min(GetSystemMetrics(SM_CXMENUCHECK),PixmapWidth(pixmap)),Min(GetSystemMetrics(SM_CYMENUCHECK),PixmapHeight(pixmap))) - If TWindowsGUIDriver.CheckCommonControlVersion() >= 2 Then - _iconBitmap = TWindowsGraphic.PreMultipliedBitmapFromPixmap32( pixmap ) - Else - Local tmpRGB = GetSysColor(COLOR_MENU) - _iconBitmap = TWindowsGraphic.BitmapWithBackgroundFromPixmap32( pixmap, tmpRGB&$FF, (tmpRGB Shr 8) & $FF, (tmpRGB Shr 16) & $FF ) - EndIf - EndIf - - EndMethod - - Method SetTooltip( pTooltip$ ) - 'Menus shouldn't have tool-tips. - EndMethod - - Method Class() - Return GADGET_MENUITEM - EndMethod - -EndType - -Type TWindowsIconStrip Extends TIconStrip - - Field _blanks[] - Field _imagelist - - Function DetectNotBlank(pixmap:TPixmap,xx,n) - Local c = pixmap.ReadPixel(xx,0), y - For Local x=0 Until n - For y=0 Until n - If pixmap.ReadPixel(xx+x,y)<>c Return True - Next - Next - EndFunction - - Method IsBlankIcon(n) - Return _blanks[n] - EndMethod - - Function RemoveMask(pixmap:TPixmap) - If pixmap.format<>( PF_RGBA8888 ) And pixmap.format<>( PF_BGRA8888 ) Return - Local w = pixmap.width, h = pixmap.height, y, c - For Local x=0 Until w - For y=0 Until h - c=pixmap.ReadPixel(x,y) - If c>=0 pixmap.WritePixel x,y,-1 - Next - Next - EndFunction - - Function BuildImageList(pixmap:TPixmap) - Local bitmap,imagelist,sz,mask - sz=pixmap.height - If TWindowsGUIDriver.CheckCommonControlVersion() And (Pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888) - imagelist=ImageList_Create(sz,sz,ILC_COLOR32,0,1) - If imagelist - bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, True) - ImageList_Add(imagelist,bitmap,0) - EndIf - EndIf - If imagelist=0 - bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, False) - mask=TWindowsGraphic.BitmapMaskFromPixmap(pixmap) - imagelist=ImageList_Create(sz,sz,ILC_COLOR24|ILC_MASK,0,1) - ImageList_Add(imagelist,bitmap,mask) - DeleteObject(mask) - EndIf - DeleteObject(bitmap) - Return imagelist - EndFunction - - Function Create:TWindowsIconStrip(source:Object) - Local icons:TWindowsIconStrip - Local imagelist - Local n,i,sz - Local blanks[] - - 'Get a 24-bit pixmap from source - Local pix:TPixmap = TPixmap(source) - If Not pix pix = LoadPixmap(source) - If Not pix Return - - 'Detect blank icons in the set - sz=pix.height;If sz n=pix.width/sz - If n=0 Return - blanks=New Int[n] - For i=0 Until n - blanks[i]=Not DetectNotBlank(pix,i*sz,sz) - Next - - 'Build a Win32 Image-List - imagelist=BuildImageList(pix) - icons = New TWindowsIconStrip - icons.pixmap = pix - icons.count=n - icons._blanks=blanks - icons._imagelist=imagelist - - Return icons - EndFunction - - Function CreateBlank:TWindowsIconStrip() - Return Create(CreatePixmap(1,1,PF_BGR888)) - EndFunction - - Method Delete() - If _imagelist Then - ImageList_Destroy(_imagelist) - _imagelist = 0 - EndIf - EndMethod - -EndType - -Type TWindowsFont Extends TGuiFont - - Method Load:TWindowsFont(_name$,_size:Double,_style) - - If handle Then DeleteObject handle;handle = 0 - - Local cfweight = FW_NORMAL - Local cfsize = -LogicalUnitsFromSize( _size ) - - If _style & FONT_BOLD cfweight=FW_BOLD - handle=CreateFontW( cfsize, 0,0,0,cfweight,.. - (_style & FONT_ITALIC) ,.. - (_style & FONT_UNDERLINE),.. - (_style & FONT_STRIKETHROUGH),.. - DEFAULT_CHARSET,.. - OUT_DEFAULT_PRECIS,.. - CLIP_DEFAULT_PRECIS,.. - ANTIALIASED_QUALITY,.. - DEFAULT_PITCH|FF_DONTCARE,.. - _name.toWString()) - - 'Now lets test to see whether the right font was found - - name = NameFromHandle(handle) - - 'If the font returned has a different name to that requested, let's try the symbol character set - - If name.ToLower() <> _name.ToLower() Then - Local tmpSymbolHandle = CreateFontW( cfsize, 0,0,0,cfweight,.. - (_style & FONT_ITALIC) ,.. - (_style & FONT_UNDERLINE),.. - (_style & FONT_STRIKETHROUGH),.. - SYMBOL_CHARSET,.. - OUT_DEFAULT_PRECIS,.. - CLIP_DEFAULT_PRECIS,.. - ANTIALIASED_QUALITY,.. - DEFAULT_PITCH|FF_DONTCARE,.. - _name.toWString()) - - Local strSymbolName:String = NameFromHandle(tmpSymbolHandle) - - 'If we now have a match, delete the first font returned and use the new symbol one. - - If strSymbolName.ToLower() = _name.ToLower() Then - DeleteObject handle - handle = tmpSymbolHandle - name = strSymbolName - Else - DeleteObject tmpSymbolHandle - EndIf - - EndIf - - size=_size - style=_style - - Return Self - - EndMethod - - Method LoadFromLogFont:TWindowsFont( pLogFont:LOGFONTW, pStyle% = 0, pSize:Double = 0:Double ) - - If pLogFont.lfWeight>=FW_BOLD Then pStyle:| FONT_BOLD - If pLogFont.lfItalic Then pStyle:| FONT_ITALIC - If pLogFont.lfUnderline Then pStyle:| FONT_UNDERLINE - If pLogFont.lfStrikeOut Then pStyle:| FONT_STRIKETHROUGH - - style = pStyle - - If Not pSize Then pSize = SizeFromLogFont( pLogFont ) - - size = pSize - - SetLogFontProperties( pLogFont, pStyle, pSize ) - - name = String.FromWString( Varptr pLogFont.lfFaceName00 ) - - If handle Then DeleteObject handle - handle = CreateFontIndirectW( pLogFont ) - - Return Self - - EndMethod - - Method LoadFromHandle:TWindowsFont(hfont) - - Local tmpLogFont:LOGFONTW = New LOGFONTW - GetObjectW( hfont, SizeOf(LOGFONTW), tmpLogFont ) - Return LoadFromLogFont( tmpLogFont ) - - EndMethod - - Method CharWidth( charcode ) - Local hdc=GetDC(0) - Local tfont=SelectObject( hdc,handle ) - - Local width=8,widths[3] - - If GetCharABCWidthsW( hdc,charcode,charcode,widths ) - width=widths[0]+widths[1]+widths[2] - Else If GetCharWidth32W( hdc,charcode,charcode,widths ) - width=widths[0] - EndIf - - SelectObject hdc,tfont - ReleaseDC 0,hdc - - Return width - EndMethod - - Method GetMaxCharWidth() - Local hdc=GetDC(0) - Local tfont=SelectObject(hdc,handle) - Local tm:TEXTMETRIC=New TEXTMETRIC - GetTextMetricsW hdc,tm - SelectObject(hdc,tfont) - ReleaseDC(0,hdc) - Return tm.tmAveCharWidth - EndMethod - - Method Delete() - If handle Then DeleteObject handle - EndMethod - - Function Request:TWindowsFont(font:TGuiFont) - - Local lf:LOGFONTW = New LOGFONTW - Local cf:CHOOSEFONT = New CHOOSEFONT - - cf.lStructSize=SizeOf(cf) - cf.hwndOwner=TWindowsGUIDriver.GetActiveHwnd() - cf.lpLogFont=lf - cf.Flags=CF_BOTH - - If font - Local p:Short Ptr = Short Ptr(Varptr lf.lfFaceName00) - For Local i = 0 Until Min(font.name.length, 31) - p[i]=font.name[i] - Next - SetLogFontProperties( lf, font.style, font.size ) - cf.Flags:|CF_INITTOLOGFONTSTRUCT - EndIf - - Local hwnd = GetFocus() - Local n = ChooseFontW(cf) - SetFocus(hwnd) - If Not n Return - - Local style - If cf.nFontType&BOLD_FONTTYPE style:|FONT_BOLD - If cf.nFontType&ITALIC_FONTTYPE style:|FONT_ITALIC - Return New TWindowsFont.LoadFromLogFont( lf, style, cf.iPointSize/Double(10) ) - - EndFunction - - Function DefaultFont:TWindowsFont( pFontSize:Double = 0, pFontStyle% = FONT_NORMAL ) - - 'Attempts to get hold of the Windows themed font (typically Tahoma on XP, Segeo UI on Vista) - Local tmpNonClientMetrics:NONCLIENTMETRICSW = New NONCLIENTMETRICSW - - If SystemParametersInfoW And SystemParametersInfoW( SPI_GETNONCLIENTMETRICS, 0, Int Byte Ptr tmpNonClientMetrics, 0 ) Then - Local tmpLogFont:LOGFONTW = New LOGFONTW - MemCopy tmpLogFont, Varptr tmpNonClientMetrics.lfMessageFont_lfHeight, SizeOf(tmpLogFont) - Return New TWindowsFont.LoadFromLogFont( tmpLogFont, pFontStyle, pFontSize ) - EndIf - - 'If these functions, for whatever reason, fail, then the default GUI font is used (typically MS Sans Serif). - 'Note: A font size of '8' has has been hard-coded in as no reliable substitute can be found, however this may cause - 'text to appear too small in some languages/lacalizations. - If pFontSize <= 0 Then pFontSize = 8 - Return New TWindowsFont.Load( "MS Shell Dlg", pFontSize, pFontStyle ) - - EndFunction - - Function NameFromHandle:String( pFntHandle:Int ) - - Local hdc = GetDC(0), buffer:Short[512] - Local tfont = SelectObject(hdc,pFntHandle) - - If Not GetTextFaceW(hdc,buffer.length,buffer) buffer[0] = 0 - - SelectObject(hdc, tfont) - ReleaseDC(0,hdc) - - Return String.FromWString(buffer) - - EndFunction - - Function LogicalUnitsFromSize( pSize:Double ) - - Local tmpDC:Int = GetDC(0) - Local tmpSize:Int = (pSize * GetDeviceCaps(tmpDC,LOGPIXELSY))/72 + 0.5 - ReleaseDC( 0, tmpDC ) - Return tmpSize - - EndFunction - - Function SizeFromLogFont:Double( pLogFont:LOGFONTW ) - - Local tmpDC:Int = GetDC(0) - Local tmpSize:Double = (Abs(pLogFont.lfHeight) * Double(72.0) )/GetDeviceCaps(tmpDC,LOGPIXELSY) - ReleaseDC( 0, tmpDC ) - Return tmpSize - - EndFunction - - Function SetLogFontProperties( pLogFont:LOGFONTW, pFlags%, pSize:Double = 0:Double ) - - If pFlags&FONT_BOLD Then pLogFont.lfWeight=FW_BOLD Else pLogFont.lfWeight=FW_NORMAL - If pFlags&FONT_ITALIC Then pLogFont.lfItalic=True Else pLogFont.lfItalic=False - If pFlags&FONT_UNDERLINE Then pLogFont.lfUnderline=True Else pLogFont.lfUnderline=False - If pFlags&FONT_STRIKETHROUGH Then pLogFont.lfStrikeOut=True Else pLogFont.lfStrikeOut=False - - If pSize > 0 Then pLogFont.lfHeight = -LogicalUnitsFromSize( pSize ) - - EndFunction - -EndType - -'A collection of functions that convert between Blitz pixmaps and Windows icons/bitmaps. -Type TWindowsGraphic Final - - Function BitmapMaskFromPixmap:Int(pix:TPixmap) - - Local x, pix2:TPixmap, usealpha - - If PixmapFormat(pix) = PF_RGBA8888 Or PixmapFormat(pix) = PF_BGRA8888 Then usealpha = True - - pix2=ConvertPixmap(pix,PF_BGR888);ClearPixels(pix2) - - For Local y:Int = 0 Until pix.height - For x = 0 Until pix.width - If usealpha - If (ReadPixel(pix,x,y) Shr 24) < 128 Then WritePixel(pix2,x,y,$FFFFFF) - Else - If (ReadPixel(pix,x,y) & $FFFFFF) = $FFFFFF Then WritePixel(pix2,x,y,$FFFFFF) - EndIf - Next - Next - - Return BitmapFromPixmap(pix2,False) - - EndFunction - - Function PreMultipliedBitmapFromPixmap32:Int( pix:TPixmap ) - - Local argb, a - Local pix2:TPixmap = CreatePixmap( pix.width, pix.height, pix.format), x - - For Local y:Int = 0 Until pix.height - For x = 0 Until pix.width - argb = ReadPixel(pix,x,y) - a = ((argb Shr 24) & $FF) - WritePixel(pix2,x,y,((((argb&$ff00ff)*a)Shr 8)&$ff00ff)|((((argb&$ff00)*a)Shr 8)&$ff00)|(a Shl 24)) - Next - Next - - Return BitmapFromPixmap(pix2,True) - - EndFunction - - Function BitmapFromPixmap:Int(pix:TPixmap, alpha:Int = True) - - Local bitCount:Int = 32, format:Int = PF_BGRA8888, bm - - If Not alpha Then - bitCount = 24 - format = PF_BGR888 - EndIf - - pix=ConvertPixmap(pix,format) - - Local hdc = GetDC(0) - - Local bi:BITMAPINFOHEADER = New BITMAPINFOHEADER - bi.biSize=SizeOf(bi) - bi.biWidth=pix.width - bi.biHeight=-pix.height - bi.biPlanes=1 - bi.biBitCount=bitCount - bi.biCompression=BI_RGB - - Local bits:Byte Ptr - Local src:Byte Ptr = pix.pixels - - If alpha - bm = CreateDibSection(hdc,bi,DIB_RGB_COLORS,Varptr bits,0,0) - Else - bm = CreateCompatibleBitmap(hdc,pix.width,pix.height) - EndIf - - Assert bm, "Cannot create bitmap. The computer may be running low on resources." - - For Local y:Int = 0 Until pix.height - SetDIBits(hdc,bm,pix.height-y-1,1,src,bi,DIB_RGB_COLORS) - src:+pix.pitch - Next - - ReleaseDC(0,hdc) - - Return bm - - EndFunction - - Function BitmapWithBackgroundFromPixmap32:Int( pix:TPixmap, pRed, pGreen, pBlue ) - - Local tmpPixel, tmpRed, tmpGreen, tmpBlue, tmpAlpha, tmpAlphaFloat#, tmpAlphaFloat2# - Local pix2:TPixmap = CreatePixmap( pix.width, pix.height, pix.format), x - - For Local y:Int = 0 Until pix.height - For x = 0 Until pix.width - - 'Read pixel and alpha info - tmpPixel = ReadPixel(pix,x,y) - tmpAlpha = ((tmpPixel Shr 24) & $FF) - tmpAlphaFloat = tmpAlpha/255.0 - tmpAlphaFloat2 = 1-tmpAlphaFloat - - 'Get individual colours - tmpBlue = tmpPixel & $FF;tmpGreen = (tmpPixel Shr 8) & $FF;tmpRed = (tmpPixel Shr 16)&$FF - - 'Courtesy of Mark T - tmpRed = (tmpRed * tmpAlphaFloat) + (tmpAlphaFloat2 * pRed) - tmpGreen = (tmpGreen * tmpAlphaFloat) + (tmpAlphaFloat2 * pGreen) - tmpBlue = (tmpBlue * tmpAlphaFloat) + (tmpAlphaFloat2 * pBlue) - - 'Write the new pixels - WritePixel(pix2,x,y,(tmpAlpha Shl 24)|(tmpRed Shl 16)|(tmpGreen Shl 8)|tmpBlue) - Next - Next - - Return BitmapFromPixmap(pix2,False) - - EndFunction - - Function IconFromPixmap32:Int(pix:TPixmap) - - ' Convert the pixmap to a HBITMAP - Local bitmap = BitmapFromPixmap(pix,True) - - ' and then copy/resize it (to the default size for icons/cusors). - Local hSrcBMP = CopyImage(bitmap, IMAGE_BITMAP , 0 , 0 , LR_DEFAULTSIZE) - - ' Now we need to create a mask bitmap for the image - Local hMaskBMP = BitmapMaskFromPixmap( pix ) - - ' So now we have our source and mask bitmaps, we can create an ICONINFO structure - Local IconInf:ICONINFO = New IconInfo - IconInf.fIcon = True - IconInf.hbmMask = hMaskBMP - IconInf.hbmColor = hSrcBMP - - ' Create the icon - Local tmpIcon = CreateIconIndirect(IconInf) - - ' Free our temporary bitmaps - DeleteObject(hMaskBMP) - DeleteObject(hSrcBMP) - DeleteObject(bitmap) - - Return tmpIcon - - EndFunction - -EndType - -Private - -Function KeyMods() - Local mods - If GetKeyState(VK_SHIFT)&$8000 mods:|MODIFIER_SHIFT - If GetKeyState(VK_CONTROL)&$8000 mods:|MODIFIER_CONTROL - If GetKeyState(VK_MENU)&$8000 mods:|MODIFIER_OPTION - If GetKeyState(VK_LWIN)&$8000 Or GetKeyState(VK_RWIN)&$8000 mods:|MODIFIER_SYSTEM - Return mods -EndFunction - -Function FindGadgetWindowHwnd(g:TGadget) - Local wg:TWindowsWindow - While g - wg=TWindowsWindow(g) - If wg Return wg.Query(QUERY_HWND) 'handle - g=g.parent - Wend -EndFunction - -Type TIntWrapper Final - Field value:Int - Function Create:TIntWrapper(value:Int) - Local tmpWrapper:TIntWrapper = New TIntWrapper - tmpWrapper.value = value - Return tmpWrapper - EndFunction - Method Compare( o:Object ) - Local c:TIntWrapper = TIntWrapper(o) - If c Then Return (value - c.value) - Return Super.Compare(o) - EndMethod - Method ToString$() - Return value - EndMethod -EndType +Rem +bbdoc: MaxGUI Drivers/Win32MaxGUIEx +End Rem +Module MaxGUI.Win32MaxGUIEx + +ModuleInfo "Version: 0.75" +ModuleInfo "Author: Simon Armstrong, Seb Hollington" +ModuleInfo "License: zlib/libpng" + +Strict + +?Win32 +Import MaxGUI.MaxGUI +Import "winimports.bmx" + +maxgui_driver = New TWindowsGUIDriver + +Type TWindowsGUIDriver Extends TMaxGUIDriver + + Global GadgetMap:TMap + Global GDIDesktop:TWindowsDesktop + Global GDIFont:TWindowsFont + Global ClassAtom + Global ClassAtom2 + Global KBMessageHook,MouseMessageHook + + Global windowtheme:Short Ptr + Global _cursor, _commoncontrolversion[] + Global _explorerstyle = False + Global _activeWindow:TWindowsWindow = Null + + Global _customcolors[] = [$FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, .. + $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF, $FFFFFF ] + + Global _hwndTooltips% + + Global intDontReleaseCapture% = False 'See WM_CAPTURECHANGED + + Method New() + + 'Initialize libraries + OleInitialize(Null) + Local icc:TINITCOMMONCONTROLSEX = New TINITCOMMONCONTROLSEX + icc.dwSize = SizeOf(icc) + icc.dwICC = ICC_WIN95_CLASSES|ICC_USEREX_CLASSES'|ICC_COOL_CLASSES'|ICC_DATE_CLASSES + InitCommonControlsEx icc + + 'Initialize Global Variables + GDIFont=TWindowsFont.DefaultFont() + GadgetMap=New TMap + GDIDesktop=New TWindowsDesktop + + 'Set-up Message Hooks + KBMessageHook=SetWindowsHookExW(WH_KEYBOARD,KeyboardProc,GetModuleHandleW(Null),GetCurrentThreadId()) + MouseMessageHook=SetWindowsHookExW(WH_MOUSE,MouseProc,GetModuleHandleW(Null),GetCurrentThreadId()) + + 'Gadget Tooltips + _hwndTooltips = CreateWindowExW( 0,"tooltips_class32","",WS_POPUP|TTS_ALWAYSTIP,0,0,0,0,GDIDesktop._hwnd,0,GetModuleHandleW(Null),Null ) + SendMessageW( _hwndTooltips, TTM_SETMAXTIPWIDTH, 0, 300 ) + SetWindowPos( _hwndTooltips, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE ) + + EndMethod + + Method Delete() + DestroyWindow( _hwndTooltips );_hwndTooltips = 0 + UnhookWindowsHookEx MouseMessageHook + UnhookWindowsHookEx KBMessageHook + EndMethod + + Method UserName$() + Return getenv_("username") + End Method + + Method ComputerName$() + Return getenv_("userdomain") + End Method + + 'Low-level Win32 interface + + Function RegisterHwnd(hwnd,gadget:TWindowsGadget) + GadgetMap.Insert TIntWrapper.Create(hwnd),gadget + EndFunction + + Function RemoveHwnd(hwnd) + GadgetMap.Remove TIntWrapper.Create(hwnd) + EndFunction + + Function GadgetFromHwnd:TWindowsGadget(hwnd) nodebug + Return TWindowsGadget(GadgetMap.ValueForKey(TIntWrapper.Create(hwnd))) + EndFunction + + Function ClassWndProc(hwnd,msg,wp,lp) "win32" + Local owner:TWindowsGadget + Local res + Local nmhdr:Int Ptr + + '?Debug And Win32 + 'Print TWindowsDebug.ReverseLookupMsg(msg) + ", hwnd: " + hwnd + ", wp: " + wp + ", lp: " + lp + '?Win32 + + Select msg + + Case WM_MENUCHAR + + If HotKeyEventFromWp(wp & $FF) Then + Return (MNC_CLOSE Shl 16) + Else + Return (MNC_IGNORE Shl 16) + EndIf + + Case WM_SIZE + + owner = GadgetFromHwnd(hwnd) + If owner And Not TWindowsWindow(owner) Then + If hwnd = owner.Query(QUERY_HWND) Then owner.RethinkClient() + If hwnd = owner.Query(QUERY_HWND_CLIENT) Then owner.LayoutKids() + EndIf + + Case WM_CTLCOLORSTATIC, WM_CTLCOLOREDIT, WM_CTLCOLORBTN + + owner=GadgetFromHwnd(lp) + + Select True + + Case TWindowsLabel(owner) <> Null + + SetBkMode(wp, TRANSPARENT) + If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) + Return owner.CreateControlBrush( owner._hwnd, wp ) + + Case TWindowsPanel(owner) <> Null + + If TWindowsPanel(owner)._type = TWindowsPanel.PANELGROUP Then + + SetBkMode(wp, TRANSPARENT) + If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) + Return owner.CreateControlBrush( lp, wp ) + + EndIf + + Case TWindowsTextField(owner) <> Null, TWindowsComboBox(owner) <> Null + + If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) + If owner.BgBrush() Then SetBkColor(wp, owner.BgColor());Return owner.BgBrush() + + Case TWindowsButton(owner) <> Null, TWindowsSlider(owner) <> Null + + SetBkMode(wp, TRANSPARENT) + If owner.FgColor() > -1 Then SetTextColor_(wp, owner.FgColor()) + Return owner.CreateControlBrush( owner._hwnd, wp ) + + EndSelect + + owner = Null + + Case WM_COMMAND,WM_HSCROLL,WM_VSCROLL + If lp Then + owner=GadgetFromHwnd(lp) + 'Fix for tab control's up/down arrow. + If Not owner Then owner = GadgetFromHwnd(GetParent_(lp)) + Else + owner=GadgetFromHwnd(hwnd) 'Fixed for menu events + EndIf + + If Not owner Then owner = GadgetFromHwnd(hwnd) + + If owner Then + res=owner.OnCommand(msg,wp) + If Not res And owner._proc And owner._hwnd = hwnd Return CallWindowProcW(owner._proc,hwnd,msg,wp,lp) + Return res + Else + Return DefWindowProcW( hwnd,msg,wp,lp ) + EndIf + + Case WM_NOTIFY + + 'Gadget tooltips + nmhdr=Int Ptr(lp) + owner=GadgetFromHwnd(nmhdr[0]) + If owner Then + Select nmhdr[2] + Case TTN_GETDISPINFOW + If owner._wstrTooltip Then nmhdr[3] = Int(owner._wstrTooltip) + EndSelect + Return owner.OnNotify(wp,lp) + EndIf + + Case WM_SETCURSOR + + If _cursor Then + SetCursor(_cursor) + Return 1 + EndIf + + Case WM_ACTIVATEAPP, WM_ACTIVATE + + SystemEmitOSEvent(hwnd,msg,wp,lp,Null) + + Case WM_DPICHANGED + Local g_dpi = wp Shr 16 +' UpdateDpiDependentFontsAndResources(); + DebugLog "DPICHANGED to "+g_dpi + + Case WM_DRAWITEM + + Local tmpDrawItemStruct:DRAWITEMSTRUCT = New DRAWITEMSTRUCT + MemCopy tmpDrawItemStruct, Byte Ptr lp, SizeOf(tmpDrawItemStruct) + + owner = GadgetFromHwnd(tmpDrawItemStruct.hwndItem) + If owner And owner.OnDrawItem( tmpDrawItemStruct ) Then Return True + + owner = Null + + 'Allow BRL.System to handle mouse/key events on sensitive gadgets. + + Case WM_CAPTURECHANGED + + 'For preventing problem where controls which called SetCapture() internally + 'had their capture prematurely released by the ReleaseCapture() call in BRL.System. + intDontReleaseCapture = False + 'If SetCapture() is called again after BRL.System's call (when the new + 'capture hwnd [lp] = old hwnd [hwnd]) then we dont want to call ReleaseCapture() in BRL.System + 'when WM_MOUSEBUTTONUP is received by the system hook TWindowsGUIDriver.MouseProc(). + If (lp = hwnd) And (Not intEmitOSEvent) Then intDontReleaseCapture = True + + Default + + 'Added preliminary check to avoid searching for a gadget in GadgetMap un-necessarily. + If (msg = WM_MOUSEWHEEL) Or (msg = WM_MOUSELEAVE) Or (msg>=WM_KEYFIRST And msg<=WM_KEYLAST) Then + owner=GadgetFromHwnd(hwnd) + If owner Then + Select msg + Case WM_MOUSELEAVE, WM_MOUSEWHEEL + If (owner.sensitivity&SENSITIZE_MOUSE) Then SystemEmitOSEvent hwnd,msg,wp,lp,owner + Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP, WM_CHAR, WM_SYSCHAR + If (owner.sensitivity&SENSITIZE_KEYS) And Not GadgetDisabled(owner) Then + SystemEmitOSEvent hwnd,msg,wp,lp,owner + EndIf + If (msg<>WM_CHAR And msg<>WM_SYSCHAR) And HotKeyEventFromWp(wp) Then Return 1 + EndSelect + EndIf + EndIf + + EndSelect + + If Not owner Then owner=GadgetFromHwnd(hwnd) + If owner Return owner.WndProc(hwnd,msg,wp,lp) + + Return DefWindowProcW( hwnd,msg,wp,lp ) + + EndFunction + + Function KeyboardProc( code,wparam,lparam ) "win32" nodebug + Local ev:TEvent, hwnd%, tmpClassName:Short[16], mods:Int, key:Int = wparam + If code>=0 Then + 'Removed: http://www.blitzbasic.com/Community/posts.php?topic=72737 +' Rem + If wparam = $D Then '$D: VK_RETURN + hwnd = GetFocus() + If hwnd And GetClassNameW(hwnd,tmpClassName,tmpClassName.length) And String.FromWString(tmpClassName).ToUpper() = "EDIT" Then + SetFocus(GetParent_(hwnd)) + EndIf + EndIf +' EndRem + + ev = HotkeyEventFromWp(wparam) + If ev + 'Hot-key events shouldn't be emitted if the source gadget is disabled + If Not(TGadget(ev.source) And GadgetDisabled(TGadget(ev.source))) Then + If Not (lparam & $80000000) Then + EmitEvent ev + If ev.mods Then Return 1 'Key press events never reach active panels etc. if we return 1 + EndIf + EndIf + EndIf + EndIf + Return CallNextHookEx( KBMessageHook,code,wparam,lparam ); + EndFunction + + Function HotkeyEventFromWp:TEvent(wparam) + Local key = wparam, mods = KeyMods() + Select wparam + Case VK_SHIFT, $A0, $A1 + If (wparam=VK_SHIFT) Then key = KEY_LSHIFT + mods:&~MODIFIER_SHIFT + Case VK_CONTROL, $A2, $A3 + If (wparam=VK_CONTROL) Then key = KEY_LCONTROL + mods:&~MODIFIER_CONTROL + Case VK_MENU, $A4, $A5 + If (wparam=VK_MENU) Then key = KEY_LALT + mods:&~MODIFIER_ALT + Case VK_LWIN, VK_RWIN + mods:&~MODIFIER_SYSTEM + EndSelect + Return HotKeyEvent( key,mods,GetForegroundWindow() ) + EndFunction + + Global intButtonStates%[3] + + Function MouseProc( code,wparam,lparam ) "win32" nodebug + + If code>=0 And wparam >= WM_MOUSEFIRST And wparam <= WM_MOUSELAST Then 'Not needed as MouseProc only receives mouse messages!!! + + Local MOUSEHOOKSTRUCT:Int Ptr = Int Ptr(lparam), wp, lp, data + Local hwnd% = MOUSEHOOKSTRUCT[2], msg% = wparam, owner:TWindowsGadget + Local point:Int[] = [MOUSEHOOKSTRUCT[0],MOUSEHOOKSTRUCT[1]] + + Select msg + Case WM_LBUTTONDOWN, WM_LBUTTONDBLCLK + data = MOUSE_LEFT + msg = WM_LBUTTONDOWN + intButtonStates[MOUSE_LEFT] = True + Case WM_LBUTTONUP + data = MOUSE_LEFT + intButtonStates[MOUSE_LEFT] = False + Case WM_RBUTTONDOWN, WM_RBUTTONDBLCLK + data = MOUSE_RIGHT + msg = WM_RBUTTONDOWN + intButtonStates[MOUSE_RIGHT] = True + Case WM_RBUTTONUP + data = MOUSE_RIGHT + intButtonStates[MOUSE_RIGHT] = False + Case WM_MBUTTONDOWN, WM_MBUTTONDBLCLK + data = MOUSE_MIDDLE + msg = WM_MBUTTONDOWN + intButtonStates[MOUSE_MIDDLE] = True + Case WM_MBUTTONUP + data = MOUSE_MIDDLE + intButtonStates[MOUSE_MIDDLE] = False + EndSelect + + owner = GadgetFromHwnd(hwnd) + If owner And ScreenToClient( hwnd, point ) Then + + If data And (Not intButtonStates[data]) And TGadget.dragGadget[data-1] Then + PostGuiEvent EVENT_GADGETDROP, owner, data, KeyMods(), point[0], point[1], TGadget.dragGadget[data-1] + TGadget.dragGadget[data-1] = Null + EndIf + + If (owner.sensitivity&SENSITIZE_MOUSE) Then + + 'Fake wp parameter to pass onto bbSystemEmitOSEvent + If intButtonStates[MOUSE_LEFT] Then wp:|MK_LBUTTON + If intButtonStates[MOUSE_MIDDLE] Then wp:|MK_MBUTTON + If intButtonStates[MOUSE_RIGHT] Then wp:|MK_RBUTTON + If GetKeyState(VK_SHIFT)&$8000 Then wp:|MK_SHIFT + If GetKeyState(VK_CONTROL)&$8000 Then wp:|MK_CONTROL + + lp = (Short(point[1]) Shl 16) | Short(point[0]) + 'Sort and determine whether to emit the event + Select msg + Case WM_MOUSEMOVE + If (owner._oldcursorlp<>lp) Then + owner._oldcursorlp=lp + SystemEmitOSEvent hwnd,msg,wp,lp,owner + EndIf + Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP + If intDontReleaseCapture Then + PostGuiEvent EVENT_MOUSEUP, owner, data + Else + SystemEmitOSEvent hwnd,msg,wp,lp,owner + EndIf + Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN + SystemEmitOSEvent hwnd,msg,wp,lp,owner + EndSelect + + EndIf + EndIf + EndIf + Return CallNextHookEx( MouseMessageHook,code,wparam,lparam ) + EndFunction + + Global intEmitOSEvent + + Function SystemEmitOSEvent( hwnd, msg, wp, lp, owner:TGadget ) + intEmitOSEvent:+1 + If owner Then + While owner.source + owner = owner.source + Wend + EndIf + Local tmpResult% = bbSystemEmitOSEvent( hwnd, msg, wp, lp, owner ) + intEmitOSEvent:-1 + Return tmpResult + EndFunction + + Function ClassName$() + Global _name$ + Global _wc:WNDCLASSW + Global _icon + + If Not _name + _name="BLITZMAX_WINDOW_CLASS" + _icon=LoadIconW(GetModuleHandleW(Null),Short Ptr(101)) + _wc=New WNDCLASSW + _wc.style=CS_OWNDC|CS_HREDRAW|CS_VREDRAW + _wc.lpfnWndProc=ClassWndProc + _wc.hInstance=GetModuleHandleW(Null) + _wc.hIcon=_icon + _wc.hCursor=LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) + _wc.hbrBackground=COLOR_BTNSHADOW + _wc.lpszMenuName=Null + _wc.lpszClassName=_name.ToWString() + _wc.cbWndExtra=DLGWINDOWEXTRA + ClassAtom=RegisterClassW(_wc) + EndIf + Return _name + EndFunction + + Function DialogClassName$() + Global _dname$ + Global _dc:WNDCLASSW + + If Not _dname + _dname="BLITZMAX_DIALOG_CLASS" + _dc=New WNDCLASSW + _dc.style=CS_OWNDC|CS_HREDRAW|CS_VREDRAW + _dc.lpfnWndProc=ClassWndProc + _dc.hInstance=GetModuleHandleW(Null) + _dc.hCursor=LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) + _dc.hbrBackground=COLOR_BTNSHADOW + _dc.lpszMenuName=Null + _dc.lpszClassName=_dname.ToWString() + _dc.cbWndExtra=DLGWINDOWEXTRA + ClassAtom2=RegisterClassW(_dc) + EndIf + Return _dname + EndFunction + + 'TMaxGuiDriver interface + + Method CreateGadget:TGadget(class,Text$,x,y,w,h,group:TGadget,style) + + Select class + Case GADGET_WINDOW + If Not group group=GDIDesktop + End Select + + Local gadget:TGadget = GadgetInstanceFromClass(class,group,style,Text) + + Select class + Case GADGET_DESKTOP, GADGET_MENUITEM, GADGET_NODE + Return gadget + End Select + + If LocalizationMode() & LOCALIZATION_OVERRIDE Then + LocalizeGadget(gadget,Text,"") + Else + gadget.SetText(Text) + EndIf + + If group Then gadget._SetParent group + If class <> GADGET_TOOLBAR Then gadget.SetShape(x,y,w,h) + + 'v0.51: Gadgets are now only shown when they have been sized, and the text set. + If TWindowsGadget(gadget) Then + If Not TWindowsWindow(gadget) + gadget.SetFont(GDIFont) + If TWindowsGadget(group) Then + TWindowsGadget(gadget)._forceDisable = Not( TWindowsGadget(group)._enabled And Not TWindowsGadget(group)._forceDisable ) + gadget.SetEnabled(Not (gadget.State()&STATE_DISABLED)) + EndIf + gadget.SetShow(True) + ElseIf Not (style & WINDOW_HIDDEN) Then + gadget.SetShow(True) + EndIf + EndIf + + If TWindowsGadget(gadget) Then TWindowsGadget(gadget).Sensitize() + + Return gadget + EndMethod + + Method GadgetInstanceFromClass:TGadget(class, group:TGadget, style = 0, Text$ = "") + + Local gadget:TGadget + + Select class + Case GADGET_DESKTOP + gadget=GDIDesktop + Case GADGET_MENUITEM + gadget=New TWindowsMenu.Create(group,style,Text) + Case GADGET_WINDOW + gadget=New TWindowsWindow.Create(group,style) + Case GADGET_BUTTON + gadget=New TWindowsButton.Create(group,style) + Case GADGET_TEXTFIELD + gadget=New TWindowsTextField.Create(group,style,Text) + Case GADGET_TEXTAREA + gadget=New TWindowsTextArea.Create(group,style) + Case GADGET_COMBOBOX + gadget=New TWindowsComboBox.Create(group,style,Text) + Case GADGET_LISTBOX + gadget=New TWindowsListBox.Create(group,style) + Case GADGET_TOOLBAR + gadget=New TWindowsToolBar.Create(group,style,Text) + Case GADGET_TABBER + gadget=New TWindowsTabber.Create(group,style) + Case GADGET_NODE + gadget=New TWindowsTreeNode.Create(group,style,Text) + Case GADGET_TREEVIEW + gadget=New TWindowsTreeView.Create(group,style) + Case GADGET_LABEL + gadget=New TWindowsLabel.Create(group,style) + Case GADGET_SLIDER + gadget=New TWindowsSlider.Create(group,style) + Case GADGET_PROGBAR + gadget=New TWindowsProgressBar.Create(group,style) + Case GADGET_PANEL + gadget=New TWindowsPanel.Create(group,style) + Case GADGET_CANVAS + gadget=New TWindowsPanel.Create(group,style|PANEL_CANVAS|PANEL_ACTIVE) + Case GADGET_HTMLVIEW + gadget=New TWindowsHTMLView.Create(group,style) + End Select + + Return gadget + + EndMethod + + Method ActiveGadget:TGadget() + Local tmpHwnd:Int = GetFocus(), tmpGadget:TGadget + While tmpHwnd + tmpGadget = GadgetFromHwnd( tmpHwnd ) + If tmpGadget Then Exit + tmpHwnd = GetParent_(tmpHwnd) + Wend + Return tmpGadget + EndMethod + + Method RequestColor(red,green,blue) + Local cc:CHOOSECOLOR = New CHOOSECOLOR + cc.lStructSize=SizeOf(cc) + cc.hwndOwner=GetActiveHwnd() + cc.rgbResult=(red)|(green Shl 8)|(blue Shl 16) + cc.lpCustColors=_customcolors + cc.Flags=CC_RGBINIT|CC_FULLOPEN|CC_ANYCOLOR + Local hwnd = GetFocus() + Local n = ChooseColorW(cc) + SetFocus(hwnd) + If Not n Return 0 + n = ((cc.rgbResult Shr 16)&$ff) | (cc.rgbResult&$ff00) | ((cc.rgbResult Shl 16)&$ff0000) + Return n|$ff000000 + EndMethod + + Method LookupColor( colorindex:Int, red:Byte Var, green:Byte Var, blue:Byte Var ) + + Select colorindex + Case GUICOLOR_WINDOWBG + colorindex = COLOR_BTNFACE + Case GUICOLOR_GADGETBG + colorindex = COLOR_WINDOW + Case GUICOLOR_GADGETFG + colorindex = COLOR_WINDOWTEXT + Case GUICOLOR_LINKFG + colorindex = COLOR_HOTLIGHT + Case GUICOLOR_SELECTIONBG + colorindex = COLOR_HIGHLIGHT + Default + Return Super.LookupColor( colorindex, red, green, blue ) + EndSelect + + Local tmpColor:Int = GetSysColor( colorindex ) + red = tmpColor & $FF + green = (tmpColor Shr 8) & $FF + blue = (tmpColor Shr 16) & $FF + + Return True + + EndMethod + + Method LoadFont:TGuiFont(name$,size,flags) + Return New TWindowsFont.Load(name,Double(size),flags) + EndMethod + + Method LoadFontWithDouble:TGuiFont(name$,size:Double,flags) + Return New TWindowsFont.Load(name,size,flags) + EndMethod + + Method LibraryFont:TGuiFont( pFontType% = GUIFONT_SYSTEM, pFontSize:Double = 0, pFontStyle% = FONT_NORMAL ) + If pFontType = GUIFONT_SYSTEM Then Return TWindowsFont.DefaultFont( pFontSize, pFontStyle ) Else Return Super.LibraryFont( pFontType, pFontSize, pFontStyle ) + EndMethod + + Method RequestFont:TGuiFont(font:TGuiFont) + Return TWindowsFont.Request(font) + EndMethod + + Method SetPointer(shape) + Global winptrs[]=[0,32512,32513,32514,32515,32516,32642,32643,32644,32645,32646,32648,32649,32650,32651] + If shape<1 Or shape>14 Then _cursor = LoadCursorW( 0,Short Ptr( IDC_ARROW ) ) Else _cursor=LoadCursorW(0,Short Ptr(winptrs[shape])) + SetCursor(_cursor) + If TWindowsTextArea._oldCursor Then TWindowsTextArea._oldCursor = _cursor + If shape = 0 Then _cursor = 0 + EndMethod + + Method LoadIconStrip:TIconStrip(source:Object) + Return TWindowsIconStrip.Create(source) + EndMethod + + Function CheckCommonControlVersion() 'Returns True if supports alpha/themes etc. or False if not. + If Not _commoncontrolversion Then + Local libComCtl = LoadLibraryW("comctl32.dll") + Local GetCommonControlVersion( pDllVersionInfo:Byte Ptr ) "win32" = GetProcAddress(libComCtl, "DllGetVersion") + If GetCommonControlVersion Then + Local tmpDllVersion:DLLVERSIONINFO2 = New DLLVERSIONINFO2 + GetCommonControlVersion( tmpDllVersion ) + _commoncontrolversion = [tmpDllVersion.dwMajorVersion,tmpDllVersion.dwMinorVersion,tmpDLLVersion.dwBuildNo] + EndIf + GetCommonControlVersion = Null + FreeLibrary( libComCtl ) + EndIf + If _commoncontrolversion And _commoncontrolversion[0] >= 6 Then + If (_commoncontrolversion[0] > 6) Or (_commoncontrolversion[1] > 0) Then Return 2 Else Return 1 + EndIf + EndFunction + + Function GetThemeHandle(hwnd, pClass$ = "WINDOW") + If OpenThemeData And CheckCommonControlVersion() Then Return OpenThemeData(hwnd, pClass) + EndFunction + + Function CloseThemeHandle(hTheme) + If CloseThemeData Then Return CloseThemeData(hTheme) + EndFunction + + Function CreateExplorerStyleGadgets( pDisable = False ) + _explorerstyle = (pDisable <> True) + EndFunction + + Function GetActiveHwnd() + If _activeWindow Then Return _activeWindow._hwnd Else Return GetActiveWindow() + EndFunction + +EndType + +Type TWindowsGadget Extends TGadget + + 'Flag that determines whether gadgets should redraw when they are resized (see Rethink()). + Global _resizeRedraw = True + + 'Generic Unicode Strings to prevent memory-leak + Global _wstrEmpty:Short Ptr = "".ToWString() + Global _wstrSpace:Short Ptr = " ".ToWString() + Global _wstrExplorer:Short Ptr = "Explorer".ToWString() + + 'Important gadget fields that store OS control handles etc.. + + Field _class, _hwnd, _hwndclient, _tooltips + Field _proc(hwnd,msg,wp,lp) "win32" + Field _hotkey:THotKey + Field _oldcursorlp 'Should track events + + Field _sensitive% = False 'Determines whether gadgets should generate events. + 'Not to be confused with the sensitivity field of TGadget + 'which specifies which type of events are fired. + + 'Aesthetics + Field _bgbrush, _fgcolor = -1, _bgcolor = -1 'Background colour + Field _hbrush, _hbitmap 'Background colour + Field _bitmap 'Background bitmap + Field _iconBitmap 'Icon bitmap + Field _hTheme 'Open handle to XP Theme API (for use in button's WM_DRAWITEM etc.) + Field _font:TWindowsFont 'Font (needs to be stored, otherwise it may be collected by GC) + Field _wstrTooltip:Short Ptr, _toolAdded = False + Field _clientX:Int, _clientY:Int, _enabled:Int = True, _forcedisable:Int = False + + Method Create:TWindowsGadget(group:TGadget, style, Text$="") Abstract + + Method SetColor(red,green,blue) + If _bgbrush Then DeleteObject _bgbrush + _bgcolor = (blue Shl 16) | (green Shl 8) | red + _bgbrush=CreateSolidBrush(_bgcolor) + RedrawGadget(Self) + EndMethod + + Method RemoveColor() + If _bgbrush Then DeleteObject _bgbrush + _bgbrush=0 + RedrawGadget(Self) + EndMethod + + Method FgColor() + Return _fgcolor + EndMethod + + Method BgColor() + Return _bgcolor + EndMethod + + Method BgBrush() + Return _bgbrush + EndMethod + + Method SetTextColor(r,g,b) + _fgcolor = (b Shl 16) | (g Shl 8) | r + RedrawGadget(Self) + EndMethod + + Method Query(queryid) + Select queryid + Case QUERY_HWND + Return _hwnd + Case QUERY_HWND_CLIENT + If _hwndclient Return _hwndclient + Return _hwnd + End Select + EndMethod + + Method Register(class,hwnd,hwndclient=0,tips=False) + _class=class + _hwnd=hwnd + _hwndclient=hwndclient + TWindowsGUIDriver.RegisterHwnd(_hwnd,Self) + If _hwndclient TWindowsGUIDriver.RegisterHwnd(_hwndclient,Self) + Local atom=GetClassLongW(hwnd,GCW_ATOM) + If atom<>TWindowsGUIDriver.ClassAtom And atom<>TWindowsGUIDriver.ClassAtom2 And Not _proc + _proc=Byte Ptr(SetWindowLongW(hwnd,GWL_WNDPROC,Int Byte Ptr TWindowsGUIDriver.ClassWndProc)) + EndIf + If tips Then SetupToolTips() + EndMethod + + Method SetupToolTips() + If _tooltips Then DestroyWindow _tooltips;TWindowsGUIDriver.RemoveHwnd(_tooltips);_tooltips = 0 + _tooltips = CreateWindowExW( 0,"tooltips_class32","",TTS_ALWAYSTIP,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,_hwnd,0,GetModuleHandleW(Null),Null ) + SendMessageW _tooltips,TTM_SETMAXTIPWIDTH,0,300 + TWindowsGUIDriver.RegisterHwnd( _tooltips, Self ) + EndMethod + + Method isTabbable() + Local style:Int = GetWindowLongW(_hwnd,GWL_STYLE)&(WS_TABSTOP|WS_CHILD) + Return (style=(WS_TABSTOP|WS_CHILD)) + EndMethod + + Method isControl() + Return (GetWindowLongW(_hwnd,GWL_STYLE)&(WS_CHILD)=WS_CHILD) + EndMethod + + Method Activate(cmd) + Select cmd + Case ACTIVATE_FOCUS + If isTabbable() + DefDlgProcW GetParent_(_hwnd),WM_NEXTDLGCTL,_hwnd,1 + Return 1 + EndIf + Return SetFocus(_hwnd) + Case ACTIVATE_BACK + Return SendMessageW(_hwnd,WM_NEXTDLGCTL,1,0) + Case ACTIVATE_FORWARD + Return SendMessageW(_hwnd,WM_NEXTDLGCTL,0,0) + Case ACTIVATE_REDRAW + RefreshLook() + Return RedrawWindow( _hwnd, Null, Null, RDW_INVALIDATE | RDW_ERASE | RDW_FRAME | RDW_ALLCHILDREN ) + End Select + EndMethod + + Method Rethink() + QueueResize(_hwnd,xpos,ypos,width,height) + EndMethod + + Method RethinkClient(forceRedraw:Int = False) + EndMethod + + Method SetArea(x,y,w,h) + SetRect(x,y,w,h) + Rethink() + EndMethod + + Method LayoutKids() + + StartResize() + + 'Implemented hack to speed-up drawing considerably... + Local tmpOldState = TWindowsGadget._resizeredraw + TWindowsGadget._resizeredraw = False + + 'Child windows are laid-out like normal... + Super.LayoutKids() + + 'Reposition all child gadgets together. + EndResize() + + 'If this control is the first parent who started the resizing, then redraw parent and all controls now. + If tmpOldState Then + If (Not kids.IsEmpty()) Then Activate(ACTIVATE_REDRAW) + TWindowsGadget._resizeredraw = True + EndIf + + EndMethod + + Method ClientWidth() + Local Rect[] = [xpos,ypos,xpos+width,ypos+height] + SendMessageW Query(QUERY_HWND), WM_NCCALCSIZE, False, Int Byte Ptr Rect + Return Rect[2]-Rect[0]-_clientX + EndMethod + + Method ClientHeight() + Local Rect[] = [xpos,ypos,xpos+width,ypos+height] + SendMessageW Query(QUERY_HWND), WM_NCCALCSIZE, False, Int Byte Ptr Rect + Return Rect[3]-Rect[1]-_clientY + EndMethod + + Method SetText(Text$) + Desensitize() + SetWindowTextW _hwnd, Text + Sensitize() + EndMethod + + Method GetText$() + Local strText:Short[GetWindowTextLengthW(_hwnd)+1] 'Must include NULL terminator. + GetWindowTextW _hwnd, strText, strText.length + Return String.FromWString( strText ) + EndMethod + + Method SetFont(font:TGuiFont) + If TWindowsFont(font) Then _font = TWindowsFont(font) Else _font = TWindowsGUIDriver.GDIFont + SendMessageW _hwnd,WM_SETFONT,font.handle,1 + EndMethod + + Method SetShow(show) + If show + ShowWindow _hwnd,SW_SHOW + Else + 'Requester fix - ShowWindow activates the last activated window when an active window is hidden, so if + 'a file requester/child gadget was the last window to be activated, then the program will lose focus as it is + 'trying to activate a non-existent window. + If parent And HasDescendant(ActiveGadget()) Then ActivateGadget(parent) + ShowWindow _hwnd,SW_HIDE + EndIf + EndMethod + + Method SetEnabled(enable) + _enabled = enable + enable = enable And Not _forceDisable + If Not((EnableWindow(_hwnd,enable)<>0) ~ enable) Then + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget._forceDisable = Not enable + If tmpGadget.isControl() Then tmpGadget.SetEnabled(tmpGadget._enabled) + Next + EndIf + EndMethod + + Method SetTooltip( pTooltip$ ) + + If _wstrTooltip Then MemFree _wstrTooltip;_wstrTooltip = Null + + Local tmpToolInfo:TOOLINFOW = New TOOLINFOW + tmpToolInfo.cbSize = SizeOf(tmpToolInfo) + tmpToolInfo.hwnd = GetParent_(_hwnd) + tmpToolInfo.hinst = GetModuleHandleW(Null) + tmpToolInfo.uID = _hwnd + + If pTooltip Then + _wstrTooltip = pTooltip.Replace("~r","").Replace("~n","~r~n").ToWString() + + tmpToolInfo.uFlags = TTF_IDISHWND|TTF_TRANSPARENT|TTF_SUBCLASS + tmpToolInfo.lpszText = _wstrTooltip + + If Not _toolAdded Then + _toolAdded = SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_ADDTOOLW, 0, Int Byte Ptr tmpToolInfo) + Else + SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_UPDATETIPTEXTW, 0, Int Byte Ptr tmpToolInfo) + EndIf + ElseIf _tooladded Then + SendMessageW(TWindowsGUIDriver._hwndTooltips, TTM_DELTOOLW, 0, Int Byte Ptr tmpToolInfo ) + _toolAdded = 0 + EndIf + + EndMethod + + Method GetTooltip$() + If _wstrTooltip Then Return String.FromWString(_wstrTooltip) + EndMethod + + Method State() + Local t, style = GetWindowLongW(_hwnd, GWL_STYLE) + If Not (style&WS_VISIBLE) Then t:|STATE_HIDDEN + If Not _enabled Then t:|STATE_DISABLED + Return t + EndMethod + + Method Free() + If _tooltips Then DestroyWindow _tooltips;_tooltips=0 + SetTooltip("") 'Free any tooltip memory allocations + If _hwnd Then DestroyWindow _hwnd;TWindowsGUIDriver.RemoveHwnd(_hwnd);_hwnd=0 + If _hwndclient Then TWindowsGUIDriver.RemoveHwnd(_hwndclient);_hwndclient=0 + FlushBrushes(False) + If _hotKey Then RemoveHotKey(_hotKey);_hotKey = Null + If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 + If _bitmap Then DeleteObject(_bitmap);_bitmap = 0 + If _bgbrush Then DeleteObject(_bgbrush);_bgbrush = 0 + If _htheme Then TWindowsGUIDriver.CloseThemeHandle(_hTheme);_hTheme = 0 + _font = Null + _SetParent Null + EndMethod + + Method OnNotify(wp,lp) + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_WINDOWPOSCHANGING + FlushBrushes() + EndSelect + If _proc And _hwnd = hwnd Then + Return CallWindowProcW(_proc,hwnd,msg,wp,lp) 'fixed auto scrollbars + EndIf + Return DefWindowProcW( hwnd,msg,wp,lp ) + EndMethod + + Method OnCommand(msg,wp) + EndMethod + + Method OnDrawItem( pDrawItemStruct:DRAWITEMSTRUCT ) + EndMethod + + Method SetHotKey(key,modifier) + Local ev:TEvent = CreateEvent( EVENT_GADGETACTION,Self ) + If _hotKey Then RemoveHotKey(_hotKey);_hotKey = Null + If key Then _hotkey=SetHotKeyEvent(key,modifier,ev,FindGadgetWindowHwnd(Self)) + EndMethod + + 'Slow back-up code for mimicking transparency for PANEL_GROUPs and when + 'DrawThemeParentBackground() is not available (i.e. on Windows 9x/2000). + Method CreateControlBrush( hWndControl, hdc = 0 ) + + Local xOffset, yOffset + Local hwndWindow = GetParent_(hwndControl) + Local rectWindow[4], rectControl[4], rectClient[4] + + If _hbrush Then Return _hbrush + + If BgBrush() Then + If hdc Then SetBkColor(hdc, BgColor()) + Return BgBrush() + EndIf + + Local tmpDC = GetDC( hwndWindow ) + + 'Fix required to offset background when controls are drawn with WS_EX_CLIENTEDGE (e.g. panel with PANEL_SUNKEN/PANEL_RAISED set) + If GetWindowLongW(hwndWindow,GWL_EXSTYLE)&(WS_EX_CLIENTEDGE|WS_EX_WINDOWEDGE) Then + xOffset = -GetSystemMetrics(SM_CXEDGE) + yOffset = -GetSystemMetrics(SM_CYEDGE) + EndIf + + GetClientRect( hwndControl, rectClient ) + GetWindowRect( hwndWindow, rectWindow ) + GetWindowRect( hwndControl, rectControl ) + + Local x = rectControl[0]-rectWindow[0] + Local y = rectControl[1]-rectWindow[1] + Local w = rectControl[2]-rectControl[0] + Local h = rectControl[3]-rectControl[1] + + Local dcBitmap = CreateCompatibleDC( tmpDC ) + Local bkgndBitmap = CreateCompatibleBitmap( tmpDC, rectWindow[2]-rectWindow[0], rectWindow[3]-rectWindow[1] ) + SelectObject( dcBitmap, bkgndBitmap ) + + 'InvalidateRect( hwndWindow, Null, False ) + SendMessageW hwndWindow, WM_ERASEBKGND, dcBitmap, 0 + + Local bkgndClientBitmap = CreateCompatibleBitmap( tmpDC, w, h ) + Local dcClientBitmap = CreateCompatibleDC( tmpDC ) + SelectObject( dcClientBitmap, bkgndClientBitmap ) + + BitBlt( dcClientBitmap, 0,0 , w, h, dcBitmap, x+xOffset, y+yOffset, ROP_SRCCOPY ) + + DeleteObject( bkgndBitmap ) + DeleteDC( dcBitmap ) + DeleteDC( dcClientBitmap ) + + _hbrush = CreatePatternBrush( bkgndClientBitmap ) + _hbitmap = bkgndClientBitmap + + ReleaseDC( hwndWindow, tmpDC ) + + Return _hbrush + + EndMethod + + 'Clears the parent background brushes. + Method FlushBrushes(pRecurse:Int = True) + Local tmpChanges:Int = 0 + If _hbrush Then + DeleteObject( _hbrush ) + _hbrush = 0 + tmpChanges:|True + EndIf + If _hBitmap Then + DeleteObject( _hBitmap ) + _hBitmap = 0 + tmpChanges:|True + EndIf + Return tmpChanges + EndMethod + + 'Method that returns a brush for drawing backgrounds. + Method DrawBackground( hdc, hwnd ) + + If BgBrush() Then SetBkColor(hdc, BgColor());Return BgBrush() + + Return DrawParentBackground( hdc, hwnd ) + + EndMethod + + 'Another method which mimics transparency on Windows Controls. + Function DrawParentBackground( hdc, hwndControl, pForceHack = False ) + + Local rectWindow[4], rectControl[4], rectClient[4] + Local hwndWindow = GetParent_(hwndControl) + + GetClientRect( hwndControl, rectClient ) + GetClientRect( hwndWindow, rectWindow ) + GetWindowRect( hwndControl, rectControl ) + + 'Ensures that the the drawing context is returned in exactly the same state that it was passed. + Local tmpSaveState = SaveDC( hdc ) + + If DrawThemeParentBackground And Not pForceHack Then + + DrawThemeParentBackground(hwndControl,hdc,rectClient) + + Else 'Again, slow back-up code in case DrawThemeParentBackground() is not available. + + Local tmpDC, xOffset, yOffset + + 'Fix required to offset background when controls are drawn with WS_EX_CLIENTEDGE (e.g. panel with PANEL_BORDER set) + If GetWindowLongW(hwndWindow,GWL_EXSTYLE)&WS_EX_CLIENTEDGE Then + xOffset = -GetSystemMetrics(SM_CXEDGE) + yOffset = -GetSystemMetrics(SM_CYEDGE) + EndIf + + tmpDC = GetDC( hwndWindow ) + + ScreenToClient( hwndWindow, rectControl ) + ScreenToClient( hwndWindow, Int Ptr (rectControl)+2 ) + + Local x = rectControl[0]+rectClient[0] + Local y = rectControl[1]+rectClient[1] + Local w = rectClient[2]-rectClient[0] + Local h = rectClient[3]-rectClient[1] + + Local bkgndBitmap = CreateCompatibleBitmap( tmpDC, rectWindow[2]-rectWindow[0], rectWindow[3]-rectWindow[1] ) + Local dcBitmap = CreateCompatibleDC( tmpDC ) + SelectObject( dcBitmap, bkgndBitmap ) + + InvalidateRect( hwndWindow, Null, False ) + SendMessageW hwndWindow, WM_ERASEBKGND, dcBitmap, 0 + + BitBlt( hdc, 0,0 , w, h, dcBitmap, x+xOffset, y+yOffset, ROP_SRCCOPY ) + + DeleteObject( bkgndBitmap ) + DeleteDC( dcBitmap ) + ReleaseDC( hwndWindow, tmpDC ) + + EndIf + + 'Ensures that the the drawing context is returned in exactly the same state that it was passed. + RestoreDC( hdc, tmpSaveState ) + + Return GetStockObject( NULL_BRUSH ) + + EndFunction + + Method Sensitize() + _sensitive = True + EndMethod + + Method DeSensitize() + _sensitive = False + EndMethod + + Method PostGuiEvent( pID%, pData%=0, pMods%=0, pX%=0, pY%=0, pExtra:Object = Null) + + Select True + Case TWindowsListBox(Self) <> Null, TWindowsTabber(Self) <> Null, TWindowsToolbar(Self) <> Null, TWindowsCombobox(Self) <> Null + If pData>-1 Then + If (ItemFlags(pData) & GADGETITEM_TOGGLE) Then SelectItem(pData,2) + EndIf + End Select + + If _sensitive Then MaxGUI.MaxGUI.PostGuiEvent( pID, Self, pData, pMods, pX, pY, pExtra ) + + EndMethod + + 'Resize Methods + + Field hdwpStruct + + Method StartResize() + If Not hdwpStruct Then + Local tmpCount = kids.Count() + If tmpCount Then hdwpStruct = BeginDeferWindowPos( tmpCount ) + EndIf + EndMethod + + Method QueueResize( hwnd, xpos, ypos, width, height ) + If parent And GetParent_(hwnd) = parent.Query(QUERY_HWND_CLIENT) And TWindowsGadget(parent).hdwpStruct Then + Local tmpFlags = SWP_NOOWNERZORDER | SWP_NOZORDER | SWP_NOACTIVATE' | SWP_NOCOPYBITS + If Not _resizeRedraw Then tmpFlags:| SWP_NOREDRAW + TWindowsGadget(parent).hdwpStruct = DeferWindowPos( TWindowsGadget(parent).hdwpStruct, hwnd, Null, xpos, ypos, width, height, tmpFlags ) + Else + MoveWindow( hwnd, xpos, ypos, width, height, _resizeRedraw ) + HasResized() + EndIf + EndMethod + + Method EndResize() + If hdwpStruct Then + EndDeferWindowPos( hdwpStruct );hdwpStruct = 0 + For Local tmpGadget:TWindowsGadget = EachIn kids + Sensitize() + tmpGadget.HasResized() + Next + EndIf + EndMethod + + 'Required for resizing columns in listboxes (has to be done outside WM_SIZE) + Method HasResized() + EndMethod + + 'Required to ensure problematic controls are updated when parent aesthetics are changed: + Method RefreshLook() + FlushBrushes(False) + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget.RefreshLook() + Next + EndMethod + +Rem + Method StartDoubleBuffer() + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget.StartDoubleBuffer() + Next + EndMethod + + Method EndDoubleBuffer() + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget.EndDoubleBuffer() + Next + EndMethod +EndRem +EndType + + +Type TWindowsDesktop Extends TWindowsGadget + + Method New() + Local Rect[4] + Local hwnd = GetDesktopWindow() + Register(GADGET_DESKTOP,hwnd,0,False) + GetClientRect hwnd,Rect + SetShape 0,0,Rect[2]-Rect[0],Rect[3]-Rect[1] + EndMethod + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Return Self + EndMethod + + Method SetTooltip( pTooltip$ ) + 'Shouldn't have tool-tips. + EndMethod + + Method Free() + 'Can't be free'd. + EndMethod + + Method Class() + Return GADGET_DESKTOP + EndMethod + + Method ClientHeight() + Local Rect[4] + If Super.ClientHeight() = height And SystemParametersInfoW( SPI_GETWORKAREA, 0, Int Byte Ptr Rect, 0 ) + Return Rect[3]-Rect[1] + Else + Return Super.ClientHeight() + EndIf + EndMethod + + Method ClientWidth() + Local Rect[4] + If Super.ClientWidth() = width And SystemParametersInfoW( SPI_GETWORKAREA, 0, Int Byte Ptr Rect, 0 ) + Return Rect[2]-Rect[0] + Else + Return Super.ClientWidth() + EndIf + EndMethod + +EndType + +Type TWindowsWindow Extends TWindowsGadget + + Field _wstyle, _xstyle + Field _minwidth,_minheight,_maxwidth = -1,_maxheight = -1 + Field _menu:TWindowsMenu + Field _hmenu + Field _status + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local hwnd, parent, client + Local classname$ = TWindowsGUIDriver.ClassName() + + Self.style = style + _wstyle=WS_CLIPSIBLINGS|WS_CLIPCHILDREN + If group Then parent = group.Query(QUERY_HWND) + + If (style&WINDOW_TITLEBAR) + _wstyle:|WS_OVERLAPPED|WS_SYSMENU + If style&WINDOW_RESIZABLE _wstyle:|WS_MINIMIZEBOX|WS_MAXIMIZEBOX + If group <> TWindowsGUIDriver.GDIDesktop And Not (style&WINDOW_TOOL) Then + classname$ = TWindowsGUIDriver.DialogClassName() + _xstyle:|WS_EX_DLGMODALFRAME + EndIf + Else + _wstyle:|WS_POPUP + EndIf + + If style&WINDOW_RESIZABLE Then _wstyle:|WS_SIZEBOX + If style&WINDOW_MENU Then _hmenu=CreateMenu_();AppendMenuW( _hmenu,MF_STRING,Null,_wstrEmpty ) + If style&WINDOW_TOOL Then _xstyle:|WS_EX_TOOLWINDOW + + ' Note: No WINDOW_HIDDEN case as gadgets are always created hidden to hide initial resize flicker. + ' TWindowsGUIDriver.CreateGadget() will later show window if WINDOW_HIDDEN is not specified. + + hwnd=CreateWindowExW(_xstyle,classname,"",_wstyle,0,0,0,0,parent,_hmenu,GetModuleHandleW(Null),Null) + + If style&WINDOW_STATUS + _status=CreateWindowExW(0,"msctls_statusbar32","",WS_CHILD|WS_VISIBLE,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) + SetWindowPos( _status, HWND_TOPMOST,0,0,0,0,SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOSIZE) + EndIf + + client=CreateWindowExW(0,TWindowsGUIDriver.ClassName(),"",WS_CHILD|WS_VISIBLE|WS_CLIPCHILDREN|WS_CLIPSIBLINGS,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) + + Register GADGET_WINDOW,hwnd,client,False + + If style&WINDOW_ACCEPTFILES Then DragAcceptFiles _hwnd,True + _wstyle = GetWindowLongW( hwnd, GWL_STYLE ) + + Return Self + EndMethod + + Method SetAlpha( alpha# ) + If SetLayeredWindowAttributes Then + Local tmpStyle% = GetWindowLongW(_hwnd, GWL_EXSTYLE) + If alpha = 1.0 Then + SetLayeredWindowAttributes( _hwnd, 0, Byte(alpha*255), LWA_ALPHA) + If (tmpStyle & WS_EX_LAYERED) Then SetWindowLongW(_hwnd, GWL_EXSTYLE, tmpStyle&~WS_EX_LAYERED) + Else + If Not (tmpStyle & WS_EX_LAYERED) Then SetWindowLongW(_hwnd, GWL_EXSTYLE, tmpStyle|WS_EX_LAYERED) + SetLayeredWindowAttributes( _hwnd, 0, Byte(alpha*255), LWA_ALPHA) + EndIf + RedrawGadget(Self) + EndIf + EndMethod + + Method Rethink() + Local dimensions[] = [xpos,ypos,width,height] + ConvertToContainerDimensions( dimensions[0], dimensions[1], dimensions[2], dimensions[3] ) + MoveWindow _hwnd, dimensions[0], dimensions[1], dimensions[2], dimensions[3], True + RethinkClient(True) + EndMethod + + Method RethinkClient(forceRedraw:Int = False) + If _hwndClient Then + MoveWindow _hwndClient, _clientx,_clienty,ClientWidth(),ClientHeight(),forceRedraw + EndIf + LayoutKids() + EndMethod + + + Method ClientWidth() + If (style & WINDOW_CLIENTCOORDS) Then Return width + Local Rect:Int[4] + GetClientRect _hwnd, Rect + Return Max(Rect[2]-Rect[0]-_clientX,0) + EndMethod + + Method ClientHeight() + If (style & WINDOW_CLIENTCOORDS) Then Return height + Local h:Int = height, Rect:Int[] = [0,0,width,height] + AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) + h:-(Rect[3]-Rect[1]+_clientY-height) + If _status Then GetWindowRect _status,Rect;h:-(Rect[3]-Rect[1]) + Return Max(h,0) + End Method + + Method Class() + Return GADGET_WINDOW + EndMethod + + Method State() + Local t = Super.State() + If IsIconic(_hwnd) t:|STATE_MINIMIZED + If IsZoomed(_hwnd) t:|STATE_MAXIMIZED + Return t + EndMethod + + Method SetEnabled(enable) + _enabled = enable + EnableWindow(_hwnd,enable) + EndMethod + + Method SetMinimumSize(w,h) + 'Set minimum size for current window style + _minwidth=w;_minheight=h + 'Get window style + Local tmpWStyle% = GetWindowLongW( _hwnd, GWL_STYLE ) + 'Update size border + If (_maxwidth = _minwidth And _maxheight = _minheight) Then tmpWStyle:&~WS_SIZEBOX ElseIf (style&WINDOW_RESIZABLE) Then tmpWStyle:|WS_SIZEBOX + 'Set new window style if necessary + If tmpWStyle <> GetWindowLongW( _hwnd, GWL_STYLE ) Then + SetWindowLongW( _hwnd, GWL_STYLE, tmpWStyle ) + Rethink() + SetWindowPos( _hwnd, Null, 0, 0, 0, 0, SWP_DRAWFRAME|SWP_FRAMECHANGED|SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOZORDER|SWP_NOSIZE ) + EndIf + EndMethod + + Method SetMaximumSize(w,h) + 'Set maximum size for current window style + _maxwidth=w;_maxheight=h + 'Get window style + Local tmpWStyle% = GetWindowLongW( _hwnd, GWL_STYLE )&~WS_MAXIMIZEBOX + 'Update size border + If (_maxwidth = _minwidth And _maxheight = _minheight) Then tmpWStyle:&~WS_SIZEBOX ElseIf (style&WINDOW_RESIZABLE) Then tmpWStyle:|WS_SIZEBOX + 'Set new window style if necessary + If tmpWStyle <> GetWindowLongW( _hwnd, GWL_STYLE ) Then + SetWindowLongW( _hwnd, GWL_STYLE, tmpWStyle ) + Rethink() + SetWindowPos( _hwnd, Null, 0, 0, 0, 0, SWP_DRAWFRAME|SWP_FRAMECHANGED|SWP_NOACTIVATE|SWP_NOMOVE|SWP_NOOWNERZORDER|SWP_NOZORDER|SWP_NOSIZE ) + EndIf + EndMethod + + Method GetMenu:TGadget() + If Not _menu Then + _menu = New TWindowsMenu.Create(Null,0,"") + _menu._setParent Self + EndIf + Return _menu + EndMethod + + Method UpdateMenu() + + Local hmenu, oldMenu + If _menu + _menu.FreeKids + _menu.Open + hmenu=_menu._hmenu + EndIf + + oldMenu = GetMenu_( _hwnd ) + SetMenu _hwnd,hmenu + DrawMenuBar _hwnd + DestroyMenu oldMenu + + EndMethod + + Field _statustext$ + + Method GetStatusText$() + If _status + Return _statustext + EndIf + EndMethod + + Method SetStatusText(Text$) + If _status + _statustext = Text + If (style&WINDOW_RESIZABLE) Then Text:+" " 'Cludge for size handle obfuscation + Local tmpWString:Short Ptr = Text.ToWString() + SendMessageW _status,WM_SETTEXT,0,Int(tmpWString) + MemFree tmpWString + EndIf + EndMethod + + Field popupextra:Object + + Method PopupMenu(menu:TGadget,extra:Object) + Local pt[2], wmenu:TWindowsMenu = TWindowsMenu(menu), tmpLink:TLink + If wmenu + + GetCursorPos_ pt + popupextra = extra + wmenu.Open(True) + + Local hmenu:Int = TrackPopupMenu( wmenu._hmenu,TPM_LEFTALIGN|TPM_TOPALIGN|TPM_RETURNCMD|TPM_NONOTIFY,pt[0],pt[1],0,_hwnd,0 ) + If hmenu Then HandleMenuEvent( WM_COMMAND, hmenu ) + + wmenu.Close() + popupextra = Null + + EndIf + EndMethod + + Function EnumChildProc(hwnd,lp) "win32" + Local winfo:WINDOWINFO = New WINDOWINFO + winfo.cbSize=SizeOf winfo + GetWindowInfo hwnd,winfo + If winfo.dwStyle&WS_TABSTOP + _firsttab=hwnd + Else + EnumChildWindows hwnd,EnumChildProc,0 + EndIf + If _firsttab Return 0 + Return 1 + EndFunction + + Global _firsttab + + Method Activate(cmd) + Select cmd + Case ACTIVATE_FOCUS + _firsttab=0 + EnumChildWindows _hwnd,EnumChildProc,0 + If Not _firsttab _firsttab=_hwnd + SetFocus _firsttab + Case ACTIVATE_MINIMIZE + ShowWindow _hwnd,SW_MINIMIZE + Case ACTIVATE_MAXIMIZE + ShowWindow _hwnd,SW_MAXIMIZE + Case ACTIVATE_RESTORE + ShowWindow _hwnd,SW_RESTORE + Case ACTIVATE_REDRAW + RefreshLook() + Return RedrawWindow( _hwnd, Null, Null, RDW_INVALIDATE | RDW_UPDATENOW | RDW_ERASE | RDW_FRAME | RDW_ALLCHILDREN ) + End Select + EndMethod + + Method OnCommand(msg,wp) + If wp>100 Then HandleMenuEvent(msg,wp) + EndMethod + + Method HandleMenuEvent( msg, wp ) + + Local tmpMenuSource:TWindowsMenu = TWindowsMenu.GetMenuFromKey(wp), tmpMenuID + If tmpMenuSource Then tmpMenuID = tmpMenuSource._tag + + Local tmpPopupExtra:Object = popupextra + popupextra = Null + + MaxGUI.MaxGUI.PostGuiEvent EVENT_MENUACTION,tmpMenuSource,tmpMenuID,0,0,0,tmpPopupExtra + + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Local x,y,w,h + Local move,size + Local Rect[4] + Local winrect[4] + + Select msg + + Case WM_ERASEBKGND + If BgBrush() Then + Local Rect[4] + If Not GetUpdateRect( hwnd, Rect, False ) Then GetClipBox( wp, Rect ) + FillRect( wp, Rect, BgBrush() ) + Return 1 + EndIf + + Case WM_SIZE + + If (hwnd = _hwnd) And (wp <> SIZE_MINIMIZED) Then + + If _status Then SendMessageW _status,WM_SIZE,0,0 + + If (style & WINDOW_CLIENTCOORDS) Then + GetClientRect _hwnd,Rect + w=Rect[2] + h=Rect[3] + AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) + x=-Rect[0] + y=-Rect[1] + GetWindowRect _hwnd,Rect + x:+Rect[0] + y:+Rect[1] + If _status Then + GetWindowRect _status,Rect + h:-(Rect[3]-Rect[1]) + EndIf + x:+_clientX;y:+_clientY + w:-_clientX;h:-_clientY + Else + GetWindowRect(_hwnd,Rect) + x=Rect[0];y=Rect[1] + w=Rect[2]-Rect[0] + h=Rect[3]-Rect[1] + EndIf + + If x<>xpos Or y<>ypos Then move = True + If w<>width Or h<>height Then size = True + + SetRect x,y,w,h + + If size Then RethinkClient() + + If move PostGuiEvent EVENT_WINDOWMOVE,0,0,x,y + If size PostGuiEvent EVENT_WINDOWSIZE,0,0,w,h + + EndIf + + Case WM_MOVE + If (hwnd = _hwnd) And Not (IsZoomed(hwnd) Or IsIconic(hwnd)) Then + + If (style & WINDOW_CLIENTCOORDS) Then + GetClientRect _hwnd,Rect + w=Rect[2] + h=Rect[3] + AdjustWindowRectEx(Rect,GetWindowLongW(_hwnd, GWL_STYLE),_hmenu,GetWindowLongW(_hwnd, GWL_EXSTYLE)) + x=-Rect[0] + y=-Rect[1] + GetWindowRect _hwnd,Rect + x:+Rect[0]+_clientX + y:+Rect[1]+_clientY + Else + GetWindowRect(_hwnd,Rect) + x=Rect[0];y=Rect[1] + w=Rect[2]-Rect[0] + h=Rect[3]-Rect[1] + EndIf + + If x<>xpos Or y<>ypos Then + SetRect x,y,width,height + PostGuiEvent EVENT_WINDOWMOVE,0,0,x,y + EndIf + + EndIf + + Case WM_GETMINMAXINFO + If hwnd = _hwnd And lp Then + Local minmax:Int Ptr = Int Ptr(lp), tmpZero% = 0 + + minmax[6]=_minwidth + minmax[7]=_minheight + ConvertToContainerDimensions(tmpZero,tmpZero,minmax[6],minmax[7]) + + If (_maxwidth >= _minwidth) And (_maxheight >= _minheight) Then + minmax[8]=_maxwidth + minmax[9]=_maxheight + ConvertToContainerDimensions(tmpZero,tmpZero,minmax[8],minmax[9]) + EndIf + + EndIf + + Case WM_ACTIVATE + If (wp = WA_ACTIVE) Or (wp = WA_CLICKACTIVE) Then + TWindowsGUIDriver._ActiveWindow = Self + PostGuiEvent EVENT_WINDOWACTIVATE + EndIf + + Case WM_COMMAND + If wp>100 Then HandleMenuEvent(wp,msg) + + Case WM_CLOSE + PostGuiEvent EVENT_WINDOWCLOSE + Return 1 + + Case WM_DROPFILES + Local hdrop,pt[2],path$ + Local pbuffer:Short[MAX_PATH] + Local i,n,l + DragQueryPoint wp,pt + n=DragQueryFileW(wp,$ffffffff,Null,0); + For i=0 Until n + l=DragQueryFileW(wp,i,pbuffer,MAX_PATH) + path=String.FromShorts(pbuffer,l) + PostGuiEvent EVENT_WINDOWACCEPT,0,0,pt[0],pt[1],path + Next + DragFinish wp + + End Select + + Return Super.WndProc(hwnd,msg,wp,lp) + + EndMethod + + Method DoLayout() + 'Don't do anything! + EndMethod + + Method SetTooltip( pTooltip$ ) + 'Windows shouldn't have tool-tips! + EndMethod + + Method SetSensitivity(flags) + 'Problems with resizing/moving sensitive windows. + Super.SetSensitivity(flags&~SENSITIZE_MOUSE) + 'Easy to create an active panel in client area as a work around. + EndMethod + + Method SetPixmap(pPixmap:TPixmap, pFlags) + If Not (pFlags & GADGETPIXMAP_ICON) Then Return False + If _iconBitmap Then DestroyIcon(_iconBitmap);_iconBitmap = 0 + If pPixmap Then _iconBitmap = TWindowsGraphic.IconFromPixmap32( pPixmap ) + SendMessageW (_hwnd, WM_SETICON, 0, _iconBitmap) + SendMessageW (_hwnd, WM_SETICON, 1, _iconBitmap) + Return True + EndMethod + + ' Needed otherwise SetEnabled() locks if modal child window is opened and parent is disabled. + Method isControl() + Return False + EndMethod + + Method ConvertToContainerDimensions%( pX Var, pY Var, pW Var , pH Var ) + + If Not (style & WINDOW_CLIENTCOORDS) Then Return 0 + + Local Rect[4], menu = GetMenu_(_hwnd) + + If menu Then menu = True + If _status Then GetWindowRect _status,Rect;pH:+(Rect[3]-Rect[1]) + pW:+_clientX;pH:+_clientY;pX:-_clientX;pY:-_clientY + + Rect = [pX,pY,pX+pW,pY+pH] + AdjustWindowRectEx Rect,GetWindowLongW(_hwnd, GWL_STYLE),menu,GetWindowLongW(_hwnd, GWL_EXSTYLE) + + pX = Rect[0];pY = Rect[1];pW = Rect[2]-Rect[0];pH = Rect[3]-Rect[1] + + Return 1 + + EndMethod + + Method FlushBrushes(pRecurse:Int = True) + Super.FlushBrushes() + If Not pRecurse Then Return + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget.FlushBrushes() + Next + EndMethod + +EndType + +Type TWindowsButton Extends TWindowsGadget + + Field _buttonImageList[] = [-1,0,0,0,0,0], _strButtonText$, _mouseoverbutton + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + Self.style = style + wstyle=WS_CHILD|WS_TABSTOP|WS_CLIPSIBLINGS|BS_MULTILINE + Select style&7 + Case 0 wstyle:|BS_PUSHBUTTON;style = BUTTON_PUSH + Case BUTTON_CHECKBOX wstyle:|BS_3STATE;If (style&BUTTON_PUSH) Then wstyle:|BS_PUSHLIKE + Case BUTTON_RADIO wstyle:|BS_AUTORADIOBUTTON;If (style&BUTTON_PUSH) Then wstyle:|BS_PUSHLIKE + Case BUTTON_OK wstyle:|BS_DEFPUSHBUTTON;hotkey=IDOK + Case BUTTON_CANCEL wstyle:|BS_PUSHBUTTON;hotkey=IDCANCEL + End Select + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"BUTTON","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + Register GADGET_BUTTON,hwnd + Return Self + EndMethod + + Method SetTextColor(r,g,b) + If Not (style&7) Then + SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)|BS_OWNERDRAW) + If Not _hTheme Then _hTheme = TWindowsGUIDriver.GetThemeHandle( _hwnd, "Button" ) + ElseIf Not (style&BUTTON_PUSH) And ((style&7=BUTTON_CHECKBOX) Or (style&7=BUTTON_RADIO)) + If SetWindowThemeW Then SetWindowThemeW(_hwnd,_wstrSpace,_wstrSpace) + EndIf + Super.SetTextColor(r,g,b) + EndMethod + + Method SetColor(r,g,b) + If Not (style&7) Then + SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)|BS_OWNERDRAW) + If Not _hTheme Then _hTheme = TWindowsGUIDriver.GetThemeHandle( _hwnd, "Button" ) + EndIf + Super.SetColor(r,g,b) + EndMethod + + Method RemoveColor() + If Not (style&7) Then + SetWindowLongW(_hwnd,GWL_STYLE,GetWindowLongW(_hwnd,GWL_STYLE)&~BS_OWNERDRAW) + _hTheme=0 + EndIf + Super.RemoveColor() + EndMethod + + Method State() + Local t=Super.State() + Select SendMessageW( _hwnd,BM_GETCHECK,0,0 ) + Case BST_CHECKED;t:|STATE_SELECTED + Case BST_INDETERMINATE;t:|STATE_INDETERMINATE + EndSelect + Return t + EndMethod + + Method SetSelected(bool) + Local state = BST_UNCHECKED + If bool Then + If (style&7 = BUTTON_CHECKBOX) And (bool = CHECK_INDETERMINATE) Then + state = BST_INDETERMINATE + Else + state = BST_CHECKED + EndIf + EndIf + SendMessageW _hwnd,BM_SETCHECK,state,0 + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_THEMECHANGED + If _hTheme Then + TWindowsGUIDriver.CloseThemeHandle(_hTheme) + _hTheme = TWindowsGUIDriver.GetThemeHandle(_hwnd,"BUTTON") + EndIf + Case WM_LBUTTONDBLCLK + PostMessageW(_hwnd, WM_LBUTTONDOWN, wp, lp) + Case WM_MOUSEMOVE + If Not _mouseoverbutton Then + _mouseoverbutton = True + InvalidateRect(_hwnd,Null,False) + Local tmpTrackMouseEvent:Int[] = [ 16, $2, hwnd, 0 ] 'TME_LEAVE: $2 + _TrackMouseEvent( tmpTrackMouseEvent ) + EndIf + Case WM_MOUSELEAVE + If _mouseoverbutton Then + _mouseoverbutton = False + InvalidateRect(_hwnd,Null,False) + EndIf + Case WM_ERASEBKGND + Return 1 + EndSelect + + Return Super.WndProc(hwnd,msg,wp,lp) + + EndMethod + + Method OnDrawItem(pDrawItemStruct:DRAWITEMSTRUCT) + + Local tmpDc = pDrawItemStruct.hDc, txtWidth%, txtHeight% + Local tmpDcState = SaveDC(tmpDC) + + ' button state + Local tmpIsPressed = (pDrawItemStruct.ItemState & ODS_SELECTED) + Local tmpIsFocused = (pDrawItemStruct.ItemState & ODS_FOCUS) + Local tmpIsDisabled = (pDrawItemStruct.ItemState & ODS_DISABLED) + Local tmpDrawFocusRect = Not (pDrawItemStruct.ItemState & ODS_NOFOCUSRECT) + + Local itemRect:Int Ptr = Int Ptr Varptr pDrawItemStruct.rcItem_left, txtRect:Int[4], clientRect:Int[4] + + Local tmpBgMode = SetBkMode(tmpDc, TRANSPARENT) + + ' Prepare draw... paint button background + + If _hTheme Then + + Local tmpState = PBS_NORMAL + If tmpIsDisabled Then + tmpState = PBS_DISABLED + ElseIf tmpIsPressed Then + tmpState = PBS_PRESSED + ElseIf _mouseoverbutton Then + tmpState = PBS_HOT + ElseIf tmpIsFocused Then + tmpState = PBS_DEFAULTED + EndIf + + If IsThemeBackgroundPartiallyTransparent(_hTheme, BP_PUSHBUTTON, tmpState) Then + DrawThemeParentBackground( _hwnd, tmpDc, itemRect ) + EndIf + DrawThemeBackground(_hTheme, tmpDc, BP_PUSHBUTTON, tmpState, itemRect, Null) + GetThemeBackgroundContentRect(_hTheme, tmpDc, BP_PUSHBUTTON, tmpState, itemRect, clientRect) + + Else + + clientRect = [itemRect[0], itemRect[1], itemRect[2], itemRect[3]] + InflateRect(clientRect, -GetSystemMetrics(SM_CXEDGE), -GetSystemMetrics(SM_CYEDGE)) + + If tmpIsFocused Then + + Local tmpBr = CreateSolidBrush($000000) + FrameRect(tmpDc, itemRect , tmpBr) + InflateRect(itemRect, -1, -1) + DeleteObject(tmpBr) + + EndIf + + Local crColor + If BgColor() < 0 Then crColor = GetSysColor(COLOR_BTNFACE) Else crColor = BgColor() + + Local brBackground = CreateSolidBrush(crColor) + + FillRect(tmpDc, itemRect, brBackground) + + DeleteObject(brBackground) + + ' Draw pressed button + If tmpIsPressed + + Local brBtnShadow = CreateSolidBrush(GetSysColor(COLOR_BTNSHADOW)) + FrameRect(tmpDc, itemRect, brBtnShadow) + DeleteObject(brBtnShadow) + + OffsetRect( clientRect, 1, 1 ) + + Else ' ...Else draw non pressed button + + Local tmpUState = DFCS_BUTTONPUSH + If _mouseoverbutton Then tmpUState :| DFCS_HOT + If tmpIsPressed Then tmpUState :| DFCS_PUSHED + + DrawFrameControl(tmpDc, itemRect, DFC_BUTTON, tmpUState) + + EndIf + + EndIf + + If BgColor() > -1 Then + Local brBackground = CreateSolidBrush(BgColor()) + FillRect(tmpDc, clientRect, brBackground) + DeleteObject(brBackground) + EndIf + + txtRect = clientRect[..] + + clientRect[RECT_RIGHT]:-clientRect[RECT_LEFT] + clientRect[RECT_BOTTOM]:-clientRect[RECT_TOP] + + ' Read the button's title + Local tmpText$ = Super.GetText() + + ' Draw the icon + 'DrawTheIcon(GetDlgItem(hDlg, IDC_OWNERDRAW_BTN), &dc, bHasTitle, &lpDIS.rcItem, &captionRect, bIsPressed, bIsDisabled) + + ' Write the button title (if any) + If tmpText Then + + Local tmpFlags = DT_CENTER|DT_WORDBREAK + + DrawTextW( tmpDc, tmpText, -1, txtRect, DT_CALCRECT|tmpFlags ) + + txtWidth = txtRect[RECT_RIGHT]-txtRect[RECT_LEFT] + txtHeight = txtRect[RECT_BOTTOM]-txtRect[RECT_TOP] + + txtRect[RECT_LEFT] = clientRect[RECT_LEFT] + (clientRect[RECT_RIGHT] - txtWidth)/2 + txtRect[RECT_TOP] = clientRect[RECT_TOP] + (clientRect[RECT_BOTTOM] - txtHeight)/2 + txtRect[RECT_RIGHT] = txtRect[RECT_LEFT] + txtWidth + txtRect[RECT_BOTTOM] = txtRect[RECT_TOP] + txtHeight + + Local tmpTextColor + If tmpIsDisabled Then + tmpTextColor = GetSysColor(COLOR_GRAYTEXT) + Else + If FgColor() < 0 Then tmpTextColor = GetSysColor(COLOR_BTNTEXT) Else tmpTextColor = FgColor() + EndIf + tmpTextColor = SetTextColor_(tmpDc,tmpTextColor) + + DrawTextW( tmpDc, tmpText, -1, txtRect, tmpFlags ) + + SetTextColor_(tmpDc,tmpTextColor) + + EndIf + + RestoreDC(tmpDc,tmpDcState) + + ' Draw the focus rect + If tmpIsFocused And tmpDrawFocusRect Then + Local focusRect:Int[4] + CopyRect(focusRect, itemRect) + InflateRect(focusRect, -3, -3) + SetMapMode(tmpDc, MM_TEXT) + DrawFocusRect(tmpDc, focusRect) + EndIf + + Return True + EndMethod + + Method OnCommand(msg,wp) + Select wp Shr 16 + Case BN_CLICKED + Select (style&7) + Case BUTTON_CHECKBOX + Select State()&STATE_INDETERMINATE + Case 0, STATE_INDETERMINATE + SetSelected(True) + Case STATE_SELECTED + SetSelected(False) + EndSelect + EndSelect + + PostGuiEvent EVENT_GADGETACTION,ButtonState(Self) + + 'Fix so that tooltips reappear on Windows XP + Local tmpTooltip$ = GetTooltip() + If tmpTooltip Then SetTooltip("");SetTooltip(tmpTooltip) + + EndSelect + EndMethod + + Method SetPixmap(pixmap:TPixmap,pFlags) + + Local tmpWindowStyle = GetWindowLongW(_hwnd,GWL_STYLE) + + If (pFlags & GADGETPIXMAP_ICON) And (((style&BUTTON_PUSH)=BUTTON_PUSH) Or (style = BUTTON_CANCEL)) Then + + 'To remove an image from a button, a handle-list of -1 should be passed. + If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]);_buttonImageList[0] = -1 + If pixmap Then _buttonImageList[0] = BuildImageList( pixmap ) + + If (pFlags & GADGETPIXMAP_NOTEXT) Then + _buttonImageList[5] = BUTTON_IMAGELIST_ALIGN_CENTER + Else + _buttonImageList[5] = BUTTON_IMAGELIST_ALIGN_LEFT + EndIf + + 'If running Windows XP/Vista, let's use BCM_SETIMAGELIST + + If Not SendMessageW (_hwnd, BCM_SETIMAGELIST, 0, Int Byte Ptr _buttonImageList) Then + 'Otherwise, if this fails we should use BM_SETIMAGE. + + If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]);_buttonImageList[0] = -1 + + If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 + If pixmap Then _iconBitmap = TWindowsGraphic.BitmapFromPixmap( pixmap, True ) + + SendMessageW (_hwnd, BM_SETIMAGE, IMAGE_BITMAP, _iconBitmap) + + EndIf + + 'Show the text if there isn't a pixmap or if we haven't specified GADGETPIXMAP_NOTEXT. + If (Not pixmap) Or Not(pFlags & GADGETPIXMAP_NOTEXT) Then + tmpWindowStyle:&(~BS_BITMAP) + + 'Text isn't hidden on XP image buttons regardless of whether BS_BITMAP is set + 'so we have to hack this in - they must have fixed it on Vista though as it works fine there. + + Super.SetText( GetText() ) + Else + tmpWindowStyle:|BS_BITMAP + + 'Text isn't hidden on XP image buttons regardless of whether BS_BITMAP is set + 'so we have to hack this in - they must have fixed it on Vista though as it works fine there. + + Super.SetText( "" ) + EndIf + + SetWindowLongW _hwnd,GWL_STYLE,tmpWindowStyle + + InvalidateRect _hwnd, Null, False + + Return True + + EndIf + + EndMethod + + Method SetText(pText$) + Local oldText$ = _strButtonText + _strButtonText = pText + If (_buttonImageList[0] < 0 And Not _iconBitmap) Or (oldText = Super.GetText()) Then Super.SetText(pText) + EndMethod + + Method GetText$() + Return _strButtonText + EndMethod + + Method Free() + If _buttonImageList[0] >= 0 Then ImageList_Destroy(_buttonImageList[0]) + If _iconBitmap Then DestroyIcon( _iconBitmap );_iconBitmap = 0 + _buttonImageList = Null + Super.Free() + EndMethod + + Function BuildImageList(pixmap:TPixmap) + Local bitmap,imagelist,mask + If TWindowsGUIDriver.CheckCommonControlVersion() And (Pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888) + imagelist=ImageList_Create(pixmap.width,pixmap.height,ILC_COLOR32,0,1) + If imagelist + bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, True) + ImageList_Add(imagelist,bitmap,0) + EndIf + EndIf + If imagelist=0 + bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, False) + mask=TWindowsGraphic.BitmapMaskFromPixmap(pixmap) + imagelist=ImageList_Create(pixmap.width,pixmap.height,ILC_COLOR24|ILC_MASK,0,1) + ImageList_Add(imagelist,bitmap,mask) + DeleteObject(mask) + EndIf + DeleteObject(bitmap) + Return imagelist + EndFunction + + Method Class() + Return GADGET_BUTTON + EndMethod + +EndType + +Type TWindowsTextField Extends TWindowsGadget + + Field _busy + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + Self.style = style + xstyle=WS_EX_CLIENTEDGE + wstyle=WS_CHILD|WS_TABSTOP|ES_AUTOHSCROLL|WS_CLIPSIBLINGS + If style&TEXTFIELD_PASSWORD Then wstyle:|ES_PASSWORD + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"EDIT","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + 'SendMessageW hwnd,WM_SETFONT,TWindowsGUIDriver.GDIFont.handle,1 + Register GADGET_TEXTFIELD,hwnd + SetColor(255,255,255) + Return Self + EndMethod + + Method SetText(Text$) + Local p0,p1 + _busy:+1 + SendMessageW _hwnd,EM_GETSEL,Int Byte Ptr Varptr p0,Int Byte Ptr Varptr p1 + Super.SetText(Text) + SendMessageW _hwnd,EM_SETSEL,p0,p1 + _busy:-1 + EndMethod + + Method Activate(cmd) + Select cmd + Case ACTIVATE_CUT + SendMessageW _hwnd,WM_CUT,0,0 + Case ACTIVATE_COPY + SendMessageW _hwnd,WM_COPY,0,0 + Case ACTIVATE_PASTE + SendMessageW _hwnd,WM_PASTE,0,0 + Case ACTIVATE_FOCUS + SendMessageW _hwnd,EM_SETSEL,0,-1 + End Select + Return Super.Activate(cmd) + EndMethod + + Method OnCommand(msg,wp) + If Not _busy + Select (wp Shr 16) + Case EN_UPDATE + PostGuiEvent EVENT_GADGETACTION + Case EN_KILLFOCUS + SendMessageW _hwnd,EM_SETSEL,0,0 + End Select + EndIf + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Local event:TEvent + Select msg + Case WM_ERASEBKGND + Return 1 + Case WM_KEYDOWN + If eventfilter<>Null + event=CreateEvent(EVENT_KEYDOWN,Self,wp,keymods()) + If Not eventfilter(event,context) Return True + EndIf + Case WM_CHAR + If eventfilter<>Null + event=CreateEvent(EVENT_KEYCHAR,Self,wp,keymods()) + If Not eventfilter(event,context) Return True + EndIf + Case WM_KILLFOCUS + PostGuiEvent EVENT_GADGETLOSTFOCUS + End Select + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method Class() + Return GADGET_TEXTFIELD + EndMethod + +EndType + +Type TWindowsTextArea Extends TWindowsGadget + + Global _ClassName:String = Null 'See InitializeLibrary(). + + Global _pagemargin# = 0.5 'Page margin for print-out in inches + + Field _locked + + Field cr1:CHARRANGE=New CHARRANGE + Field cr2:CHARRANGE=New CHARRANGE + Field cf:CHARFORMATW=New CHARFORMATW + + Field ole:IRichEditOLE + Field idoc:ITextDocument + Field busy,readonly + + Field IID_ITextDocument:GUID = New GUID + + Function _InitializeLibrary() + + If Not _ClassName Then + + 'Load RichEdit DLL + If Not LoadLibraryW("msftedit.dll") Then + If LoadLibraryW("riched20.dll") _ClassName = "RichEdit20W" + Else + _ClassName = "RICHEDIT50W" + EndIf + + EndIf + + EndFunction + + Method New() + _InitializeLibrary() + EndMethod + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + Local res + + xstyle=WS_EX_CLIENTEDGE + wstyle=WS_CHILD|WS_VSCROLL|WS_CLIPSIBLINGS + wstyle:|ES_MULTILINE|ES_NOOLEDRAGDROP|ES_NOHIDESEL|ES_LEFT + If Not (style&TEXTAREA_WORDWRAP) wstyle:|WS_HSCROLL|ES_AUTOHSCROLL +' If (style&TEXTAREA_READONLY) wstyle:|ES_READONLY + If (style&TEXTAREA_READONLY) readonly=True + + Self.style = style + + parent=group.query(QUERY_HWND_CLIENT) + + 'RichText control should be made have dimensions of 1x1 pixels to fix Windows XP vertical scrollbar drawing bug. + hwnd=CreateWindowExW(xstyle,_ClassName,"",wstyle,0,0,1,1,parent,hotkey,GetModuleHandleW(Null),Null) + + SendMessageW hwnd,EM_SETLIMITTEXT,4*1024*1024,0 + SendMessageW hwnd,EM_SETEVENTMASK,0,ENM_CHANGE|ENM_MOUSEEVENTS|ENM_SELCHANGE|ENM_KEYEVENTS + SendMessageW hwnd,EM_SETUNDOLIMIT,0,0 + + SendMessageW hwnd,EM_GETOLEINTERFACE,0,Int Byte Ptr Varptr ole + res=IIDFromString(ITextDocument_UUID,IID_ITextDocument) + + res=ole.QueryInterface(IID_ITextDocument,Varptr idoc) + + Register GADGET_TEXTAREA,hwnd + Return Self + EndMethod + + Method Free() + If ole Then ole.Release_ + If idoc Then idoc.Release_ + Super.Free() + EndMethod + + Method Activate(cmd) + Select cmd + Case ACTIVATE_CUT + SendMessageW _hwnd,WM_CUT,0,0 + Case ACTIVATE_COPY + SendMessageW _hwnd,WM_COPY,0,0 + SetFocus _hwnd + Case ACTIVATE_PASTE + DoPaste + Case ACTIVATE_PRINT + DoPrint + Default + Return Super.Activate(cmd) + End Select + EndMethod + + Method DoPaste() + Local h,handle,n + Local w:Short Ptr,cp:Short Ptr + Local tp:Byte Ptr,bp:Byte Ptr + + If OpenClipboard(_hwnd) + If IsClipboardFormatAvailable(CF_UNICODETEXT) + handle=GetClipboardData(CF_UNICODETEXT) + n=GlobalSize(handle) + w=Short Ptr GlobalLock(handle) + h=GlobalAlloc(GMEM_MOVEABLE,n) + cp=Short Ptr GlobalLock(h) + memcpy_(cp,w,n) + If cp[n/2-2]=10 Then cp[n/2-2]=13 + GlobalUnlock h + GlobalUnlock handle + If h + EmptyClipboard + SetClipboardData CF_UNICODETEXT,h + EndIf + ElseIf IsClipboardFormatAvailable(CF_OEMTEXT) + handle=GetClipboardData(CF_OEMTEXT) + n=GlobalSize(handle) + tp=Byte Ptr GlobalLock(handle) + h=GlobalAlloc(GMEM_MOVEABLE,n) + bp=Byte Ptr GlobalLock(h) + memcpy_(bp,tp,n) + If bp[n-2]=10 Then bp[n-2]=13 + GlobalUnlock h + GlobalUnlock handle + If h + EmptyClipboard + SetClipboardData CF_OEMTEXT,h + EndIf + EndIf + CloseClipboard + SendMessageW _hwnd,WM_PASTE,0,0 + SetFocus _hwnd + EndIf + EndMethod + + Method DoPrint() + + Local tmpTextSelLen = TextAreaSelLen(Self) + + Local tmpPrintDialog:PRINTDLGW = New PRINTDLGW + + tmpPrintDialog.flags = PD_RETURNDC | PD_HIDEPRINTTOFILE | PD_NOPAGENUMS + If Not tmpTextSelLen Then tmpPrintDialog.flags:|PD_NOSELECTION + + tmpPrintDialog.hwndOwner = _hwnd + + If Not PrintDlg( Byte Ptr tmpPrintDialog ) Then Return 0 + + Local hdcPrinter = tmpPrintDialog.hdc + + Local tmpDoc:DOCINFOW = New DOCINFOW + Local tmpDocTitle:Short Ptr = AppTitle.ToWString() + tmpDoc.lpszDocName = tmpDocTitle + + Local tmpSuccess = (StartDocW( hdcPrinter, Byte Ptr tmpDoc ) > 0) + + If tmpSuccess Then + + Local _cursor = TWindowsGUIDriver._cursor + + SetPointer( POINTER_WAIT ) + + SetMapMode( hdcPrinter, MM_TEXT ) + + Local wPage = GetDeviceCaps( hdcPrinter, PHYSICALWIDTH ) + Local hPage = GetDeviceCaps( hdcPrinter, PHYSICALHEIGHT ) + Local xPPI = GetDeviceCaps( hdcPrinter, LOGPIXELSX ) + Local yPPI = GetDeviceCaps( hdcPrinter, LOGPIXELSY ) + + Local tmpTextLengthStruct[] = [GTL_DEFAULT,1200] + Local tmpTextLength = SendMessageW (_hwnd, EM_GETTEXTLENGTHEX, Int Byte Ptr tmpTextLengthStruct, 0) + + Local tmpTextPrinted, tmpFormatRange:FORMATRANGE = New FORMATRANGE + + tmpFormatRange.hdc = hdcPrinter + tmpFormatRange.hdcTarget = hdcPrinter + + tmpFormatRange.rcPageRight = (wPage*1440:Long)/xPPI + tmpFormatRange.rcPageBottom = (hPage*1440:Long)/yPPI + + tmpFormatRange.rcLeft = (1440*_pagemargin);tmpFormatRange.rcTop = (1440*_pagemargin) + tmpFormatRange.rcRight = tmpFormatRange.rcPageRight - (2880*_pagemargin) + tmpFormatRange.rcBottom = tmpFormatRange.rcPageBottom - (2880*_pagemargin) + + If tmpPrintDialog.flags & PD_SELECTION Then + tmpTextPrinted = TextAreaCursor(Self) + tmpFormatRange.CHARRANGE_cpMax = tmpTextPrinted+tmpTextSelLen + Else + tmpFormatRange.CHARRANGE_cpMax = tmpTextLength + EndIf + + SendMessageW (_hwnd, EM_FORMATRANGE, False, 0) + + While tmpSuccess And ( tmpTextPrinted < tmpFormatRange.CHARRANGE_cpMax ) + + tmpFormatRange.CHARRANGE_cpMin = tmpTextPrinted + + tmpSuccess = (StartPage(hdcPrinter) > 0) + If Not tmpSuccess Then Exit + + tmpTextPrinted = SendMessageW( _hwnd, EM_FORMATRANGE, True, Int Byte Ptr tmpFormatRange ) + + tmpSuccess = (EndPage(hdcPrinter) > 0) + + Wend + + If tmpSuccess Then EndDoc( hdcPrinter ) Else AbortDoc( hdcPrinter ) + + SendMessageW (_hwnd, EM_FORMATRANGE, False, 0) + + TWindowsGUIDriver._cursor = _cursor + SetCursor _cursor + + EndIf + + GlobalFree( tmpPrintDialog.hDevMode ) + GlobalFree( tmpPrintDialog.hDevNames ) + DeleteDC( hdcPrinter ) + + MemFree tmpDocTitle + + Return tmpSuccess + + EndMethod + + Global gt[] = [GTL_DEFAULT, CP_ACP] + + Method CharCount() + Return SendMessageW(_hwnd,EM_GETTEXTLENGTHEX,Int Byte Ptr gt,0) + EndMethod + + Method SetStyle(r,g,b,flags,pos,length,units) + Local iifont:ITextFont + Local iirange:ITextRange + Local res, tmpOutput + If units=TEXTAREA_LINES + Local n=pos + pos=CharAt(pos) + If length>=0 length=CharAt(n+length)-pos + EndIf + If length<0 length=charcount()-pos + busy:+1 + res=idoc.Range(pos,pos+length,iirange) + res=iirange.GetFont(iifont) + res=iifont.SetForeColor(((b Shl 16)|(g Shl 8)|r)) + If (flags&TEXTFORMAT_BOLD) Then iifont.SetBold(TOMTRUE) Else iifont.SetBold(TOMFALSE) + If (flags&TEXTFORMAT_ITALIC) Then iifont.SetItalic(TOMTRUE) Else iifont.SetItalic(TOMFALSE) + If (flags&TEXTFORMAT_UNDERLINE) Then iifont.SetUnderline(TOMSINGLE) Else iifont.SetUnderline(TOMFALSE) + If (flags&TEXTFORMAT_STRIKETHROUGH) Then iifont.SetStrikeThrough(TOMTRUE) Else iifont.SetStrikeThrough(TOMNONE) + iifont.Release_ + iirange.Release_ + busy:-1 + EndMethod + + Method InsertText(Text$,pos,count) + Local iirange:ITextRange + Local bstr:Short Ptr, tmpWString:Short Ptr = Text.toWString() + Local res, bool + busy:+1 + res=idoc.Range(pos,pos+count,iirange) + bstr=SysAllocStringLen(tmpWString,Text.length);MemFree tmpWString + LockText() + res=iirange.SetText(bstr) + UnlockText() + SysFreeString bstr + iirange.Release_ + busy:-1 + EndMethod + + Method ReplaceText(pos,length,Text$,units) + If units=TEXTAREA_LINES + Local n=pos + pos=CharAt(pos) + If length>=0 length=CharAt(n+length)-pos + EndIf + If length<0 Then length=charcount()-pos + InsertText Text,pos,length + EndMethod + + Method AreaText$(pos,length,units) + Local iirange:ITextRange + Local bstr:Short Ptr + + If units=TEXTAREA_LINES + Local n=pos + pos=CharAt(pos) + If length>=0 length=CharAt(n+length)-pos + EndIf + If length<0 length=charcount()-pos + idoc.Range(pos,pos+length,iirange) + iirange.GetText(Varptr bstr) + Local Text$=String.FromWString(bstr) + SysFreeString bstr + iirange.Release_ + Text=Text.Replace(Chr(13),Chr(10)) + Return Text + EndMethod + + Method SetSelection(pos,length,units) + If units=TEXTAREA_LINES + Local n=pos + pos=CharAt(pos) + If length>0 + length=CharAt(n+length) + length=length-pos + EndIf + EndIf + If length<0 length=charcount()-pos + Local cr:CHARRANGE = New CHARRANGE + cr.cpMin=pos + cr.cpMax=pos+length + Desensitize() + SendMessageW _hwnd,EM_EXSETSEL,0,Int Byte Ptr(cr) + Sensitize() + EndMethod + + Method SetMargins(leftmargin) + SendMessageW _hwnd,EM_SETMARGINS,EC_LEFTMARGIN,leftmargin + EndMethod + + ' 72 points per inch + + Method SetTabs(tabs) + Local hdc=GetDC( 0 ) + idoc.SetDefaultTabStop tabs * 72.0 / GetDeviceCaps( hdc,LOGPIXELSX ) + ReleaseDC 0,hdc + EndMethod + + Method SetTextColor(r,g,b) + cf.cbSize=SizeOf(CHARFORMATW) + cf.dwMask=CFM_COLOR|CFM_BOLD|CFM_ITALIC + cf.crTextColor=(b Shl 16)|(g Shl 8)|r + SendMessageW _hwnd,EM_SETCHARFORMAT,SCF_DEFAULT,Int Byte Ptr cf + SendMessageW _hwnd,EM_SETCHARFORMAT,SCF_ALL,Int Byte Ptr cf + EndMethod + + Method SetColor(r,g,b) + SendMessageW _hwnd,EM_SETBKGNDCOLOR,0,((b Shl 16)|(g Shl 8)|r) + EndMethod + + Method RemoveColor() + SendMessageW _hwnd,EM_SETBKGNDCOLOR,1,0 + EndMethod + + Method GetCursorPos(units) + Local cr:CHARRANGE = New CHARRANGE + SendMessageW _hwnd,EM_EXGETSEL,0,Int Byte Ptr(cr) + Local pos=cr.cpMin + If units=TEXTAREA_LINES pos=LineAt(pos) + Return pos + EndMethod + + Method GetSelectionLength(units) + Local cr:CHARRANGE = New CHARRANGE + SendMessageW _hwnd,EM_EXGETSEL,0,Int Byte Ptr(cr) + If units=TEXTAREA_LINES + Return LineAt(cr.cpMax-1)-LineAt(cr.cpMin)+1 + Else + Return cr.cpMax-cr.cpMin + EndIf + EndMethod + + Method CharAt(Line) + If Line<0 Return + If Line>AreaLen(TEXTAREA_LINES) Return charcount() + Return SendMessageW(_hwnd,EM_LINEINDEX,Line,0) + EndMethod + + Method LineAt(pos) + If pos<0 Return + If pos>charcount() Return AreaLen(TEXTAREA_LINES) + Return SendMessageW(_hwnd,EM_EXLINEFROMCHAR,0,pos) + EndMethod + + Method AreaLen(units) + If units=TEXTAREA_LINES Return LineAt(charcount()) + Return charcount() + EndMethod + + Method CharX( char ) + Local tmpPoint[2] + SendMessageW(_hwnd, EM_POSFROMCHAR, Int Byte Ptr tmpPoint, char ) + Return tmpPoint[0] + EndMethod + + Method CharY( char ) + Local tmpPoint[2] + SendMessageW(_hwnd, EM_POSFROMCHAR, Int Byte Ptr tmpPoint, char ) + Return tmpPoint[1] + EndMethod + + Method SetText(Text$) + InsertText Text,0,charcount() + EndMethod + + Method AddText(Text$) + InsertText Text,charcount(),0 + Local cr:CHARRANGE = New CHARRANGE + Local p = charcount() + cr.cpMin=p + cr.cpMax=p + SendMessageW _hwnd,EM_EXSETSEL,0,Int Byte Ptr(cr) + EndMethod + + Method GetText$() + Return AreaText(0,charcount(),TEXTAREA_CHARS) + EndMethod + + Global _oldCursor = 0 + Field _oldSelPos%, _oldSelLen% = 0 + + Method LockText() + + If Not idoc.Freeze(_locked) + _oldSelPos = GetCursorPos(TEXTAREA_CHARS) + _oldSelLen = GetSelectionLength(TEXTAREA_CHARS) + If Not _oldCursor Then _oldCursor = GetCursor() + EndIf + + EndMethod + + Method UnlockText() + + If idoc.Unfreeze(_locked) = S_OK Then + SetSelection( _oldSelPos, _oldSelLen, TEXTAREA_CHARS ) + If _oldCursor And (_oldCursor <> GetCursor()) Then + SetCursor(_oldCursor) + EndIf + _oldCursor = 0 + EndIf + + EndMethod + + Method OnCommand(msg,wp) + If busy Then Return + Select wp Shr 16 + Case EN_CHANGE + If Not _locked Then PostGuiEvent EVENT_GADGETACTION + End Select + EndMethod + + Method OnNotify(wp,lp) + Local nmhdr:Int Ptr + Local event:TEvent + + Super.OnNotify(wp,lp) 'Tooltip + + nmhdr=Int Ptr(lp) + Select nmhdr[2] +' Case EN_PROTECTED +' DebugStop + Case EN_SELCHANGE + If Not (busy Or _locked) + PostGuiEvent EVENT_GADGETSELECT + EndIf + Case EN_MSGFILTER + Select nmhdr[3] + Case WM_RBUTTONDOWN + If GetSelectionLength(TEXTAREA_CHARS)=0 nmhdr[3]=WM_LBUTTONDOWN + Case WM_RBUTTONUP + Local mx=nmhdr[5] & $ffff + Local my=nmhdr[5] Shr 16 + PostGuiEvent EVENT_GADGETMENU,0,0,mx,my + Case WM_KEYDOWN + + Local k=nmhdr[4] + + 'Filtering out special shortcut combinations + If (keymods()&MODIFIER_CONTROL) Then + Select k + Case 76,69,82 'ctrl+l, ctrl+e, ctrl+r + Return 1 'Alignment shortcuts + + Case 188,190 'ctrl+<, ctrl+> + 'Font size shortcuts + If (keymods()&MODIFIER_SHIFT) Then Return 1 + EndSelect + EndIf + + 'Read-only + If readonly + If k>=33 And k<=40 Return 0 'selection keys + If (keymods()&MODIFIER_CONTROL) Then + Select k + Case 65, 67;Return 0 'ctrl-a, ctrl+c + EndSelect + EndIf + Return 1 + EndIf + + 'Event Filter + If eventfilter<>Null + event=CreateEvent(EVENT_KEYDOWN,Self,k,keymods()) + Return Not eventfilter(event,context) + EndIf + + Case WM_CHAR + If readonly Return 1 + If eventfilter<>Null + event=CreateEvent(EVENT_KEYCHAR,Self,nmhdr[4],keymods()) + Return Not eventfilter(event,context) + EndIf + End Select + End Select + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + + Case WM_MOUSEWHEEL + If (wp&MK_CONTROL) Then SendMessageW _hwnd, EM_SETZOOM, 0, 0 + + Case WM_KILLFOCUS + PostGuiEvent EVENT_GADGETLOSTFOCUS + + End Select + + Return Super.WndProc(hwnd,msg,wp,lp) + + EndMethod + + Method Class() + Return GADGET_TEXTAREA + EndMethod + +EndType + +Type TWindowsListBox Extends TWindowsGadget + + Field _icons:TWindowsIconStrip + Field _selected = -1 + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + + Self.style = style + + xstyle=WS_EX_CLIENTEDGE + wstyle=WS_CHILD|WS_TABSTOP|LVS_REPORT|LVS_NOCOLUMNHEADER|LVS_SHOWSELALWAYS|LVS_SHAREIMAGELISTS + wstyle:|WS_CLIPSIBLINGS + + If (style&LISTBOX_MULTISELECT<>LISTBOX_MULTISELECT) Then wstyle:|LVS_SINGLESEL + + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"SysListView32","",wstyle,0,0,20,20,parent,hotkey,GetModuleHandleW(Null),Null) + + Local column:LVCOLUMNW + column=New LVCOLUMNW + SendMessageW hwnd,LVM_INSERTCOLUMNW,0,Int Byte Ptr(column) + + SendMessageW hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,LVS_EX_FULLROWSELECT|LVS_EX_INFOTIP,LVS_EX_FULLROWSELECT|LVS_EX_INFOTIP + + If TWindowsGUIDriver.CheckCommonControlVersion() Then SendMessageW hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,LVS_EX_DOUBLEBUFFER,LVS_EX_DOUBLEBUFFER + + Register GADGET_LISTBOX,hwnd,0,False 'Set to True for normal Tooltips + + If TWindowsGUIDriver._explorerstyle Then UseExplorerTheme() + + Return Self + EndMethod + + Method SetColor(r,g,b) + SendMessageW _hwnd,LVM_SETBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r + SendMessageW _hwnd,LVM_SETTEXTBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + Method RemoveColor() + SendMessageW _hwnd,LVM_SETBKCOLOR ,1,0 + SendMessageW _hwnd,LVM_SETTEXTBKCOLOR ,1,0 + EndMethod + + Method SetTextColor(r,g,b) + SendMessageW _hwnd,LVM_SETTEXTCOLOR,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + 'Hack: When image lists are removed from listviews, the items don't + 'reposition themselves automatically. Hack involves first setting a tiny + 'blank image-list to update item size, before attempting to remove it. + Method SetIconStrip(iconstrip:TIconStrip) + Local imagelist + If Not iconstrip Then + _icons = TWindowsIconStrip.CreateBlank() + Else + _icons = TWindowsIconStrip(iconstrip) + EndIf + If _icons Then imagelist = _icons._imagelist + SendMessageW _hwnd,LVM_SETIMAGELIST,LVSIL_SMALL,imagelist + If Not iconstrip Then + SendMessageW _hwnd,LVM_SETIMAGELIST,LVSIL_SMALL,0 + _icons = Null + EndIf + EndMethod + + Method ClearListItems() + _selected=-1 + DeSensitize() + SendMessageW _hwnd,LVM_DELETEALLITEMS,0,0 + If Not IsSingleSelect() Then SelectionChanged() + Sensitize() + EndMethod + + Method InsertListItem(index,Text$,tip$,icon,tag:Object) + + Local it:LVITEMW + it=New LVITEMW + it.mask=LVIF_TEXT|LVIF_DI_SETITEM + it.iItem=index + it.pszText=Text.toWString() + + 'If icon>=0 Then + it.mask:|LVIF_IMAGE + it.iImage=icon + 'EndIf + + Desensitize() + SendMessageW _hwnd,LVM_INSERTITEMW,0,Int Byte Ptr(it) + SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 + If Not IsSingleSelect() Then SelectionChanged() + Sensitize() + MemFree it.pszText + + EndMethod + + Method SetListItem(index,Text$,tip$,icon,tag:Object) + Local tmpReselect + If ListItemState(index) & STATE_SELECTED Then tmpReselect = True + RemoveListItem index + InsertListItem index,Text,tip,icon,tag + If tmpReselect Then SetItemState(index,STATE_SELECTED) + EndMethod + + Method RemoveListItem(index) + Desensitize() + If ListItemState(index) & STATE_SELECTED Then _selected = -1 + SendMessageW _hwnd,LVM_DELETEITEM,index,0 + SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 + If Not IsSingleSelect() Then SelectionChanged() + Sensitize() + EndMethod + + Method SetListItemState(index,state) + Local it:LVITEMW = New LVITEMW + it.mask=LVIF_STATE + it.iItem=index + If state&STATE_SELECTED + it.state=LVIS_SELECTED + If IsSingleSelect() Then _selected=index + ElseIf _selected=index + _selected=-1 + EndIf + it.stateMask=LVIS_SELECTED + Desensitize() + SendMessageW _hwnd,LVM_SETITEMSTATE,index,Int Byte Ptr(it) + If it.state Then SendMessageW _hwnd,LVM_ENSUREVISIBLE,index,False + If Not IsSingleSelect() Then SelectionChanged() + Sensitize() + EndMethod + + Method ListItemState(index) + Local state = SendMessageW(_hwnd,LVM_GETITEMSTATE,index,LVIS_SELECTED) + If state&LVIS_SELECTED Return STATE_SELECTED + EndMethod + + Method SetTooltip( pTooltip$ ) + 'ToolTips should be set on an item-by-item basis instead. + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_MAXGUILISTREFRESH + Local index + + If IsSingleSelect() Then + index=SendMessageW(_hwnd,LVM_GETNEXTITEM,-1,LVNI_SELECTED) + Else + index = SelectionChanged() + EndIf + If index <> _selected Then + If IsSingleSelect() Then _selected = index + Local item:TGadgetItem = New TGadgetItem + If index>=0 And index=0 And index-1 + _selected=-1 + PostGuiEvent EVENT_GADGETSELECT,-1 + EndIf + Case NM_RCLICK + index=nmhdr[3] + Local item:TGadgetItem + If index>=0 And indexLISTBOX_MULTISELECT) + EndMethod + + Method Class() + Return GADGET_LISTBOX + EndMethod + + Method HasResized() + SendMessageW _hwnd,LVM_SETCOLUMNWIDTH,0,-2 + EndMethod + + Method UseExplorerTheme() + If TWindowsGUIDriver.CheckCommonControlVersion() And SetWindowThemeW Then SetWindowThemeW( _hwnd, _wstrExplorer, Null ) + EndMethod + +EndType + +Type TWindowsComboBox Extends TWindowsGadget + + Field _icons:TWindowsIconStrip + Field _editHwnd, _comboHwnd + Field _selected = -1 + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey,hwnd + Local parent,editstyle,combostyle + + Self.style = style + wstyle=WS_CHILD|WS_TABSTOP|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|CBS_AUTOHSCROLL + If (style & COMBOBOX_EDITABLE) Then wstyle:|CBS_DROPDOWN Else wstyle:|CBS_DROPDOWNLIST + + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"ComboBoxEx32","",wstyle,0,0,0,180,parent,hotkey,GetModuleHandleW(Null),Null) + + If (style & COMBOBOX_EDITABLE) Then + _editHwnd=SendMessageW(hwnd,CBEM_GETEDITCONTROL,0,0) + If _editHwnd Then + editstyle=GetWindowLongW(_editHwnd,GWL_STYLE) + SetWindowLongW _editHwnd,GWL_STYLE,editstyle|WS_TABSTOP + EndIf + EndIf + + _comboHwnd=SendMessageW(hwnd,CBEM_GETCOMBOCONTROL,0,0) + comboStyle=GetWindowLongW(_comboHwnd,GWL_STYLE) + SetWindowLongW _comboHwnd,GWL_STYLE,comboStyle|WS_TABSTOP + + Register GADGET_COMBOBOX,hwnd + + TWindowsGUIDriver.RegisterHwnd(_combohwnd,Self) + If _edithwnd Then TWindowsGUIDriver.RegisterHwnd(_edithwnd,Self) + + SetColor(255,255,255) + + Return Self + + EndMethod + + Method SetText(Text$) + If Not _editHwnd Then + Local tmpWString:Short Ptr = Text.ToWString() + Local tmpResult = SendMessageW(_comboHwnd, CB_SETCUEBANNER, 0, Int(tmpWString)) + MemFree tmpWString;Return tmpResult + Else + Return Super.SetText(Text) + EndIf + EndMethod + + Method GetText$() + If Not _editHwnd Then + If _selected > -1 Then Return items[_selected].Text Else Return "" + Else + Return Super.GetText() + EndIf + EndMethod + + Method Activate(cmd) + If _editHwnd Then + Select cmd + Case ACTIVATE_CUT + SendMessageW _editHwnd,WM_CUT,0,0 + Case ACTIVATE_COPY + SendMessageW _editHwnd,WM_COPY,0,0 + SetFocus _hwnd + Case ACTIVATE_PASTE + SendMessageW _editHwnd,WM_PASTE,0,0 + Case ACTIVATE_FOCUS + SendMessageW _editHwnd,EM_SETSEL,0,-1 + End Select + EndIf + Return Super.Activate(cmd) + EndMethod + + Method SetIconStrip(iconstrip:TIconStrip) + Local imagelist + _icons=TWindowsIconStrip(iconstrip) + If _icons Then imagelist = _icons._imagelist + SendMessageW _hwnd,CBEM_SETIMAGELIST,LVSIL_SMALL,imagelist + EndMethod + + Method ClearListItems() + _selected=-1 + Desensitize() + SendMessageW _hwnd,CB_RESETCONTENT,0,0 + Sensitize() + EndMethod + + Method InsertListItem(index,Text$,tip$,icon,tag:Object) + Local it:COMBOBOXEXITEMW = New COMBOBOXEXITEMW + it.mask=CBEIF_TEXT + it.iItem=index + it.pszText=Text.toWString() + If icon>=0 + it.mask:|CBEIF_IMAGE|CBEIF_SELECTEDIMAGE + it.iImage=icon + it.iSelectedImage=icon + EndIf + Desensitize() + SendMessageW(_hwnd,CBEM_INSERTITEMW,0,Int Byte Ptr(it)) + Sensitize() + MemFree it.pszText + EndMethod + + Method SetListItem(index,Text$,tip$,icon,tag:Object) + Local it:COMBOBOXEXITEMW = New COMBOBOXEXITEMW + it.mask=CBEIF_TEXT + it.iItem=index + it.pszText=Text.toWString() + If _icons And icon>-1 + it.mask:|CBEIF_IMAGE|CBEIF_SELECTEDIMAGE + it.iImage=icon + it.iSelectedImage=icon + EndIf + Desensitize() + SendMessageW(_hwnd,CBEM_SETITEMW,0,Int Byte Ptr(it)) + Sensitize() + MemFree it.pszText + EndMethod + + Method RemoveListItem(index) + Desensitize() + SendMessageW _hwnd,CBEM_DELETEITEM,index,0 + Sensitize() + EndMethod + + Method SetListItemState(index,state) + If state&STATE_SELECTED + _selected=index + Else + If _selected=index _selected=-1 + index=-1 + EndIf + Desensitize() + SendMessageW _hwnd,CB_SETCURSEL,index,0 + Sensitize() + EndMethod + + Method ListItemState(index) + Local Current,state + Current=SendMessageW(_hwnd,CB_GETCURSEL,0,0) + If Current=CB_ERR Current=-1 + If Current=index state=STATE_SELECTED + Return state + EndMethod + + Method OnCommand(msg,wp) + Local index + Select wp Shr 16 + Case CBN_SELCHANGE + index=SendMessageW(_hwnd,CB_GETCURSEL,0,0) + If index=CB_ERR + index=-1 + Else + If _selected<>index 'user generated event + _selected=index + Local extra:Object + If index>=0 And index tmpHeight Then + TWindowsGadget(parent)._clientY = tmpHeight + parent.Rethink() + TWindowsGadget(parent).RethinkClient() + parent.LayoutKids() + EndIf + EndMethod + + Method DoLayout() + Rethink() + EndMethod + + Method SetTooltip( pTooltip$ ) + 'ToolTips should be set on an item-by-item basis instead. + EndMethod + + Method ClearListItems() + While SendMessageW(_hwnd,TB_BUTTONCOUNT,0,0) + RemoveListItem(0) + Wend + EndMethod + + Method InsertListItem(index,Text$,tip$,icon,tag:Object) + Local but:TBBUTTON + but=New TBBUTTON + but.fsState=TBSTATE_ENABLED + If icon = -2 Or (icon>-1 And _icons.IsBlankIcon(icon)) + but.idCommand=0 + but.fsStyle=TBSTYLE_SEP + Else + but.iBitmap=icon + but.idCommand=index+1 + but.fsStyle=TBSTYLE_BUTTON + EndIf + Desensitize() + SendMessageW _hwnd,TB_INSERTBUTTON,index,Int Byte Ptr(but) + Sensitize() + If tip + Local ti:TOOLINFOW=New TOOLINFOW + ti.cbSize=SizeOf(ti) + ti.uFlags=TTF_SUBCLASS + ti.hwnd=_hwnd + ti.lpszText=tip.towstring() + ti.uId=index+1 + SendMessageW _hwnd,TB_GETITEMRECT,index,Int(Varptr ti.rect_left) + SendMessageW _tooltips,TTM_ADDTOOLW,0,Int Byte Ptr(ti) + MemFree ti.lpszText + EndIf + EndMethod + + Method SetListItem(index,Text$,tip$,icon,tag:Object) + Local tmpState:Int = ListItemState(index) + RemoveListItem index + InsertListItem index,Text,tip,icon,tag + SetListItemState(index,tmpState) + EndMethod + + Method RemoveListItem(index) + Local ti:TOOLINFOW=New TOOLINFOW + ti.cbSize=SizeOf(ti) + ti.hwnd=_hwnd + ti.uId=index+1 + Desensitize() + SendMessageW _tooltips,TTM_DELTOOLW,0,Int(Varptr ti) + SendMessageW _hwnd,TB_DELETEBUTTON,index,0 + Sensitize() + EndMethod + + Method SetListItemState(index,state) + Local enable,pressed + If state&STATE_DISABLED=0 enable=$1 + If state&STATE_SELECTED pressed=$1 + SendMessageW _hwnd,TB_ENABLEBUTTON,index+1,enable + SendMessageW _hwnd,TB_CHECKBUTTON,index+1,pressed + EndMethod + + Method ListItemState(index) + Local state,flags + state=SendMessageW(_hwnd,TB_GETSTATE,index+1,0) + If state=-1 Return 0 + If Not (state&TBSTATE_ENABLED) flags:|STATE_DISABLED + If state&TBSTATE_CHECKED flags:|STATE_SELECTED + Return flags + EndMethod + + Method OnCommand(msg,wp) + Local index=wp-1 + Local extra:Object + If index>=0 And indexRect[0] Then Return Rect[2]-Rect[0] + EndMethod + + Method ClientHeight() + Local Rect[] = [0,0,width,height] + SendMessageW _hwnd,TCM_ADJUSTRECT,False,Int Byte Ptr(Rect) + If Rect[3]>Rect[1] Then Return Rect[3]-Rect[1] + EndMethod + + Method ClearListItems() + _tabcount=0 + _selected=-1 + Desensitize() + SendMessageW _hwnd,TCM_DELETEALLITEMS, 0, 0 + Sensitize() + RethinkClient() + EndMethod + + Method InsertListItem(index,Text$,tip$,icon,tag:Object) + If _tabcount=0 SendMessageW _hwnd,TCM_DELETEALLITEMS,0,0 + Local t:TCITEMW=New TCITEMW + t.mask=TCIF_TEXT|TCIF_IMAGE + t.pszText=Text.toWString() + t.iImage=icon + Desensitize() + SendMessageW _hwnd,TCM_INSERTITEMW,index,Int Byte Ptr(t) + Sensitize() + MemFree t.pszText + _tabcount:+1 + RethinkClient() + EndMethod + + Method SetListItem(index,Text$,tip$,icon,tag:Object) + Local t:TCITEMW=New TCITEMW + t.mask=TCIF_TEXT|TCIF_IMAGE + t.pszText=Text.toWString() + t.iImage=icon + Desensitize() + SendMessageW _hwnd,TCM_SETITEMW,index,Int Byte Ptr(t) + Sensitize() + MemFree t.pszText + RethinkClient() + EndMethod + + Method RemoveListItem(index) + Desensitize() + SendMessageW _hwnd,TCM_DELETEITEM,index,0 + _tabcount:-1 + _selected=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) + If _tabcount=0 SendMessageW _hwnd,TCM_INSERTITEMW,0,Int(_blank) + Sensitize() + RethinkClient() + EndMethod + + Method SetListItemState(index,state) + Desensitize() + If state&STATE_SELECTED + _selected=index + SendMessageW _hwnd,TCM_SETCURSEL,index,0 + ElseIf _selected=index + _selected=-1 + EndIf + Sensitize() + EndMethod + + Method ListItemState(index) + Local state,Current + Current=-1 + If _tabcount Current=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) + If Current=index state:|STATE_SELECTED + Return state + EndMethod + + Method OnNotify(wp,lp) + Local nmhdr:Int Ptr 'hwnd,id,code + Local index + nmhdr=Int Ptr(lp) + Select nmhdr[2] + + Case TTN_GETDISPINFOW + + Local TCHITTESTINFO[3], Rect[4] + + GetCursorPos_( TCHITTESTINFO );GetWindowRect( _hwnd, Rect ) + TCHITTESTINFO = [TCHITTESTINFO[0]-Rect[0],TCHITTESTINFO[1]-Rect[1],0] + + Local tmpItem = SendMessageW( _hwnd, TCM_HITTEST, 0, Int Byte Ptr TCHITTESTINFO ) + + If (tmpItem > -1) And (tmpItem < items.length) Then + Local tmpTooltip$ = items[tmpItem].tip + If (items[tmpItem].flags&GADGETITEM_LOCALIZED) Then tmpTooltip = LocalizeString(tmpTooltip) + SetTipBuffer( tmpTooltip ) + If tmpTooltip Then nmhdr[3] = Int(_tipbuffer) + EndIf + + Case TCN_SELCHANGE + If _tabcount + index=SendMessageW(_hwnd,TCM_GETCURSEL,0,0) + If index<>_selected + Local extra:Object + If index>=0 And index= items.length) Then index = -1 Else extra = items[index].extra + + PostGuiEvent EVENT_GADGETMENU,index,0,TCHITTESTINFO[0],TCHITTESTINFO[1],extra + + EndSelect + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_ERASEBKGND + Select hwnd + Case _hwndclient + If DrawThemeParentBackground Then + DrawParentBackground(wp,hwnd) + Return 1 + EndIf + EndSelect + End Select + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method RethinkClient(forceRedraw:Int = False) + Local Rect[] = [0,0,width,height] + SendMessageW _hwnd,TCM_ADJUSTRECT,False, Int Byte Ptr(Rect) + MoveWindow _hwndclient,Rect[RECT_LEFT],Rect[RECT_TOP],Rect[RECT_RIGHT]-Rect[RECT_LEFT],Rect[RECT_BOTTOM]-Rect[RECT_TOP],forceRedraw + EndMethod + + Method SetTipBuffer( pTip$ ) + If _tipbuffer Then MemFree _tipbuffer + If pTip Then _tipbuffer = pTip.ToWString() + EndMethod + + Method SetTooltip( pTooltip$ ) + 'ToolTips should be set on an item-by-item basis instead. + EndMethod + + Method Class() + Return GADGET_TABBER + EndMethod + +EndType + +Type TWindowsTreeNode Extends TGadget + Field _parent:TWindowsTreeNode + Field _tree 'HWND + Field _item 'HTREEITEM + Field _expanded + Field _icon + Field _handle + + Method Activate(cmd) + Local tmpTree:TWindowsTreeView = TWindowsTreeView(TWindowsGUIDriver.GadgetFromHwnd(_tree)) + If tmpTree Then tmpTree.Desensitize() + Select cmd + Case ACTIVATE_SELECT + If _item <> TVI_ROOT Then + SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,_item + Else + SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,0 + EndIf + Case ACTIVATE_EXPAND + SendMessageW _tree,TVM_EXPAND,TVE_EXPAND,_item + _expanded=True + Case ACTIVATE_COLLAPSE + SendMessageW _tree,TVM_EXPAND,TVE_COLLAPSE,_item + _expanded=False + Case ACTIVATE_REDRAW + RedrawNode() + End Select + If tmpTree Then tmpTree.Sensitize() + EndMethod + + Method CreateRoot:TWindowsTreeNode(owner:TWindowsTreeView) + _tree=owner._hwnd + _item=TVI_ROOT + Return Self + EndMethod + + Method CountKids() + Return kids.count() + EndMethod + + Method Create:TWindowsTreeNode(group:TGadget,style,Text$="",index=-1,icon = -1) + _parent=TWindowsTreeNode(group) + If Not _parent Throw "Parent isn't a treeview node. Use TreeViewRoot() when creating a root node." + Self.style = style + _tree=_parent._tree + _icon = icon + Spawn(Text,index) + _SetParent group,index + If (LocalizationMode()&LOCALIZATION_OVERRIDE) Then + LocalizeGadget(Self, Text, "") + EndIf + Return Self + EndMethod + + Method GetText$() + Local item[10] + Local buffer:Short[260] + item[0]=TVIF_TEXT + item[1]=_item + item[4]=Int Byte Ptr buffer + item[5]=256 + SendMessageW _tree,TVM_GETITEMW,0,Int Byte Ptr(item) + Return String.FromWString(buffer) + EndMethod + + Method SetText(Text$) + Local tv:TVITEMW=New TVITEMW + tv.mask=TVIF_HANDLE|TVIF_TEXT + tv.hItem = _item + If _icon > -1 Then + tv.mask:|TVIF_IMAGE|TVIF_SELECTEDIMAGE + tv.iImage=_icon + tv.iSelectedImage=tv.iImage + EndIf + tv.pszText=Text.ToWString() + SendMessageW(_tree,TVM_SETITEMW,0,Int Byte Ptr tv) + MemFree tv.pszText + EndMethod + + Method DoLayout() + 'Don't do anything! + EndMethod + + Method Free() + 'If we don't have a parent then the node must have previously been freed. + If Not _parent Then Return + 'Avoid firing events when freeing a treenode that is selected. + If SendMessageW(_tree,TVM_GETNEXTITEM,TVGN_CARET,0) Then DeSelect() + 'Free treenode + If _item Then SendMessageW(_tree,TVM_DELETEITEM,0,_item);_item=0 + 'Redraw parent if we were its last child node + If Not SendMessageW(_tree, TVM_GETNEXTITEM, TVGN_CHILD, _parent._item) Then _parent.RedrawNode() + 'Cleanup variables that could be circular references + _parent = Null;_tree = 0;_SetParent Null + 'Release any handle we created using HandleFromObject() in Spawn() + If _handle Then Release _handle + EndMethod + + Method DeSelect() + SendMessageW _tree,TVM_SELECTITEM,TVGN_CARET,0 + EndMethod + + Method InsertNode:TGadget(index,Text$,icon) + Return New TWindowsTreeNode.Create(Self,0,Text,index,icon) + EndMethod + + Method ModifyNode(Text$,icon) + _icon = icon + SetText Text + EndMethod + + Method tviatindex(index) + If kids.IsEmpty() Then Return TVI_FIRST + If index<0 Or index>=kids.count() Return TVI_LAST + Local child:TWindowsTreeNode + child=TWindowsTreeNode(kids.valueatindex(index)) + Return child._item + EndMethod + + Method Spawn(name$,index=-1) + + Local it:TVINSERTSTRUCTW + Local hitem + it=New TVINSERTSTRUCTW + it.hParent=_parent._item + If index = 0 Then + it.hInsertAfter = TVI_FIRST + Else + it.hInsertAfter=_parent.tviatindex(index-1) + EndIf + it.item_mask=TVIF_TEXT|TVIF_PARAM + + If _icon > -1 Then + it.item_mask:|TVIF_IMAGE|TVIF_SELECTEDIMAGE + it.item_iImage=_icon + it.item_iSelectedImage=it.item_iImage + EndIf + + Local tmpParentHadKids = SendMessageW(_tree, TVM_GETNEXTITEM, TVGN_CHILD, _parent._item) + + it.item_pszText=name.ToWString() + it.item_lparam=HandleFromObject(Self) + + 'Make sure that we store handle so we can release it later. + If _handle Then Release _handle + _handle = it.item_lparam + + _item=SendMessageW(_tree,TVM_INSERTITEMW,0,Int Byte Ptr it) + + MemFree it.item_pszText + + 'Fix for tree-view parent status update problem. + If Not tmpParentHadKids Then _parent.RedrawNode() + + Return _item + + EndMethod + + Method RedrawNode() + + If _item = TVI_ROOT Then + InvalidateRect _tree, Null, True + Else + Local Rect[] = [_item,0,0,0] + If SendMessageW(_tree, TVM_GETITEMRECT, False, Int Byte Ptr Rect) Then + InvalidateRect _tree, Rect, True + EndIf + EndIf + + EndMethod + + Method SetTooltip( pTooltip$ ) + 'At the moment, nodes don't support tooltips. + EndMethod + + Method Class() + Return GADGET_NODE + EndMethod + +EndType + +Type TWindowsTreeView Extends TWindowsGadget + + Field _root:TWindowsTreeNode + Field _selected:TWindowsTreeNode + Field _icons:TWindowsIconStrip + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + + Self.style = style + xstyle=WS_EX_CLIENTEDGE + wstyle=WS_CHILD|TVS_HASLINES|TVS_HASBUTTONS|TVS_LINESATROOT|TVS_SHOWSELALWAYS|TVS_NOTOOLTIPS|WS_CLIPSIBLINGS + If Not(style&TREEVIEW_DRAGNDROP) wstyle:|TVS_DISABLEDRAGDROP + + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"SysTreeView32","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + If TWindowsGUIDriver.CheckCommonControlVersion() Then SendMessageW hwnd, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER + Register GADGET_TREEVIEW,hwnd + _root=New TWindowsTreeNode.CreateRoot(Self) + + If TWindowsGUIDriver._explorerstyle Then UseExplorerTheme() + + Return Self + + EndMethod + + Method SetIconStrip(iconstrip:TIconStrip) + _icons=TWindowsIconStrip(iconstrip) + SendMessageW _hwnd,TVM_SETIMAGELIST,TVSIL_NORMAL,_icons._imagelist + EndMethod + + Method SetColor(r,g,b) + SendMessageW _hwnd,TVM_SETBKCOLOR,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + Method RemoveColor() + SendMessageW _hwnd,TVM_SETBKCOLOR,1,0 + EndMethod + + Method SetTextColor(r,g,b) + SendMessageW _hwnd,TVM_SETTEXTCOLOR,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + Method RootNode:TGadget() + Return _root + EndMethod + + Method SelectedNode:TGadget() + Return _selected + EndMethod + + Method CountKids() + Return _root.CountKids() + EndMethod + + Method OnNotify(wp,lp) + Local nmhdr:Int Ptr + Local itemnew:Int Ptr + Local node:TWindowsTreeNode + + Super.OnNotify(wp,lp) 'Tool-tips + + nmhdr=Int Ptr(lp) + Select nmhdr[2] 'code + + 'MSLU glitch requires handling of ANSI equivalent + Case TVN_SELCHANGEDW, TVN_SELCHANGEDA + itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew + If itemnew[1]=TVI_ROOT 'hItem + _selected=_root + Else + _selected=TWindowsTreeNode(HandleToObject(itemnew[9])) 'lParaM + EndIf + PostGuiEvent EVENT_GADGETSELECT,0,0,0,0,_selected + + Case TVN_ITEMEXPANDEDW, TVN_ITEMEXPANDEDA + itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew.TVITEM + If itemnew[1]=TVI_ROOT 'hItem + node=_root + Else + node=TWindowsTreeNode(HandleToObject(itemnew[9] )) 'lParaM + EndIf + Select nmhdr[3] 'action itemnew[2]&TVIS_EXPANDED 'state + Case 1 + PostGuiEvent EVENT_GADGETCLOSE,0,0,0,0,node + node._expanded=False + Case 2 + PostGuiEvent EVENT_GADGETOPEN,0,0,0,0,node + node._expanded=True + End Select + Return True + + Case TVN_BEGINDRAGW, TVN_BEGINRDRAGW, TVN_BEGINDRAGA, TVN_BEGINRDRAGA + + If (style&TREEVIEW_DRAGNDROP) Then + + Local data% = 1 + If (nmhdr[2] = TVN_BEGINRDRAGW) Or (nmhdr[2] = TVN_BEGINRDRAGA) Then data = 2 + + itemnew=nmhdr+14 'Int Ptr(nmhdr[5]) 'itemNew + + If itemnew[1]<>TVI_ROOT Then + TGadget.dragGadget[data-1]=TWindowsTreeNode(HandleToObject(itemnew[9])) + PostGuiEvent EVENT_GADGETDRAG, data, KeyMods(), itemnew[10], itemnew[11], TGadget.dragGadget[data-1] + Else + TGadget.dragGadget[data-1]=Null + EndIf + + EndIf + + Case NM_DBLCLK, NM_RETURN + PostGuiEvent EVENT_GADGETACTION,0,0,0,0,_selected + + Case NM_RCLICK + Local Rect[4] + Local pt[2] + Local hittest[4] + Local item[10] + GetWindowRect _hwnd,Rect + GetCursorPos_ pt + hittest[0]=pt[0]-Rect[0] + hittest[1]=pt[1]-Rect[1] + If SendMessageW(_hwnd,TVM_HITTEST,0,Int Byte Ptr(hittest)) + If hittest[3]=TVI_ROOT + node=_root + Else + item[0]=TVIF_PARAM + item[1]=hittest[3] + SendMessageW _hwnd,TVM_GETITEMW,0,Int Byte Ptr(item) + node=TWindowsTreeNode(HandleToObject(item[9])) + EndIf + PostGuiEvent EVENT_GADGETMENU,0,hittest[0],hittest[1],0,node + EndIf + Return True + + EndSelect + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + 'If we are using Vista's common controls, then the treeview will be double-buffered and so + 'we don't need to clear the background when redrawing (performance tweak). + Case WM_ERASEBKGND + If TWindowsGUIDriver.CheckCommonControlVersion() >= 2 Then Return 1 + EndSelect + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method UseExplorerTheme() + + If TWindowsGUIDriver.CheckCommonControlVersion() And SetWindowThemeW Then + SetWindowThemeW( _hwnd, _wstrExplorer, Null ) + SendMessageW _hwnd, TVM_SETEXTENDEDSTYLE, TVS_EX_FADEINOUTEXPANDOS, TVS_EX_FADEINOUTEXPANDOS + EndIf + + EndMethod + + Method Class() + Return GADGET_TREEVIEW + EndMethod + +EndType + +Type TWindowsLabel Extends TWindowsGadget + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + + Self.style = style + wstyle=WS_CHILD|SS_NOPREFIX|WS_CLIPSIBLINGS|SS_NOTIFY + + Select style&24 + Case LABEL_LEFT wstyle:|SS_LEFT + Case LABEL_RIGHT wstyle:|SS_RIGHT + Case LABEL_CENTER wstyle:|SS_CENTER + End Select + Select style&7 + Case LABEL_FRAME wstyle:|WS_BORDER + Case LABEL_SUNKENFRAME wstyle:|SS_SUNKEN + Case LABEL_SEPARATOR wstyle:|SS_SUNKEN|SS_GRAYRECT + End Select + + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"STATIC","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + Register GADGET_LABEL,hwnd + + Return Self + EndMethod + + Method SetArea(x,y,w,h) + If ((style & 7) = LABEL_SEPARATOR) Then + If (w > h) Then h = 2 Else w = 2 + EndIf + Return Super.SetArea(x,y,w,h) + EndMethod + + Method SetText(Text$) + If ((style & 7) <> LABEL_SEPARATOR) Then Return Super.SetText(Text) + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_ERASEBKGND + Return 1 + EndSelect + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method Class() + Return GADGET_LABEL + EndMethod + +EndType + +Type TWindowsSlider Extends TWindowsGadget + Field _slidertype,_ishorizontal,_visible = 5,_total = 10,_value + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,class$ + Local hwnd,parent,hotkey + + _slidertype=style&$fffc + _ishorizontal=style&SLIDER_HORIZONTAL + + Self.style = style + wstyle=WS_CHILD|WS_CLIPSIBLINGS|WS_CLIPCHILDREN + parent=group.query(QUERY_HWND_CLIENT) + Select _slidertype + Case SLIDER_SCROLLBAR + If _ishorizontal wstyle:|SBS_HORZ;Else wstyle:|SBS_VERT + class$="SCROLLBAR" + Case SLIDER_TRACKBAR + wstyle:|TBS_AUTOTICKS|WS_TABSTOP + xstyle:|WS_EX_COMPOSITED 'Reduces flicker when resizing (doesn't like scrollbars/up-down controls) + If _ishorizontal wstyle:|TBS_HORZ Else wstyle:|TBS_VERT + class$=TRACKBAR_CLASS + Case SLIDER_STEPPER + If _ishorizontal wstyle:|UDS_HORZ + class$="msctls_updown32" + Default + Return Null + End Select + + hwnd=CreateWindowExW(xstyle,class,"",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + Register GADGET_SLIDER,hwnd + RefreshLook() + + Return Self + EndMethod + + Method SetRange(visible,total) + _visible = visible + _total = total + Local tmpEnabled:Int = Not( State() & STATE_DISABLED ) + Desensitize() + Select _slidertype + Case SLIDER_SCROLLBAR + Local info:SCROLLINFO=New SCROLLINFO + info.cbSize=SizeOf(SCROLLINFO) + info.fMask=SIF_PAGE|SIF_RANGE + info.nMax=total-1 + info.nPage=visible + SendMessageW _hwnd,SBM_SETSCROLLINFO,True,Int Byte Ptr info + Case SLIDER_TRACKBAR + + SendMessageW _hwnd,TBM_SETRANGEMIN,False,visible + SendMessageW _hwnd,TBM_SETRANGEMAX,True,total + + ' Aesthetic tweak that should stop black tick bands forming when + ' large ranges are used on small trackbars. + + Local tmpFirstTick% = SendMessageW( _hwnd, TBM_GETTICPOS, 0, 0 ) + Local tmpNumTicks% = SendMessageW( _hwnd, TBM_GETNUMTICS, 0, 0) + Local tmpLastTick% = SendMessageW( _hwnd, TBM_GETTICPOS, tmpNumTicks-3, 0 ) + If Not( tmpLastTick < 0 Or tmpFirstTick < 0 Or (total-visible-2) < 1) Then + If (tmpLastTick-tmpFirstTick)/(total-visible-2) < 4 Then + SendMessageW( _hwnd, TBM_CLEARTICS, True, 0 ) + EndIf + EndIf + + Case SLIDER_STEPPER + SendMessageW _hwnd,UDM_SETRANGE32,visible,total + End Select + _value = GetProp() + SetEnabled(tmpEnabled) + Sensitize() + EndMethod + + Method SetProp(value) + Desensitize() + Select _slidertype + Case SLIDER_SCROLLBAR + Local info:SCROLLINFO=New SCROLLINFO + info.cbSize=SizeOf(SCROLLINFO) + info.fMask=SIF_POS + info.nPos=value + SendMessageW _hwnd,SBM_SETSCROLLINFO,True,Int Byte Ptr info + Case SLIDER_TRACKBAR + If _ishorizontal Then + SendMessageW _hwnd,TBM_SETPOS,True,value + Else + 'Flip the value so that the scale starts from the bottom + SendMessageW _hwnd,TBM_SETPOS,True,_visible + _total - value + EndIf + Case SLIDER_STEPPER + SendMessageW _hwnd,UDM_SETPOS,True,value + End Select + _value = value + Sensitize() + EndMethod + + Method GetProp() + Local value + Select _slidertype + Case SLIDER_SCROLLBAR + value=GetScrollPos(_hwnd,SB_CTL) + Case SLIDER_TRACKBAR + value=SendMessageW(_hwnd,TBM_GETPOS,0,0) + 'Flip the value so that the scale starts from the bottom + If Not _ishorizontal Then value = _visible + _total - value + Case SLIDER_STEPPER + value=SendMessageW(_hwnd,UDM_GETPOS32,0,Null) + End Select + Return value + EndMethod + + Method OnCommand(msg,wp) + If _slidertype=SLIDER_SCROLLBAR + If msg=WM_COMMAND Return + Local info:SCROLLINFO=New SCROLLINFO + info.cbSize=SizeOf(SCROLLINFO) + Select wp&$ffff + Case SB_THUMBTRACK,SB_THUMBPOSITION + info.fMask=SIF_TRACKPOS + SendMessageW _hwnd,SBM_GETSCROLLINFO,0,Int Byte Ptr info + SetScrollPos _hwnd,SB_CTL,info.nTrackPos,True + Default + info.fMask=SIF_POS|SIF_PAGE|SIF_RANGE + SendMessageW _hwnd,SBM_GETSCROLLINFO,0,Int Byte Ptr info + Local pos=info.nPos + Local vis=info.nPage + Select wp&$ffff + Case SB_LINEUP pos:-1 + Case SB_LINEDOWN pos:+1 + Case SB_PAGEUP pos:-vis + Case SB_PAGEDOWN pos:+vis + Default Return 0 + End Select + SetScrollPos _hwnd,SB_CTL,pos,True + End Select + EndIf + Local index=GetProp() + If (index <> _value) Then + PostGuiEvent EVENT_GADGETACTION,index + _value = index + EndIf + Return 1 + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + Case WM_ERASEBKGND + Return 1 + EndSelect + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method RefreshLook() + Super.RefreshLook() + SetRange(_visible,_total) + EndMethod + + Method Class() + Return GADGET_SLIDER + EndMethod + +EndType + +Type TWindowsProgressBar Extends TWindowsGadget + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,parent + Self.style = style + wstyle=WS_CHILD|PBS_SMOOTH|WS_CLIPSIBLINGS + parent=group.query(QUERY_HWND_CLIENT) + hwnd=CreateWindowExW(xstyle,"msctls_progress32","",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + Register GADGET_PROGBAR,hwnd + Return Self + EndMethod + + Method SetValue(value#) + SendMessageW _hwnd,PBM_SETPOS,value*100,0 + EndMethod + + Method SetColor(r,g,b) + 'Only works in Classic mode, but it's better than nothing. + SendMessageW _hwnd,PBM_SETBKCOLOR ,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + Method RemoveColor() + 'Only works in Classic mode, but it's better than nothing. + SendMessageW _hwnd,PBM_SETBKCOLOR ,1,0 + EndMethod + + Method SetTextColor(r,g,b) + 'Only works in Classic mode, but it's better than nothing. + SendMessageW _hwnd,PBM_SETBARCOLOR ,0,(b Shl 16)|(g Shl 8)|r + EndMethod + + Method Class() + Return GADGET_PROGBAR + EndMethod + +EndType + +Type TWindowsPanel Extends TWindowsGadget + + Const PANELPANEL=0 + Const PANELGROUP=1 + Const PANELCANVAS=2 + + Field _type + Field _alpha#=1.0 + Field _bitmapwidth,_bitmapheight,_bitmapflags + Field _canvas:TGraphics + Field _hasalpha + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Local xstyle,wstyle,hotkey + Local hwnd,client,parent + Self.style = style + + parent=group.query(QUERY_HWND_CLIENT) + If (style&3=PANEL_GROUP) Then + _type=PANELGROUP + hwnd=CreateWindowExW(WS_EX_CONTROLPARENT,"BUTTON","",BS_GROUPBOX|WS_CHILD|WS_CLIPSIBLINGS|WS_CLIPCHILDREN,0,0,0,0,parent,0,GetModuleHandleW(Null),Null ) + client=CreateWindowExW(WS_EX_CONTROLPARENT,TWindowsGUIDriver.ClassName(),"",WS_CHILD|WS_VISIBLE|WS_CLIPCHILDREN|WS_CLIPSIBLINGS,0,0,0,0,hwnd,0,GetModuleHandleW(Null),Null) + Else + _type=PANELPANEL + xstyle=WS_EX_CONTROLPARENT + wstyle=WS_CHILD|WS_CLIPCHILDREN|WS_CLIPSIBLINGS + Select (style&3) + Case PANEL_SUNKEN xstyle:|WS_EX_CLIENTEDGE + Case PANEL_RAISED xstyle:|WS_EX_WINDOWEDGE ; wstyle:|WS_DLGFRAME + EndSelect + If (style&PANEL_CANVAS) Then _type=PANELCANVAS + hwnd=CreateWindowExW(xstyle,TWindowsGUIDriver.ClassName(),"",wstyle,0,0,0,0,parent,hotkey,GetModuleHandleW(Null),Null) + EndIf + + Register GADGET_PANEL,hwnd,client + If (style & PANEL_ACTIVE) Then sensitivity = SENSITIZE_ALL + + Return Self + EndMethod + + Method SetAlpha( alpha# ) + _alpha=alpha + RedrawGadget(Self) + EndMethod + + Method Activate( cmd ) + Select cmd + Case ACTIVATE_REDRAW + If (_type = PANELCANVAS) Then + InvalidateRect _hwnd, Null, False + Return True + EndIf + EndSelect + Return Super.Activate(cmd) + EndMethod + + Method SetPixmap(pixmap:TPixmap,flags) + If _bitmap Then DeleteObject _bitmap;_bitmap = 0 + If pixmap Then + If pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888 + _bitmap=TWindowsGraphic.PreMultipliedBitmapFromPixmap32( pixmap ) + EndIf + If _bitmap + _hasalpha=True + Else + _bitmap=TWindowsGraphic.BitmapFromPixmap( pixmap, False ) + _hasalpha=False + EndIf + _bitmapflags=flags + _bitmapwidth=pixmap.width + _bitmapheight=pixmap.height + EndIf + RedrawGadget(Self) + EndMethod + + Method AttachGraphics:TGraphics( flags ) + _canvas=brl.Graphics.AttachGraphics( _hwnd,flags ) + EndMethod + + Method CanvasGraphics:TGraphics() + Return _canvas + EndMethod + + Method Free() + If _canvas Then CloseGraphics(_canvas);_canvas = Null + Super.Free() + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + + Case WM_ERASEBKGND + + If _type = PANELCANVAS Then Return 1 + + Local hdc=wp,hdcCanvas,hdcBitmap,srcw,srch,x,y,xoffset,yoffset + Local clientRect[4], updateRect[4], clipRect[4], windowRect[4] + + GetClipBox( hdc, clipRect ) + GetWindowRect( hwnd, windowRect) + GetClientRect( hwnd, clientRect ) + + If Not GetUpdateRect( hwnd, updateRect, False) Then updateRect = clipRect + If IsRectEmpty(updateRect) Then updateRect = [0,0,windowRect[2]-windowRect[0],windowRect[3]-windowRect[1]] + + 'If we are drawing a bitmap or using alpha then let's do some double-buffering stuff + + If (hwnd <> _hwndclient) And ((_bitmap And _bitmapwidth And _bitmapheight) Or _alpha<1.0) Then + + hdc = CreateCompatibleDC(wp) + hdcCanvas = CreateCompatibleBitmap(wp,windowRect[2]-windowRect[0],windowRect[3]-windowRect[1]) + SelectObject( hdc, hdcCanvas ) + + EndIf + + 'Fill the drawing context with the background colour, or the background of the parent + + If BgBrush() And (hwnd <> _hwndclient) Then FillRect(hdc,updateRect,BgBrush()) Else DrawParentBackground(hdc,hwnd) + + 'If we aren't drawing to a bitmap or using alpha, then we can return now. + + If Not ((hwnd <> _hwndclient) And ((_bitmap And _bitmapwidth And _bitmapheight) Or _alpha<1.0)) Then Return 1 + + If _bitmap And _bitmapwidth And _bitmapheight + hdcBitmap=CreateCompatibleDC(hdc) + SelectObject(hdcBitmap,_bitmap) + srcw=_bitmapwidth + srch=_bitmapheight + Select (_bitmapflags & (GADGETPIXMAP_ICON-1)) + Case PANELPIXMAP_TILE + While ymy Then + If (_bitmapflags&(GADGETPIXMAP_ICON-1)) = PANELPIXMAP_FIT Then mx=my Else my=mx + EndIf + Local w=mx*srcw + Local h=mx*srch + x=(windowRect[RECT_RIGHT]-windowRect[RECT_LEFT]-w)/2 + y=(windowRect[RECT_BOTTOM]-windowRect[RECT_TOP]-h)/2 + SetStretchBltMode hdc,COLORONCOLOR + + If _hasalpha + AlphaBlend_ hdc,x,y,w,h,hdcBitmap,0,0,srcw,srch,$01ff0000 + Else + StretchBlt hdc,x,y,w,h,hdcBitmap,0,0,srcw,srch,ROP_SRCCOPY + EndIf + + Case PANELPIXMAP_STRETCH + SetStretchBltMode hdc,COLORONCOLOR + + If _hasalpha + AlphaBlend_ hdc,0,0,windowRect[RECT_RIGHT]-windowRect[RECT_LEFT],windowRect[RECT_BOTTOM]-windowRect[RECT_TOP],hdcBitmap,0,0,srcw,srch,$01ff0000 + Else + StretchBlt hdc,0,0,windowRect[RECT_RIGHT]-windowRect[RECT_LEFT],windowRect[RECT_BOTTOM]-windowRect[RECT_TOP],hdcBitmap,0,0,srcw,srch,ROP_SRCCOPY + EndIf + + EndSelect + + DeleteDC(hdcBitmap) + + EndIf + + If _alpha < 1.0 Then + + DrawParentBackground( wp, hwnd ) + Local blendfunction = ((Int(_alpha*255)&$FF) Shl 16) + AlphaBlend_(wp,updateRect[0],updateRect[1],updateRect[2]-updateRect[0],updateRect[3]-updateRect[1],hdc,updateRect[0],updateRect[1],updateRect[2]-updateRect[0],updateRect[3]-updateRect[1],blendfunction) + + Else + + BitBlt(wp,0,0,windowRect[2]-windowRect[0],WindowRect[3]-windowRect[1],hdc,0,0,ROP_SRCCOPY) + + EndIf + + Assert hdc <> wp, "hdc == wp! Please post a MaxGUI bug report." + + DeleteObject( hdcCanvas ) + DeleteDC( hdc ) + + Return 1 + + Case WM_PAINT + + Select _type + Case PANELCANVAS + PostGuiEvent EVENT_GADGETPAINT + ValidateRect _hwnd, Null + Return 1 + EndSelect + + Case WM_LBUTTONDOWN + + SetFocus Query(QUERY_HWND_CLIENT) + + End Select + + Return Super.WndProc(hwnd,msg,wp,lp) + + EndMethod + + Method FlushBrushes(pRecurse:Int = True) + Super.FlushBrushes() + If Not pRecurse Then Return + For Local tmpGadget:TWindowsGadget = EachIn kids + tmpGadget.FlushBrushes() + Next + EndMethod + + Method ClientWidth() + If _hwndClient Then Return (Super.ClientWidth()-8) Else Return Super.ClientWidth() + EndMethod + + Method ClientHeight() + If _hwndClient Then Return (Super.ClientHeight()-20) Else Return Super.ClientHeight() + EndMethod + + Method RethinkClient(forceRedraw:Int = False) + If _hwndClient Then + MoveWindow( _hwndClient, 4+_clientX,16+_clientY,ClientWidth(),ClientHeight(),forceRedraw) + EndIf + EndMethod + + Method Class() + If _type = PANELCANVAS Then Return GADGET_CANVAS Else Return GADGET_PANEL + EndMethod + +EndType + + +Type TWindowsHTMLView Extends TWindowsGadget + + Field mshtml + Field browser:IWebBrowser2 + + Field IID_IHTMLDocument2:GUID=New GUID + + Method Create:TWindowsGadget(group:TGadget,style,Text$="") + Self.style = style + Local parent=group.query(QUERY_HWND_CLIENT) + mshtml=msHtmlCreate(Self,TWindowsGUIDriver.ClassName(),parent,style) + browser=msHTMLBrowser(mshtml) + Register GADGET_HTMLVIEW,msHtmlHwnd(mshtml) + + Local res = IIDFromString(IHTMLDocument2_UUID,IID_IHTMLDocument2) + + Return Self + EndMethod + + Method Rethink() + msHtmlSetShape mshtml,xpos,ypos,width,height + EndMethod + + Method SetText(Text$) 'sets document url + If Text Then msHtmlGo mshtml,Text + EndMethod + + Method GetText$() + Local bstr:Short Ptr + browser.lfget_LocationURL(Varptr bstr) + Local result$ = String.FromWString(bstr) + SysFreeString(bstr) + Return result + EndMethod + + Method GetTitleText$() 'returns document title + + Local bstr:Short Ptr + Local res + + Local disp:IDispatch + Local doc:IHTMLDOCUMENT2 + + res=browser.lfget_Document(Varptr disp) + If res RuntimeError "no document" + + res=disp.QueryInterface(IID_IHTMLDocument2,Varptr doc) + If res RuntimeError "no document2 interface" + + If doc + doc.get_Title(Varptr bstr) + Else + browser.lfget_LocationName(Varptr bstr) + EndIf + + Local result$ = String.FromWString(bstr) + SysFreeString(bstr) + Return result + + End Method +Rem + Method Run$(script$) + Local res + Local disp:IDispatch + Local doc:IHTMLDOCUMENT2 + Local win:IHTMLWindow2 + Local result:VARIANT + + res=browser.lfget_Document(Varptr disp) + If res RuntimeError "no document" + res=disp.QueryInterface(IID_IHTMLDocument2,Varptr doc) + If res RuntimeError "no document2 interface" + res=doc.get_parentWindow(Varptr win) + If res RuntimeError "no parent window" + result=New VARIANT + result.vt=VT_EMPTY + Local bstr:Short Ptr + bstr=SysAllocStringLen(script.toWString(),script.length) + res=win.execScript(bstr,Null,result) + SysFreeString bstr + Return res + End Method + +EndRem + Method Activate(cmd) + Return msHtmlActivate(mshtml,cmd) + EndMethod + + Method State() + Return msHtmlStatus(mshtml) + EndMethod + + Method Run$(script$) + msHtmlRun(mshtml,script) + EndMethod + + Method WndProc(hwnd,msg,wp,lp) + Select msg + 'Reduces flicker on HTMLViews + Case WM_ERASEBKGND + Return 1 + EndSelect + Return Super.WndProc(hwnd,msg,wp,lp) + EndMethod + + Method Class() + Return GADGET_HTMLVIEW + EndMethod + +EndType + +Type TWindowsMenu Extends TGadget + Field _hmenu + Field _pmenu + Field _item + Field _state + Field _tag + Field _hotkeycode + Field _modifier + Field _shortcut$ + Field _hotkey:THotKey + Field _key = SetNewKey() + Field _iconBitmap + + Global iteminfo:MENUITEMINFOW + + Global keymap:TMap=New TMap 'key,gadget + Global keycount=100 + + Method SetNewKey%() + keycount:+1 + keymap.Insert( TIntWrapper.Create(keycount), Self ) + Return keycount + EndMethod + + Function GetMenuFromKey:TWindowsMenu(pKey%) + Return TWindowsMenu(keymap.ValueForKey(TIntWrapper.Create(pKey))) + EndFunction + + Method SetText(pText$) + name = pText + EndMethod + + Method GetText$() + Return name + EndMethod + + Method Free() + Close + _setparent Null + keymap.Remove(TIntWrapper.Create(_key)) + If _iconBitmap Then DeleteObject(_iconBitmap) + EndMethod + + Method DoLayout() + 'Don't do anything! + EndMethod + + Method State() + Return _state + EndMethod + + Method SetEnabled(enable) + If enable + If _pmenu EnableMenuItem(_pmenu,_item,MF_BYPOSITION|MF_ENABLED) + _state:&~STATE_DISABLED + Else + If _pmenu EnableMenuItem(_pmenu,_item,MF_BYPOSITION|MF_GRAYED) + _state:|STATE_DISABLED + EndIf + EndMethod + + Method SetSelected(bool) + If bool + If _pmenu CheckMenuItem(_pmenu,_item,MF_BYPOSITION|MF_CHECKED) + _state:|STATE_SELECTED + Else + If _pmenu CheckMenuItem(_pmenu,_item,MF_BYPOSITION|MF_UNCHECKED) + _state:&~STATE_SELECTED + EndIf + EndMethod + + Method SetHotKey(keycode,modifier) + _hotkeycode=keycode + _modifier=modifier + + Local pre$, suf$, m$ + + If LocalizationMode()&LOCALIZATION_ON Then + pre="{{" + suf="}}" + EndIf + + If keycode>=KEY_0 And keycode<=KEY_9 + m$=Chr(keycode) + ElseIf keycode>=KEY_A And keycode<=KEY_Z + m$=Chr(keycode) + ElseIf keycode>=KEY_F1 And keycode<=KEY_F12 + m$="F"+(keycode+1-KEY_F1) + ElseIf keycode>=KEY_NUM0 And keycode<=KEY_NUM9 + m$="Num "+(keycode+1-KEY_NUM0) + Else + Select keycode + Case KEY_BACKSPACE;m = pre+"Backspace"+suf + Case KEY_TAB;m = pre+"Tab"+suf + Case KEY_ESCAPE;m = pre+"Esc"+suf + Case KEY_SPACE;m = pre+"Space"+suf + Case KEY_ENTER;m = pre+"Enter"+suf + Case KEY_PAGEUP;m = pre+"PageUp"+suf + Case KEY_PAGEDOWN;m = pre+"PageDown"+suf + Case KEY_END;m = pre+"End"+suf + Case KEY_HOME;m = pre+"Home"+suf + Case KEY_LEFT;m = pre+"Left"+suf + Case KEY_RIGHT;m = pre+"Right"+suf + Case KEY_UP;m = pre+"Up"+suf + Case KEY_DOWN;m = pre+"Down"+suf + Case KEY_INSERT;m = pre+"Insert"+suf + Case KEY_DELETE;m = pre+"Delete"+suf + Case KEY_TILDE;m = "~~" + Case KEY_MINUS;m = "-" + Case KEY_EQUALS;m = "=" + Case KEY_OPENBRACKET;m = "[" + Case KEY_CLOSEBRACKET;m = "]" + Case KEY_BACKSLASH;m = "\" + Case KEY_SEMICOLON;m = ";" + Case KEY_QUOTES;m = "'" + Case KEY_COMMA;m = "," + Case KEY_PERIOD;m = "." + Case KEY_SLASH;m = "/" + Case KEY_NUMMULTIPLY;m = "Num *" + Case KEY_NUMADD;m = "Num +" + Case KEY_NUMSUBTRACT;m = "Num -" + Case KEY_NUMDECIMAL;m = "Num ." + Case KEY_NUMDIVIDE;m = "Num /" + EndSelect + EndIf + + If m + If modifier&MODIFIER_SHIFT m$=pre+"Shift"+suf+"+"+m$ + If modifier&MODIFIER_CONTROL m$=pre+"Ctrl"+suf+"+"+m$ + If modifier&MODIFIER_ALT m$=pre+"Alt"+suf+"+"+m$ + m="~t"+m + EndIf + _shortcut$=LocalizeString(m) + + If Not iteminfo + iteminfo=New MENUITEMINFOW + iteminfo.cbSize=SizeOf(iteminfo) + EndIf + iteminfo.fMask=MIIM_TYPE + iteminfo.dwTypeData=(name+_shortcut).toWString() + SetMenuItemInfoW _pmenu,_item,True,iteminfo + + MemFree iteminfo.dwTypeData + + Local ev:TEvent=CreateEvent( EVENT_MENUACTION, Self,_tag ) + If _hotKey RemoveHotKey(_hotKey);_hotKey = Null + If keycode Then _hotkey=SetHotKeyEvent(keycode,modifier,ev,FindGadgetWindowHwnd(Self)) + EndMethod + + Method Create:TWindowsMenu(group:TGadget,tag,Text$="") + If Not iteminfo Then + iteminfo=New MENUITEMINFOW + iteminfo.cbSize=SizeOf(iteminfo) + EndIf + name=Text + _tag=tag + Local window:TWindowsWindow = TWindowsWindow(group) + If window group=window.GetMenu() + _SetParent(group) + If (LocalizationMode()&LOCALIZATION_OVERRIDE) Then + LocalizeGadget(Self, name, "") + EndIf + Return Self + EndMethod + + Method Open(popup=False) + + Local dad:TWindowsMenu = TWindowsMenu(parent) + + If dad + _pmenu=dad._hmenu + If Not _pmenu Throw "Parent doesn't have a handle - the desktop heap may have run out of memory!" + _item=GetMenuItemCount(_pmenu) + If name + Local tmpWString:Short Ptr = (LocalizeString(name)+_shortcut).ToWString() + AppendMenuW _pmenu,MF_STRING,_key,tmpWString + MemFree tmpWString + Else + AppendMenuW _pmenu,MF_SEPARATOR,_key,Null + EndIf + If kids.count() + _hmenu=CreateMenu_() + Local tmpMenuInfo:MENUINFO = New MENUINFO + + tmpMenuInfo.fMask = MIM_APPLYTOSUBMENUS|MIM_STYLE + tmpMenuInfo.dwStyle = MNS_CHECKORBMP|MNS_MODELESS + SetMenuInfo(_hmenu, tmpMenuInfo) + + iteminfo.fMask=MIIM_SUBMENU + iteminfo.hSubMenu=_hmenu + SetMenuItemInfoW _pmenu,_item,True,iteminfo + EndIf + + If _state&STATE_DISABLED SetEnabled(False) + If _state&STATE_SELECTED SetSelected(True) + + If _iconBitmap Then SetMenuItemBitmaps(_pMenu,_key,MF_BYCOMMAND,_iconBitmap,Null) + Else + If popup + _hmenu=CreatePopupMenu() + Else + If kids _hmenu=CreateMenu_() + EndIf + EndIf + + For Local kid:TWindowsMenu = EachIn kids + kid.Open + Next + + EndMethod + + Method FreeKids() + For Local kid:TWindowsMenu = EachIn kids + kid.Close + Next + EndMethod + + Method Close() + FreeKids() + If _hmenu + DestroyMenu _hmenu + _hmenu=0 + EndIf + EndMethod + + Method SetPixmap(pixmap:TPixmap,pFlags) + If Not (pFlags & GADGETPIXMAP_ICON) Then Return + If _iconBitmap Then DeleteObject(_iconBitmap);_iconBitmap = 0 + If pixmap Then + pixmap = PixmapWindow(pixmap,0,0,Min(GetSystemMetrics(SM_CXMENUCHECK),PixmapWidth(pixmap)),Min(GetSystemMetrics(SM_CYMENUCHECK),PixmapHeight(pixmap))) + If TWindowsGUIDriver.CheckCommonControlVersion() >= 2 Then + _iconBitmap = TWindowsGraphic.PreMultipliedBitmapFromPixmap32( pixmap ) + Else + Local tmpRGB = GetSysColor(COLOR_MENU) + _iconBitmap = TWindowsGraphic.BitmapWithBackgroundFromPixmap32( pixmap, tmpRGB&$FF, (tmpRGB Shr 8) & $FF, (tmpRGB Shr 16) & $FF ) + EndIf + EndIf + + EndMethod + + Method SetTooltip( pTooltip$ ) + 'Menus shouldn't have tool-tips. + EndMethod + + Method Class() + Return GADGET_MENUITEM + EndMethod + +EndType + +Type TWindowsIconStrip Extends TIconStrip + + Field _blanks[] + Field _imagelist + + Function DetectNotBlank(pixmap:TPixmap,xx,n) + Local c = pixmap.ReadPixel(xx,0), y + For Local x=0 Until n + For y=0 Until n + If pixmap.ReadPixel(xx+x,y)<>c Return True + Next + Next + EndFunction + + Method IsBlankIcon(n) + Return _blanks[n] + EndMethod + + Function RemoveMask(pixmap:TPixmap) + If pixmap.format<>( PF_RGBA8888 ) And pixmap.format<>( PF_BGRA8888 ) Return + Local w = pixmap.width, h = pixmap.height, y, c + For Local x=0 Until w + For y=0 Until h + c=pixmap.ReadPixel(x,y) + If c>=0 pixmap.WritePixel x,y,-1 + Next + Next + EndFunction + + Function BuildImageList(pixmap:TPixmap) + Local bitmap,imagelist,sz,mask + sz=pixmap.height + If TWindowsGUIDriver.CheckCommonControlVersion() And (Pixmap.format=PF_RGBA8888 Or pixmap.format=PF_BGRA8888) + imagelist=ImageList_Create(sz,sz,ILC_COLOR32,0,1) + If imagelist + bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, True) + ImageList_Add(imagelist,bitmap,0) + EndIf + EndIf + If imagelist=0 + bitmap=TWindowsGraphic.BitmapFromPixmap(pixmap, False) + mask=TWindowsGraphic.BitmapMaskFromPixmap(pixmap) + imagelist=ImageList_Create(sz,sz,ILC_COLOR24|ILC_MASK,0,1) + ImageList_Add(imagelist,bitmap,mask) + DeleteObject(mask) + EndIf + DeleteObject(bitmap) + Return imagelist + EndFunction + + Function Create:TWindowsIconStrip(source:Object) + Local icons:TWindowsIconStrip + Local imagelist + Local n,i,sz + Local blanks[] + + 'Get a 24-bit pixmap from source + Local pix:TPixmap = TPixmap(source) + If Not pix pix = LoadPixmap(source) + If Not pix Return + + 'Detect blank icons in the set + sz=pix.height;If sz n=pix.width/sz + If n=0 Return + blanks=New Int[n] + For i=0 Until n + blanks[i]=Not DetectNotBlank(pix,i*sz,sz) + Next + + 'Build a Win32 Image-List + imagelist=BuildImageList(pix) + icons = New TWindowsIconStrip + icons.pixmap = pix + icons.count=n + icons._blanks=blanks + icons._imagelist=imagelist + + Return icons + EndFunction + + Function CreateBlank:TWindowsIconStrip() + Return Create(CreatePixmap(1,1,PF_BGR888)) + EndFunction + + Method Delete() + If _imagelist Then + ImageList_Destroy(_imagelist) + _imagelist = 0 + EndIf + EndMethod + +EndType + +Type TWindowsFont Extends TGuiFont + + Method Load:TWindowsFont(_name$,_size:Double,_style) + + If handle Then DeleteObject handle;handle = 0 + + Local cfweight = FW_NORMAL + Local cfsize = -LogicalUnitsFromSize( _size ) + + If _style & FONT_BOLD cfweight=FW_BOLD + handle=CreateFontW( cfsize, 0,0,0,cfweight,.. + (_style & FONT_ITALIC) ,.. + (_style & FONT_UNDERLINE),.. + (_style & FONT_STRIKETHROUGH),.. + DEFAULT_CHARSET,.. + OUT_DEFAULT_PRECIS,.. + CLIP_DEFAULT_PRECIS,.. + ANTIALIASED_QUALITY,.. + DEFAULT_PITCH|FF_DONTCARE,.. + _name.toWString()) + + 'Now lets test to see whether the right font was found + + name = NameFromHandle(handle) + + 'If the font returned has a different name to that requested, let's try the symbol character set + + If name.ToLower() <> _name.ToLower() Then + Local tmpSymbolHandle = CreateFontW( cfsize, 0,0,0,cfweight,.. + (_style & FONT_ITALIC) ,.. + (_style & FONT_UNDERLINE),.. + (_style & FONT_STRIKETHROUGH),.. + SYMBOL_CHARSET,.. + OUT_DEFAULT_PRECIS,.. + CLIP_DEFAULT_PRECIS,.. + ANTIALIASED_QUALITY,.. + DEFAULT_PITCH|FF_DONTCARE,.. + _name.toWString()) + + Local strSymbolName:String = NameFromHandle(tmpSymbolHandle) + + 'If we now have a match, delete the first font returned and use the new symbol one. + + If strSymbolName.ToLower() = _name.ToLower() Then + DeleteObject handle + handle = tmpSymbolHandle + name = strSymbolName + Else + DeleteObject tmpSymbolHandle + EndIf + + EndIf + + size=_size + style=_style + + Return Self + + EndMethod + + Method LoadFromLogFont:TWindowsFont( pLogFont:LOGFONTW, pStyle% = 0, pSize:Double = 0:Double ) + + If pLogFont.lfWeight>=FW_BOLD Then pStyle:| FONT_BOLD + If pLogFont.lfItalic Then pStyle:| FONT_ITALIC + If pLogFont.lfUnderline Then pStyle:| FONT_UNDERLINE + If pLogFont.lfStrikeOut Then pStyle:| FONT_STRIKETHROUGH + + style = pStyle + + If Not pSize Then pSize = SizeFromLogFont( pLogFont ) + + size = pSize + + SetLogFontProperties( pLogFont, pStyle, pSize ) + + name = String.FromWString( Varptr pLogFont.lfFaceName00 ) + + If handle Then DeleteObject handle + handle = CreateFontIndirectW( pLogFont ) + + Return Self + + EndMethod + + Method LoadFromHandle:TWindowsFont(hfont) + + Local tmpLogFont:LOGFONTW = New LOGFONTW + GetObjectW( hfont, SizeOf(LOGFONTW), tmpLogFont ) + Return LoadFromLogFont( tmpLogFont ) + + EndMethod + + Method CharWidth( charcode ) + Local hdc=GetDC(0) + Local tfont=SelectObject( hdc,handle ) + + Local width=8,widths[3] + + If GetCharABCWidthsW( hdc,charcode,charcode,widths ) + width=widths[0]+widths[1]+widths[2] + Else If GetCharWidth32W( hdc,charcode,charcode,widths ) + width=widths[0] + EndIf + + SelectObject hdc,tfont + ReleaseDC 0,hdc + + Return width + EndMethod + + Method GetMaxCharWidth() + Local hdc=GetDC(0) + Local tfont=SelectObject(hdc,handle) + Local tm:TEXTMETRIC=New TEXTMETRIC + GetTextMetricsW hdc,tm + SelectObject(hdc,tfont) + ReleaseDC(0,hdc) + Return tm.tmAveCharWidth + EndMethod + + Method Delete() + If handle Then DeleteObject handle + EndMethod + + Function Request:TWindowsFont(font:TGuiFont) + + Local lf:LOGFONTW = New LOGFONTW + Local cf:CHOOSEFONT = New CHOOSEFONT + + cf.lStructSize=SizeOf(cf) + cf.hwndOwner=TWindowsGUIDriver.GetActiveHwnd() + cf.lpLogFont=lf + cf.Flags=CF_BOTH + + If font + Local p:Short Ptr = Short Ptr(Varptr lf.lfFaceName00) + For Local i = 0 Until Min(font.name.length, 31) + p[i]=font.name[i] + Next + SetLogFontProperties( lf, font.style, font.size ) + cf.Flags:|CF_INITTOLOGFONTSTRUCT + EndIf + + Local hwnd = GetFocus() + Local n = ChooseFontW(cf) + SetFocus(hwnd) + If Not n Return + + Local style + If cf.nFontType&BOLD_FONTTYPE style:|FONT_BOLD + If cf.nFontType&ITALIC_FONTTYPE style:|FONT_ITALIC + Return New TWindowsFont.LoadFromLogFont( lf, style, cf.iPointSize/Double(10) ) + + EndFunction + + Function DefaultFont:TWindowsFont( pFontSize:Double = 0, pFontStyle% = FONT_NORMAL ) + + 'Attempts to get hold of the Windows themed font (typically Tahoma on XP, Segeo UI on Vista) + Local tmpNonClientMetrics:NONCLIENTMETRICSW = New NONCLIENTMETRICSW + + If SystemParametersInfoW And SystemParametersInfoW( SPI_GETNONCLIENTMETRICS, 0, Int Byte Ptr tmpNonClientMetrics, 0 ) Then + Local tmpLogFont:LOGFONTW = New LOGFONTW + MemCopy tmpLogFont, Varptr tmpNonClientMetrics.lfMessageFont_lfHeight, SizeOf(tmpLogFont) + Return New TWindowsFont.LoadFromLogFont( tmpLogFont, pFontStyle, pFontSize ) + EndIf + + 'If these functions, for whatever reason, fail, then the default GUI font is used (typically MS Sans Serif). + 'Note: A font size of '8' has has been hard-coded in as no reliable substitute can be found, however this may cause + 'text to appear too small in some languages/lacalizations. + If pFontSize <= 0 Then pFontSize = 8 + Return New TWindowsFont.Load( "MS Shell Dlg", pFontSize, pFontStyle ) + + EndFunction + + Function NameFromHandle:String( pFntHandle:Int ) + + Local hdc = GetDC(0), buffer:Short[512] + Local tfont = SelectObject(hdc,pFntHandle) + + If Not GetTextFaceW(hdc,buffer.length,buffer) buffer[0] = 0 + + SelectObject(hdc, tfont) + ReleaseDC(0,hdc) + + Return String.FromWString(buffer) + + EndFunction + + Function LogicalUnitsFromSize( pSize:Double ) + + Local tmpDC:Int = GetDC(0) + Local tmpSize:Int = (pSize * GetDeviceCaps(tmpDC,LOGPIXELSY))/72 + 0.5 + ReleaseDC( 0, tmpDC ) + Return tmpSize + + EndFunction + + Function SizeFromLogFont:Double( pLogFont:LOGFONTW ) + + Local tmpDC:Int = GetDC(0) + Local tmpSize:Double = (Abs(pLogFont.lfHeight) * Double(72.0) )/GetDeviceCaps(tmpDC,LOGPIXELSY) + ReleaseDC( 0, tmpDC ) + Return tmpSize + + EndFunction + + Function SetLogFontProperties( pLogFont:LOGFONTW, pFlags%, pSize:Double = 0:Double ) + + If pFlags&FONT_BOLD Then pLogFont.lfWeight=FW_BOLD Else pLogFont.lfWeight=FW_NORMAL + If pFlags&FONT_ITALIC Then pLogFont.lfItalic=True Else pLogFont.lfItalic=False + If pFlags&FONT_UNDERLINE Then pLogFont.lfUnderline=True Else pLogFont.lfUnderline=False + If pFlags&FONT_STRIKETHROUGH Then pLogFont.lfStrikeOut=True Else pLogFont.lfStrikeOut=False + + If pSize > 0 Then pLogFont.lfHeight = -LogicalUnitsFromSize( pSize ) + + EndFunction + +EndType + +'A collection of functions that convert between Blitz pixmaps and Windows icons/bitmaps. +Type TWindowsGraphic Final + + Function BitmapMaskFromPixmap:Int(pix:TPixmap) + + Local x, pix2:TPixmap, usealpha + + If PixmapFormat(pix) = PF_RGBA8888 Or PixmapFormat(pix) = PF_BGRA8888 Then usealpha = True + + pix2=ConvertPixmap(pix,PF_BGR888);ClearPixels(pix2) + + For Local y:Int = 0 Until pix.height + For x = 0 Until pix.width + If usealpha + If (ReadPixel(pix,x,y) Shr 24) < 128 Then WritePixel(pix2,x,y,$FFFFFF) + Else + If (ReadPixel(pix,x,y) & $FFFFFF) = $FFFFFF Then WritePixel(pix2,x,y,$FFFFFF) + EndIf + Next + Next + + Return BitmapFromPixmap(pix2,False) + + EndFunction + + Function PreMultipliedBitmapFromPixmap32:Int( pix:TPixmap ) + + Local argb, a + Local pix2:TPixmap = CreatePixmap( pix.width, pix.height, pix.format), x + + For Local y:Int = 0 Until pix.height + For x = 0 Until pix.width + argb = ReadPixel(pix,x,y) + a = ((argb Shr 24) & $FF) + WritePixel(pix2,x,y,((((argb&$ff00ff)*a)Shr 8)&$ff00ff)|((((argb&$ff00)*a)Shr 8)&$ff00)|(a Shl 24)) + Next + Next + + Return BitmapFromPixmap(pix2,True) + + EndFunction + + Function BitmapFromPixmap:Int(pix:TPixmap, alpha:Int = True) + + Local bitCount:Int = 32, format:Int = PF_BGRA8888, bm + + If Not alpha Then + bitCount = 24 + format = PF_BGR888 + EndIf + + pix=ConvertPixmap(pix,format) + + Local hdc = GetDC(0) + + Local bi:BITMAPINFOHEADER = New BITMAPINFOHEADER + bi.biSize=SizeOf(bi) + bi.biWidth=pix.width + bi.biHeight=-pix.height + bi.biPlanes=1 + bi.biBitCount=bitCount + bi.biCompression=BI_RGB + + Local bits:Byte Ptr + Local src:Byte Ptr = pix.pixels + + If alpha + bm = CreateDibSection(hdc,bi,DIB_RGB_COLORS,Varptr bits,0,0) + Else + bm = CreateCompatibleBitmap(hdc,pix.width,pix.height) + EndIf + + Assert bm, "Cannot create bitmap. The computer may be running low on resources." + + For Local y:Int = 0 Until pix.height + SetDIBits(hdc,bm,pix.height-y-1,1,src,bi,DIB_RGB_COLORS) + src:+pix.pitch + Next + + ReleaseDC(0,hdc) + + Return bm + + EndFunction + + Function BitmapWithBackgroundFromPixmap32:Int( pix:TPixmap, pRed, pGreen, pBlue ) + + Local tmpPixel, tmpRed, tmpGreen, tmpBlue, tmpAlpha, tmpAlphaFloat#, tmpAlphaFloat2# + Local pix2:TPixmap = CreatePixmap( pix.width, pix.height, pix.format), x + + For Local y:Int = 0 Until pix.height + For x = 0 Until pix.width + + 'Read pixel and alpha info + tmpPixel = ReadPixel(pix,x,y) + tmpAlpha = ((tmpPixel Shr 24) & $FF) + tmpAlphaFloat = tmpAlpha/255.0 + tmpAlphaFloat2 = 1-tmpAlphaFloat + + 'Get individual colours + tmpBlue = tmpPixel & $FF;tmpGreen = (tmpPixel Shr 8) & $FF;tmpRed = (tmpPixel Shr 16)&$FF + + 'Courtesy of Mark T + tmpRed = (tmpRed * tmpAlphaFloat) + (tmpAlphaFloat2 * pRed) + tmpGreen = (tmpGreen * tmpAlphaFloat) + (tmpAlphaFloat2 * pGreen) + tmpBlue = (tmpBlue * tmpAlphaFloat) + (tmpAlphaFloat2 * pBlue) + + 'Write the new pixels + WritePixel(pix2,x,y,(tmpAlpha Shl 24)|(tmpRed Shl 16)|(tmpGreen Shl 8)|tmpBlue) + Next + Next + + Return BitmapFromPixmap(pix2,False) + + EndFunction + + Function IconFromPixmap32:Int(pix:TPixmap) + + ' Convert the pixmap to a HBITMAP + Local bitmap = BitmapFromPixmap(pix,True) + + ' and then copy/resize it (to the default size for icons/cusors). + Local hSrcBMP = CopyImage(bitmap, IMAGE_BITMAP , 0 , 0 , LR_DEFAULTSIZE) + + ' Now we need to create a mask bitmap for the image + Local hMaskBMP = BitmapMaskFromPixmap( pix ) + + ' So now we have our source and mask bitmaps, we can create an ICONINFO structure + Local IconInf:ICONINFO = New IconInfo + IconInf.fIcon = True + IconInf.hbmMask = hMaskBMP + IconInf.hbmColor = hSrcBMP + + ' Create the icon + Local tmpIcon = CreateIconIndirect(IconInf) + + ' Free our temporary bitmaps + DeleteObject(hMaskBMP) + DeleteObject(hSrcBMP) + DeleteObject(bitmap) + + Return tmpIcon + + EndFunction + +EndType + +Private + +Function KeyMods() + Local mods + If GetKeyState(VK_SHIFT)&$8000 mods:|MODIFIER_SHIFT + If GetKeyState(VK_CONTROL)&$8000 mods:|MODIFIER_CONTROL + If GetKeyState(VK_MENU)&$8000 mods:|MODIFIER_OPTION + If GetKeyState(VK_LWIN)&$8000 Or GetKeyState(VK_RWIN)&$8000 mods:|MODIFIER_SYSTEM + Return mods +EndFunction + +Function FindGadgetWindowHwnd(g:TGadget) + Local wg:TWindowsWindow + While g + wg=TWindowsWindow(g) + If wg Return wg.Query(QUERY_HWND) 'handle + g=g.parent + Wend +EndFunction + +Type TIntWrapper Final + Field value:Int + Function Create:TIntWrapper(value:Int) + Local tmpWrapper:TIntWrapper = New TIntWrapper + tmpWrapper.value = value + Return tmpWrapper + EndFunction + Method Compare( o:Object ) + Local c:TIntWrapper = TIntWrapper(o) + If c Then Return (value - c.value) + Return Super.Compare(o) + EndMethod + Method ToString$() + Return value + EndMethod +EndType diff --git a/mod/maxgui.mod/xpmanifest.mod/resources/compile.cmd b/mod/maxgui.mod/xpmanifest.mod/resources/compile.cmd index 6849ee8..2329c80 100644 --- a/mod/maxgui.mod/xpmanifest.mod/resources/compile.cmd +++ b/mod/maxgui.mod/xpmanifest.mod/resources/compile.cmd @@ -1,2 +1,2 @@ @echo off -windres -o ../xpmanifest.o resources.rc \ No newline at end of file +windres -o ../xpmanifest.o xp.rc diff --git a/mod/maxgui.mod/xpmanifest.mod/resources/resources.rc b/mod/maxgui.mod/xpmanifest.mod/resources/resources.rc deleted file mode 100644 index 78b2682..0000000 --- a/mod/maxgui.mod/xpmanifest.mod/resources/resources.rc +++ /dev/null @@ -1,4 +0,0 @@ -#define RT_MANIFEST 24 -#define MANIFEST_ID 1 - -MANIFEST_ID RT_MANIFEST "xp.manifest" diff --git a/mod/maxgui.mod/xpmanifest.mod/resources/xp.manifest b/mod/maxgui.mod/xpmanifest.mod/resources/xp.manifest index ae006b5..b0c91a3 100644 --- a/mod/maxgui.mod/xpmanifest.mod/resources/xp.manifest +++ b/mod/maxgui.mod/xpmanifest.mod/resources/xp.manifest @@ -1,12 +1,5 @@ - - - - - true - -