PureBasic Forums - English

Code: Select all

;+-------------------------------------------+
;|                                                             |
;|  This example is just one way to set a         |
;|  custom background, it's probably the          |
;|  simplest here in PureBasic, to acheive         |
;|  the functionality you'd like without             |
;| the overhead of ImageGadgets and fighting  |
;| Z-Order, and putting Children windows         |
;| withing Children windows...                        |
;| Have fun with it...Justin Jack                     |
;|                                                             |
;+-------------------------------------------+


Enumeration
    #WM_SETBACKGROUNDIMAGE = #WM_APP + $01
EndEnumeration


Structure bkgrSTRUCT
    hOrigBkgrHandle.l
    hOldBkgrHandle.l
    hBkgr.l
EndStructure

Procedure WndProc( hWnd, uMsg, wParam, lParam )
    *myPtr = GetWindowLongPtr_(hWnd, #GWLP_USERDATA)
    If *myPtr > 0
        *imgInfo.bkgrSTRUCT = *myPtr
    EndIf
    Select uMsg
        Case #WM_CREATE
            *ptr = AllocateMemory(SizeOf(bkgrSTRUCT))
            SetWindowLongPtr_(hWnd, #GWLP_USERDATA, *ptr)
            *imgInfo.bkgrSTRUCT = *ptr
        Case #WM_SETBACKGROUNDIMAGE
            If lParam > 0
                hBkgr = GetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND)
                *imgInfo\hBkgr = CreatePatternBrush_(ImageID(lParam))
                SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, *imgInfo\hBkgr)
                InvalidateRect_(hWnd, 0, 1)
                If *imgInfo\hOrigBkgrHandle = 0
                    *imgInfo\hOrigBkgrHandle = hBkgr
                Else
                    DeleteObject_(hBkgr)
                EndIf
                ProcedureReturn *imgInfo\hBkgr
            Else
                ProcedureReturn 0
            EndIf
        Case #WM_DESTROY
            SetClassLongPtr_(hWnd, #GCL_HBRBACKGROUND, *imgInfo\hOrigBkgrHandle)
            DeleteObject_(*imgInfo\hBkgr)
    EndSelect
    ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure



Procedure Main()
    UseJPEGImageDecoder() ;Just to be safe...BitMaps will work too.
    imageFile.s = OpenFileRequester("Please Select an image to use as a background...", "*.BMP", "*.BMP", 1)

    If imageFile <> ""
        myImage = LoadImage(#PB_Any, imageFile, #PB_ImagePlugin_JPEG)
    EndIf
    

    SetWindowCallback(@WndProc())
    
    myWindow = OpenWindow(#PB_Any, 200, 200, 500, 500, "Test")
    hMainWindow = WindowID(myWindow)
    GetWindowRect_(hMainWindow, rc.RECT)
    
    ;- Resize our image to fit our window size
    If IsImage(myImage)
        ResizeImage(myImage, (rc\right-rc\left), (rc\bottom-rc\top))
    EndIf
    
    ;- Send our custom message to set the background as "myImage"
    If Not(SendMessage_(hMainWindow, #WM_SETBACKGROUNDIMAGE, 0, myImage))
        SetWindowTitle(myWindow, "Background Image Failed to Load.")
    Else
        SetWindowTitle(myWindow, "Background Image: " + imageFile)
    EndIf


    ; Regular PB Code...
    
    StringGadget(1,  10, 10, 150, 20, "")
    ButtonGadget(2, 180,  8,  75, 25, "Click Me!") 
    
    Repeat
        event = WaitWindowEvent()
        Select EventGadget()
            Case 2
                Select EventType()
                    Case #PB_EventType_LeftClick
                        myMsg.s = "You Typed: " + GetGadgetText(1) + #CRLF$
                        If IsImage(myImage)
                            myMsg.s + "Don't you like that background?"
                        EndIf
                        MessageBox_(hMainWindow, @myMsg.s, @"Please Note.", #MB_OK)
                EndSelect
        EndSelect
    Until event = #WM_CLOSE
    
    If IsImage(myImage)
        FreeImage(myImage)
    EndIf
    CloseWindow(myWindow)
EndProcedure

Main()