PCX für alle

Fragen zu Grafik- & Soundproblemen und zur Spieleprogrammierung haben hier ihren Platz.
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

PCX für alle

Beitrag von Xaby »

Hallo Fans,

hier mal etwas CODE:

Ist Pascal, am besten zu betrachten mit Proton

Code: Alles auswählen

procedure LoadPCX(x,y,trans:integer;name:string);
var
   pal:array[0..255,1..3] of byte;
type
        pcxheader=record
                man,ver,enc,bpp: byte;
                xl,yl,xh,yh,hres,vres: word;
                palette: array [0..47] of byte;
                rsr,cp: byte;
                bpl: word;
                ptype: word;
                filler: array [0..57] of byte;
        end;

var
        header: pcxheader;
        bytes: word;
        f: file;
  c:byte;
        cc: array[0..255] of byte;
        npal:array[0..255,1..3] of byte;
  count:byte;
  i,j,k:integer;
  z,zz:integer;
  width, height:integer;

begin
   Endung(Name,'PCX');
   If Exist(Pics+Name) then Name:=Pics+Name;
          assign(f,name);
        {$I-}
        reset(f,1);
        {$I+}
        if ioresult=0 then
        begin
                blockread(f,header,sizeof(header));
                if (header.man=10) and (header.ver=5) and (header.bpp=8) and (header.cp=1) then
                begin
                        seek (f,filesize(f)-769);
                        blockread (f,c,1);
                        if (c=12) then
                        begin
                                blockread (f,pal, 768);
                                for i:=0 to 255 do for j:=1 to 3 do pal[i,j]:=pal[i,j] shr 2;


                                seek (f, 128);
                                width:=header.xh-header.xl;
                                height:=header.yh-header.yl;
                                bytes:=header.bpl;
        count:=255;
                                for j:=0 to height do
                                begin
                                        i:=0;
                                        k:=0;
                                        while (k<bytes) do
                                        begin
            inc(count);
            if count=0 then blockread(f,cc,256);
                                                if ((cc[count] and 192)=192) then
                                                begin
                                                        z:=cc[count] and 63;
              inc(count);
              if count=0 then blockread(f,cc,256);
                                                        k:=k+z;
                                                        for zz:=0 to z-1 do
                                                        begin
        if cc[count]<>trans then putpixel(x+i,y+j,RealColor(cc[count]));
                                                                inc(i);
                                                        end;
                                                end else
                                                begin
                                                        inc(k);
        if cc[count]<>trans then putpixel(x+i,y+j,RealColor(cc[count]));
                                                        inc(i);
                                                end;
                                        end;
                                end;
                        end;
          end;
     close(f);
      IF SetPCXPal then
      BEGIN
      IF ((NOT VGAMode)or(F256)) then
      for i:=0 to 255 do setpal(i,pal[i,1],pal[i,2],pal[i,3]);
      END;
   end else ErrorInf('P',Name);
end;
Hier der englische Text dazu:

UNTER PCX
http://www.wotsit.org/search.asp?page=7&s=graphics
>> Graphics Files / unten Nummer 7 / PCX _ Download (8K)

Code: Alles auswählen

Since the overhead this technique requires is, on average,  25% of
the non-repeating data and is at least offset whenever bytes are repeated,
the file storage savings are usually considerable.

ZSoft .PCX FILE HEADER FORMAT

Byte      Item          Size   Description/Comments 
 0         Manufacturer 1      Constant Flag, 10 = ZSoft .pcx 
 1         Version      1      Version information 
                               0 = Version 2.5 of PC Paintbrush 
                               2 = Version 2.8 w/palette information 
                               3 = Version 2.8 w/o palette information 
                               4 = PC Paintbrush for Windows(Plus for
                                  Windows uses Ver 5) 
                               5 = Version 3.0 and > of PC Paintbrush
                                  and PC Paintbrush +, includes
                                  Publisher's Paintbrush . Includes
                                  24-bit .PCX files 
 2         Encoding      1     1 = .PCX run length encoding 
 3         BitsPerPixel  1     Number of bits to represent a pixel
                                  (per Plane) - 1, 2, 4, or 8 
 4         Window        8     Image Dimensions: Xmin,Ymin,Xmax,Ymax 
12         HDpi          2     Horizontal Resolution of image in DPI* 
14         VDpi          2     Vertical Resolution of image in DPI* 
16         Colormap     48     Color palette setting, see text 
64         Reserved      1     Should be set to 0. 
65         NPlanes       1     Number of color planes 
66         BytesPerLine  2     Number of bytes to allocate for a scanline
                                  plane.  MUST be an EVEN number.  Do NOT
                                  calculate from Xmax-Xmin. 
68         PaletteInfo   2     How to interpret palette- 1 = Color/BW,
                                  2 = Grayscale (ignored in PB IV/ IV +) 
70         HscreenSize   2     Horizontal screen size in pixels. New field
                                  found only in PB IV/IV Plus 
72         VscreenSize   2     Vertical screen size in pixels. New field
                                  found only in PB IV/IV Plus 
74         Filler       54     Blank to fill out 128 byte header.  Set all
                                  bytes to 0 
Soweit bin ich schon:

Code: Alles auswählen

CreateImage(0,640,480)

Procedure Refresh()
  StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0),40,40)
  StopDrawing()
EndProcedure

Procedure LoadPCX(Name.s)
  Dim pcxPAL.l(255)
  #Pcx=0
  If ReadFile(#Pcx, Name)
   *PCXheader = AllocateMemory(128)
   ReadData(#Pcx,*PCXheader,128)
   If PeekB(*PCXheader)=10
     Debug "ZSoft"
   EndIf
   If PeekB(*PCXheader+1)=5
     Debug "Version Nummer 5"
   EndIf
   If PeekB(*PCXheader+3)=8
     Debug "8 Bits per Pixel"
   EndIf
   If PeekB(*PCXheader+65)=1
     Debug "Number of Colorplanes = 1"
   EndIf
   
    
   
   
  
    CloseFile(#Pcx)
  Else
    Debug "Na sowatt, Datei fehlt wohl"
  EndIf
EndProcedure

OpenWindow(0,0,0,720,540,"PCX-Loader",#PB_Window_ScreenCentered |#PB_Window_SystemMenu)


LoadPCX("SpielBG0.PCX")


Repeat
  Event=WaitWindowEvent()
  Refresh()

Until Event=#PB_Event_CloseWindow

CloseWindow(0)
Wir sollten uns jedes Format auf der Welt Schritt für Schritt vornehmen und uns gegenseitig zu Weihnachten mit ein paar ImagePlugIns beschenken.

Vielleicht ist ja jemand schon fertig oder schneller, oder hat ein anderes Format im Petto, freue mich über euren Post.

Gruß, Folker und ein Frohes Fest :allright:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

Warum erstellste keine Structure, ähnlich dem Pascal Record "pcxheader"
Sollte das ganze lesbarer und einfacher machen
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Haste Recht, bin mir da aber was Records in PB angeht noch nicht ganz so sicher. Hab auch verblüfft gekuckt, dass ich einen Record in Pascal einfach aus einer Datei lesen kann.

Hab es zwar in der Hilfe gelesen, dass man da auch komplexe Datenformate sich selbst machen kann ...

Und ganz ehrlich find ich die Punkte in Pascal immer noch besser als die Schrägstriche in Pure :|

Aber darfst dich auch versuchen. Hab mich vom Fernsehen ablenken lassen. Ist also noch nicht weiter :roll:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

record=structure :wink:

Code: Alles auswählen

; type
;         pcxheader=record
;                 man,ver,enc,bpp: byte;
;                 xl,yl,xh,yh,hres,vres: word;
;                 palette: array [0..47] of byte;
;                 rsr,cp: byte;
;                 bpl: word;
;                 ptype: word;
;                 filler: array [0..57] of byte;
;         End; 

Structure pcxheader
  man.b
  ver.b
  enc.b
  bpp.b
  xl.w
  yl.w
  xh.w
  yh.w
  hres.w
  vres.w
  palette.b[47]
  rsr.b
  cp.b
  bpl.w
  ptype.w
  filler.b[57]
EndStructure
Mußte aber selber testen

Happy TV
Thomas

PS:
Mit Readdata, Adresse der Structurevariable und bei länge SizeOf
Geht also in PB ähnlich
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Hast du ne Ahnung, wieso PB manchmal Bytes aus Dateien als ShotInt ausliest?

Also über 128 negative Zahlen ausgibt?

Ist wohl nicht immer so, aber ab und an.

Naja. /:->
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
Leonhard
Beiträge: 602
Registriert: 01.03.2006 21:25

Beitrag von Leonhard »

Kannst du ein Beispiel senden?
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Code: Alles auswählen

Procedure LoadBMPPal()
#Pal=0
  If OpenFile(#Pal,"FFTecPAL.BMP")
    FileSeek(#Pal,54)
    *Palette = AllocateMemory(1024)
    Bis=ReadData(#Pal,*Palette,1024)
    For i=0 To Bis / 4 -1
      R=PeekB(*Palette+i*4+0)
      If R<0 : R=256+R : EndIf
      G=PeekB(*Palette+i*4+1)
      If G<0 : G=256+G : EndIf
      B=PeekB(*Palette+i*4+2)
      If B<0 : B=256+B : EndIf
      A=PeekB(*Palette+i*4+3)
      PAL(i)=RGB(B,G,R) 
    Next
    FreeMemory(*Palette)
  CloseFile(#Pal)
  EndIf
EndProcedure
Ohne die IF-Abfragen zwischendurch ... werden sie negativ.
Aber ist wohl auch von der Palette abhängig.

Eine Octree-Standard-Palette BMP kannst ja mal versuchen.

:allright:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

>> Also über 128 negative Zahlen ausgibt?
Alle Bytes in PB sind vorzeichenbehaftet, also -127 - 128
mit & $FF oder ähnlichem kann man sich da behelfen, bei nicht
Unicode-Anwendungen kann man auch Character statt Byte nehmen (0 - 255)
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Muss ich wohl bis PB Version 5.x warten, wenn es dann auch i als Type gibt :mrgreen:

Find es auch interessant, dass erst in Version 4 PB die gleichen Dinge was die Dateibehandlung angeht aufweist, die Pascal schon seit 20 Jahren hat.

Alte Sachen müssen ja nicht immer schlecht sein :?

Achja, phylosophieren könnten man ewig :allright:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
Leonhard
Beiträge: 602
Registriert: 01.03.2006 21:25

Beitrag von Leonhard »

Ich kann den Code leider nicht testen, da:

Code: Alles auswählen

PAL(i)=RGB(B,G,R) 
PAL(i)-Array wird nicht definiert.
Antworten