PureBasic Forums - English

Code: Select all

; 
; by Danilo, 22.04.2003 - german forum 
; 
Procedure LoadTransparentImage(Number,FileName$,TransColor,NewColor) 
  ;> 
  ;> Number     = ImageNumber 
  ;> FileName$  = File Name 
  ;> TransColor = RGB: Transparent Color,        -1 = First Color in Picture 
  ;> NewColor   = RGB: New Color for TransColor, -1 = System Window Background 
  ;> 
  Structure _LTI_BITMAPINFO 
    bmiHeader.BITMAPINFOHEADER 
    bmiColors.RGBQUAD[1] 
  EndStructure 

  Structure _LTI_LONG 
   l.l 
  EndStructure 

  hBmp = LoadImage(Number,FileName$) 
  If hBmp 
    hDC  = StartDrawing(ImageOutput()) 
    If hDC 
      ImageWidth  = ImageWidth() : ImageHeight = ImageHeight() 
      mem = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT,ImageWidth*ImageHeight*4) 
      If mem 
        bmi._LTI_BITMAPINFO 
        bmi\bmiHeader\biSize   = SizeOf(BITMAPINFOHEADER) 
        bmi\bmiheader\biWidth  = ImageWidth 
        bmi\bmiheader\biHeight = ImageHeight 
        bmi\bmiheader\biPlanes = 1 
        bmi\bmiheader\biBitCount = 32 
        bmi\bmiheader\biCompression = #BI_RGB 
        If GetDIBits_(hDC,hBmp,0,ImageHeight(),mem,bmi,#DIB_RGB_COLORS) <> 0 
          If TransColor = -1 
            *pixels._LTI_LONG = mem+((ImageHeight-1)*ImageWidth*4) 
            TransColor = *pixels\l 
          Else 
            TransColor = RGB(Blue(TransColor),Green(TransColor),Red(TransColor)) 
          EndIf 

          If NewColor = -1 
            NewColor = GetSysColor_(#COLOR_BTNFACE) ; #COLOR_WINDOW 
          EndIf 
          NewColor = RGB(Blue(NewColor),Green(NewColor),Red(NewColor)) 

          *pixels._LTI_LONG = mem 
          For a = 1 To ImageWidth*ImageHeight 
            If *pixels\l = TransColor 
              *pixels\l = NewColor 
            EndIf 
            *pixels + 4 
          Next a 

          If SetDIBits_(hDC,hBmp,0,ImageHeight(),mem,bmi,#DIB_RGB_COLORS) <> 0 
            Result = hBmp 
          EndIf 
        EndIf 
        GlobalFree_(mem) 
      EndIf 
    EndIf 
    StopDrawing() 
  EndIf 
  ProcedureReturn Result 
EndProcedure 

image1 = LoadTransparentImage(1,"d:\bilder\berthel.bmp",-1,-1) 
If image1 
  OpenWindow(0,0,0,ImageWidth(),ImageHeight(),#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Image") 
    CreateGadgetList(WindowID()) 
    ImageGadget(0,0,0,ImageWidth(),ImageHeight(),image1) 
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow 
Else 
  MessageRequester("ERROR","Cant load image!",#MB_ICONERROR) 
EndIf