Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/MDI Window Background
Required plugins for this example: MBS Main Plugin, MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/MDI Window Background
This example is the version from Thu, 8th Feb 2017.
Project "MDI Window Background.rbp"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open() if TargetWin32 then background = new MDIBackground background.pic = LogoMBS(500) else MsgBox "This example is only for Windows!" end if End EventHandler
Property background As MDIBackground
End Class
Class Window1 Inherits Window
EventHandler Sub Open() Title = RBVersionString End EventHandler
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class MDIBackground Inherits WinNotificationMBS
ComputedProperty Pic As Picture
Sub Set() mPic = value ClearBitmap End Set
Sub Get() return mPic End Get
End ComputedProperty
Const GW_CHILD = 5
Const SRCCOPY = &h00CC0020
Const WM_ERASEBKGND = &h14
Const WM_PAINT = &h000F
EventHandler Sub GotNotification(Message as Integer, Name as string, Value1 as Integer, Value2 as Integer, byref Result as Integer, byref Handled as boolean) Select case Message case WM_ERASEBKGND dim DCHandle as integer = Value1 if DCHandle <> 0 then // must be valid Draw DCHandle // we draw something, so return success handled = true result = 1// success end if case WM_PAINT 'declare function GetDC Lib "User32.dll" ( hWnd as Integer) as integer 'declare function ReleaseDC Lib "User32.dll" (hWnd as Integer, HDC as Integer) as Int32 ' 'dim DCHandle as integer = GetDC(WindowHandle) 'System.DebugLog "DCHandle für Paint: "+str(DCHandle) 'if DCHandle <> 0 then // must be valid ' 'DrawPicture DCHandle ' '// we draw something, so return success 'handled = true 'result = 1 ' 'call ReleaseDC(WindowHandle, DCHandle) ' 'handled = true 'result = 0 // success ' 'end if end Select End EventHandler
Sub ClearBitmap() if hdcSrc <> nil then // unload bitmap from source context declare function SelectObject Lib "gdi32.dll" (hdc as Ptr, hgdiobj as Ptr) as Ptr call SelectObject(hdcSrc, hold) hdcSrc = nil hold = nil declare function DeleteObject Lib "gdi32.dll" ( hgdiobj as Ptr) as Int32 call DeleteObject(hdcSrc) hdcSrc = nil // free image call DeleteObject(hBitmap) hBitmap = nil end if End Sub
Sub Constructor() // get MDI window dim MDIWindowHandle as integer = app.MDIWindow.Handle // get child where we draw into declare function GetWindow lib "User32.dll" ( hWnd as integer, uCmd as UInt32) as integer WindowHandle = GetWindow(MDIWindowHandle, GW_CHILD) if WindowHandle = 0 then break // error else Super.Constructor(WindowHandle) call ListenForMessage(WM_ERASEBKGND) 'call ListenForMessage(WM_PAINT) end if End Sub
Sub Draw(DCHandle as Integer) dim r as Rect // query size of window declare function GetClientRect lib "User32.dll" (WindowHandle as Integer, byref r as Rect) as Int32 dim b as Integer = GetClientRect(WindowHandle, r) dim w as integer = r.right - r.left dim h as integer = r.bottom - r.top System.DebugLog "Window size: "+str(w)+" x "+str(h) // fill with color FillRect DCHandle, 0, 0, w, h, &cFF0000 // draw a picture DrawPicture DCHandle End Sub
Sub DrawPicture(DCHandle as Integer) if hdcSrc = nil then // create source context declare function CreateCompatibleDC Lib "gdi32.dll" (h as integer) as Ptr hdcSrc = CreateCompatibleDC(0) System.DebugLog "hdcSrc: "+str(hdcSrc) // load bitmap into source context declare function SelectObject Lib "gdi32.dll" (hdc as Ptr, hgdiobj as Ptr) as Ptr hBitmap = pic.CopyOSHandle(Picture.HandleType.WindowsBMP) hOld = SelectObject(hdcSrc, hBitmap) System.DebugLog "hBitmap: "+str(hBitmap) System.DebugLog "hOld: "+str(hOld) end if // draw into window Declare Function StretchBlt Lib "gdi32.dll" ( hdcDest As Integer, nXDest As Int32, nYDest As Int32, nDestWidth As Int32, _ nDestHeight As Int32, hdcSrc As Ptr, XSrc As Int32, YSrc As Int32, hSrcWidth As Int32, nSrcHeight As Int32, _ dwRop As UInt32) As Int32 System.DebugLog "DCHandle: "+str(DCHandle) System.DebugLog "hdcSrc: "+str(hdcSrc) dim rr as integer = StretchBlt(DCHandle, 0, 0, pic.Width, pic.Height, hdcSrc, 0, 0, pic.Width, pic.Height, SRCCOPY) System.DebugLog "StretchBlt: "+str(rr) End Sub
Sub FillRect(DCHandle as Integer, x as integer, y as integer, w as integer, h as integer, c as color) dim co as UInt32 = c.red + c.green * 256 + c.blue * 65536 declare function CreateSolidBrush lib "gdi32.dll" (c as UInt32) as ptr declare function FillRect lib "User32.dll" (hDC as Integer, byref r as Rect, Brush as Ptr) as int32 dim brush as ptr = CreateSolidBrush(co) System.DebugLog "brush: "+str(brush) dim r as rect r.left = x r.top = y r.right = x + w r.bottom = y + h dim re as integer = FillRect(DCHandle, r, brush) System.DebugLog "FillRect returns: "+str(re) declare function DeleteObject Lib "gdi32.dll" ( hgdiobj as Ptr) as Int32 call DeleteObject(brush) brush = nil End Sub
Property WindowHandle As Integer
Property Private hBitmap As Ptr
Property Private hOld As ptr
Property Private hdcSrc As Ptr
Property Private mPic As Picture
Structure RECT left as Integer top as Integer right as Integer bottom as integer End Structure
End Class
End Project

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Win Plugin.

MBS FileMaker Plugins