PureBasic

Code : Tout sélectionner

;
; Load PCX Image
;
Structure TPEPCXHEADER
  bytManufactor.b
  bytVersion.b
  bytEncoding.b
  bytBitsPerPixel.b
  intXMin.w
  intYMin.w
  intXMax.w
  intYMax.w
  intHDPI.w
  intVDPI.w
  bytColorMap.b[48]
  bytReserved.b
  bytNPlanes.b
  intBytesPerline.w
  intpalette_info.w
  bytFiller.b[58]
EndStructure
Structure TPEPALLETS
  bytColorR.a
  bytColorG.a
  bytColorB.a
EndStructure
;
Procedure.i LoadPCX(Filename.s) ; Charge une image au format PCX (numéro d'image renvoyé par la fonction, 0 si échec)
  Protected Stream
  Protected i.l
  Protected j.l
  Protected k.l
  Protected bdata.a
  Protected llenx.l
  Protected lleny.l
  Protected ltemp.l
  Protected lcount.l
  Protected lfllen.l
  Protected lOffset.l
  Protected Dim Raw.a(0)
  Protected Dim Pallets.TPEPALLETS(255)
  Protected header.TPEPCXHEADER, Image
  ;
  Stream = ReadFile(#PB_Any, Filename)
  If Stream
    lfllen = Lof(Stream)
    ReadData(Stream, header, SizeOf(header))
    k = lfllen - SizeOf(header) - 768
    If k <= 0
      CloseFile(Stream)
      ProcedureReturn #False
    EndIf
    Redim Raw(k)
    ReadData(Stream, Raw(), k)
    FileSeek(Stream, lfllen - 768)
    ReadData(Stream, Pallets(), 768)
    CloseFile(Stream)
    If ((header\bytManufactor = 10) Or (header\bytVersion = 5) Or (header\bytEncoding = 1) Or (header\bytNPlanes = 1) Or (header\bytBitsPerPixel = 8))
      llenx = header\intBytesPerline
      lleny = header\intYMax - header\intYMin + 1
      i = 0
      ltemp = lleny
      Image = CreateImage(#PB_Any, llenx, lleny)
      If Image
        If StartDrawing(ImageOutput(Image))
            While ltemp
              lOffset = 0
              ltemp - 1
              j = (lleny - ltemp) * llenx
              While (lOffset < llenx)
                bdata = Raw(i)
                i + 1
                If (bdata & 192) = 192
                  lcount  = bdata & 63
                  lOffset   + lcount
                  bdata     = Raw(i)
                  i + 1
                  While lcount
                    lcount - 1
                    Plot(j % llenx, (j / llenx) - 1, RGB(Pallets(bdata)\bytColorR, Pallets(bdata)\bytColorG, Pallets(bdata)\bytColorB))
                    j + 1
                  Wend
                Else
                  Plot(j % llenx, (j / llenx) - 1, RGB(Pallets(bdata)\bytColorR, Pallets(bdata)\bytColorG, Pallets(bdata)\bytColorB))
                  lOffset + 1
                  j + 1
                EndIf
              Wend
            Wend
          StopDrawing()
          ProcedureReturn Image
        EndIf
      EndIf
    EndIf
  EndIf
  ;
EndProcedure
;
Define hWnd.l, event.l, ImagePCX.i
hWnd = OpenWindow(0, 0, 0, 800, 600, "LoadPCX", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
If hWnd <> 0
  ImageGadget(0, 0, 0, 800, 600, 0)
  ImagePCX = LoadPCX(OpenFileRequester("Ouvrir un fichier PCX", "", "Archive pcx|*.pcx", 0))
  If ImagePCX
    SetGadgetState(0, ImageID(ImagePCX))
  EndIf
  Repeat
    event = WaitWindowEvent()
  Until event = #PB_Event_CloseWindow
EndIf