PCX für alle

[ts-soft]

@#NULL, stimmt , auch hier war ich zu Faul zum nachsehen

Bitte beachten Sie, dass sich in Strukturen ein statisches Array[] nicht so verhält wie das normale BASIC Array (definiert mittels Dim), um konform zum C/C++ Strukturen Format zu bleiben (was direkte API Strukturen Portierung ermöglicht). Dies bedeutet, dass a[2] ein Array von 0 bis 1 definiert, wogegen Dim a(2) ein Array von 0 bis 2 anlegt.

Zumal ich mir bei Pascal auch nicht so sicher war

Gruß
Thomas

[#NULL]

mit irfanView erstellte *.pcx kann ich hiermit lesen. andere hab ich nicht. ich weiß auch nicht wie das mit Palletten funktioniert. wenn ihr vielleicht mal testen könntet wäre gut. ist aber nur zur probe, können also fehler oder anderer mist entstehen. ich weiß auch nicht, wie man sowas normalerweise in den bildbuffer kriegt und hab hier einach Plot() genommen.

<edit>
jetzt müßte das auch mit 256er palletten funktionieren, die am datei-ende hängen. außerdem ist ein fehler behoben - bei bildern mit ungeradzahliger breite.

Code: Alles auswählen

Structure PCXinfoS
  ID.b
  Version.b
  Compression.b
  BitsPerPixel.b
  
  Xmin.w
  Ymin.w
  Xmax.w
  Ymax.w
  
  horDPI.w
  verDPI.w
  ColorMap.b[48]
  reserved.b
  Planes.b
  BytesPerLine.w
  PaletteInfo.w
  Width.w
  Height.w
  fillHeader.b[54]
EndStructure



Procedure.l loadPCX( file.s )
  Protected header.PCXinfoS
  Protected fileNr.l
  Protected imgNr.l
  Protected Dim p.l(1,1) ; to be redimensioned

  Protected w.l
  Protected h.l

  Protected b.b
  Protected count.b
  Protected val.b

  Protected i.l
  Protected k.l
  Protected plane.l
  Protected countBytes.l
  
  Protected Dim pal.l(255)
  Protected color.l
  
  fileNr = ReadFile(#PB_Any, file)
  If fileNr
    ReadData(fileNr,header,SizeOf(header))
    With header
      If (\ID = 10) And (\Version = 5) And (\Compression = 1) And (\BitsPerPixel = 8)
        w = \xMax-\xMin +1
        h = \yMax-\yMin +1
        FileSeek(fileNr, 128)
        Dim p.l(w-1,h-1)
        For k=0 To h-1
          For plane=0 To \planes-1
            For i=0 To w-1
              If count<1
                b.b = ReadByte(fileNr)
                If (b & %11000000) = %11000000
                  count = (b & %00111111)
                  val.b = ReadByte(fileNr)
                Else
                  count = 1
                  val.b = b
                EndIf
              EndIf
              p(i,k) | ( ($FF&val)<<(plane*8) )
              count-1
              countBytes+1
            Next
            While countBytes < (\BytesPerLine)
              ReadByte(fileNr)
              countBytes+1
            Wend
            countBytes=0
          Next
        Next
        
        
        If Not Eof(fileNr) And ReadByte(fileNr)=12 And \Planes=1
          For i=0 To 255
            color =  ($FF&ReadByte(fileNr))
            color | (($FF&ReadByte(fileNr))<<8)
            color | (($FF&ReadByte(fileNr))<<16)
            pal(i)= color
          Next
          For k=0 To h-1
            For i=0 To w-1
              color = p(i,k)
              p(i,k) = pal(color)
            Next
          Next
        EndIf
        
        ;##################### ARRAY TO IMAGE #####
        imgNr=CreateImage(#PB_Any, w,h)
        If IsImage(imgNr)
          StartDrawing( ImageOutput(imgNr) )
            For k=0 To h-1
              For i=0 To w-1
                Plot( i,k, p(i,k) )
              Next
            Next
          StopDrawing()
        EndIf
        ;##########################################
        
      EndIf
    EndWith
    CloseFile(fileNr)
  EndIf
  
  ProcedureReturn imgNr
EndProcedure

file.s = OpenFileRequester("select file", "E:\ProjectsPureBasic\PCX\", "*.pcx|*.pcx",0)

imgNr=loadPCX(file)
If Not imgNr
  MessageRequester("fehler", file+#CRLF$+"kann nicht geladen werden.")
  End
EndIf

OpenWindow(0, 50,50,ImageWidth(imgNr)+4,ImageHeight(imgNr)+4,"loadPCX")
CreateGadgetList(WindowID(0))
ImageGadget(1, 2,2, 0,0, ImageID(imgNr) )

Repeat
  event=WaitWindowEvent()
Until event=#PB_Event_CloseWindow