Seite 1 von 1

Hintergrundbild setzen für Window und Container

Verfasst: 15.07.2010 14:00
von mk-soft
Da schon öfters danach gefragt wurde...

Update v1.02

Code: Alles auswählen

;-TOP
; Kommentar     : Hintergrundbild setzen für Window und Container
; Author        : mk-soft
; Second Author : 
; Datei         : .pb
; Version       : 1.02
; Erstellt      : 15.07.2010
; Geändert      :
; 
; Compilermode  :
;
; ***************************************************************************************

Procedure SetWindowBkImage(Window, ImageID)
  Protected r1
  Protected WindowID
  Protected brush.LOGBRUSH
  
  WindowID = WindowID(Window)
  WindowID = WindowID(Gadget)
  If WindowID = 0
    ProcedureReturn #Null
  EndIf
  If ImageID = 0
    ProcedureReturn #Null
  EndIf
  With brush
    \lbStyle=#BS_PATTERN
    \lbColor=#DIB_RGB_COLORS
    \lbHatch=ImageID
  EndWith
  object = CreateBrushIndirect_(Brush)
  If object = 0
    ProcedureReturn #Null
  EndIf
  r1 = GetClassLong_(WindowID,#GCL_HBRBACKGROUND)
  If r1
    DeleteObject_(r1)
  EndIf
  r1 = SetClassLong_(WindowID,#GCL_HBRBACKGROUND, object)
  If r1 = #Null
    ProcedureReturn #Null
  EndIf
  r1 = InvalidateRect_(WindowID, #Null, #True)
  If r1
    ProcedureReturn object
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure

Procedure SetContainerBkImage(Gadget, ImageID)
  Protected r1
  Protected GadgetID
  Protected brush.LOGBRUSH
  Protected object
  
  If GadgetType(Gadget) <> #PB_GadgetType_Container
    ProcedureReturn #Null
  EndIf
  GadgetID = GadgetID(Gadget)
  If GadgetID = 0
    ProcedureReturn #Null
  EndIf
  If ImageID = 0
    ProcedureReturn #Null
  EndIf
  With brush
    \lbStyle=#BS_PATTERN
    \lbColor=#DIB_RGB_COLORS
    \lbHatch=ImageID
  EndWith
  object = CreateBrushIndirect_(Brush)
  If object = 0
    ProcedureReturn #Null
  EndIf
  r1 = GetClassLong_(GadgetID,#GCL_HBRBACKGROUND)
  If r1
    DeleteObject_(r1)
  EndIf
  r1 = SetClassLong_(GadgetID,#GCL_HBRBACKGROUND, object)
  If r1 = #Null
    ProcedureReturn #Null
  EndIf
  r1 = InvalidateRect_(GadgetID, #Null, #True)
  If r1
    ProcedureReturn object
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure

; ***************************************************************************************

; Test

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()

DateiName$ = OpenFileRequester("Bild", "", "", 0)

If OpenWindow(0,149,202,800,600, "...", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
  
  LoadImage(1,DateiName$,#PB_Image_DisplayFormat)
  ResizeImage(1, WindowWidth(0),WindowHeight(0))
  
  ContainerGadget(0, 0,0,800,300)
  SetContainerBkImage(0, ImageID(1))
  While WindowEvent() : Wend
  Delay(1000)
  SetContainerBkImage(0, ImageID(1))
  
  Repeat
    event = WaitWindowEvent()
  Until event = #PB_Event_CloseWindow
EndIf

FF :wink:

Re: Hintergrundbild setzen für Window und Container

Verfasst: 15.07.2010 14:06
von Shadow-Gamer
Danke für den Code. :allright:

Re: Hintergrundbild setzen für Window und Container

Verfasst: 15.07.2010 14:33
von mk-soft
Noch schnell ein kleine Update hinterher...

Fals öfters das Hintergrundbild geändert wird muss auch das alte Hintergrundbild (Object) gelöscht werden.