home *** CD-ROM | disk | FTP | other *** search
/ PC Action 1997 October / PCA1097A.ISO / menue / postfach / 97100233.txt < prev    next >
Text File  |  1997-08-28  |  9KB  |  360 lines
  1. 0
  2. Grafik und Sound
  3. Black Baron
  4. Johnny Mnemonic
  5. Datum:   22.07.1997
  6. Betreff: lesen und schreiben eigener
  7.          Grafikformate (8/97)
  8. From:    Black Baron
  9. To:      Johnny Mnemonic
  10. ================================================
  11. Das Programm PCX ist zum lesen  von  PCX  Datein
  12. mit  16  Farben  und  einer  Größe  von  680x480
  13. Pixeln. Dieses Programm kann  die PCX Datein nur
  14. lesen nicht schreiben.
  15.  
  16. Program PCX;
  17. Uses Graph;
  18. Var B : Array [ 1 .. 480 , 1 .. 80 ] of Byte
  19.     absolute $A000 : $0000;
  20.     A , D , Q : Byte;
  21.     C , I , L , T , X , Y , Z : Longint;
  22.     G , H : Integer;
  23.     O : Array [ 1 .. 640 ] of Byte;
  24.     V : Array [ 1 .. 340 ] of Byte;
  25.  
  26. Procedure S ( N : Byte );
  27. Begin
  28.   Port [ 964 ] := 2;
  29.   Case N of
  30.     0 : Port [ 985 ] := 1;
  31.     1 : Port [ 985 ] := 2;
  32.     2 : Port [ 985 ] := 4;
  33.     3 : Port [ 985 ] := 8;
  34.     4 : Port [ 985 ] := 16;
  35.   End;
  36. End;
  37.  
  38. Var GD , GM : Integer;
  39.     DATEI : File;
  40.     DATEI_NAME : String;
  41. Begin
  42.   Write ( 'Dateiname: ' );
  43.   Readln ( DATEI_NAME );
  44.   Detectgraph ( GD , GM );
  45.   Initgraph ( GD , GM , 'C:\TP\BGI' );
  46.   Assign ( DATEI , DATEI_NAME );
  47.   Reset ( DATEI , 1 );
  48.   Seek ( DATEI , 16 );
  49.   Blockread ( DATEI , V , 54 );
  50.   If V [ 54 ] = 0 Then Begin;
  51.     Y := 1;
  52.     For H := 0 to 15 do Begin
  53.       Setpalette ( H , H );
  54.       Setrgbpalette ( H , V [ Y ] Div 4 ,
  55.                       V [ Y + 1 ] Div 4 ,
  56.                       V [ Y + 2 ] Div 4 );
  57.       Y := Y + 3;
  58.     End;
  59.   End;
  60.   L := 128;
  61.   For G := 1 to 480 do Begin
  62.     I := 1;
  63.     T := 1;
  64.     Seek ( DATEI , L );
  65.     X := Filesize ( DATEI );
  66.     If ( L + 640 ) > X Then C := X - L
  67.                        Else C := 640;
  68.     Blockread ( DATEI , O [ 1 ] , C );
  69.     Repeat
  70.       D := O [ T ];
  71.       T := T + 1;
  72.       L := L + 1;
  73.       If D and 192 = 192 Then Begin
  74.         A := D And 63;
  75.         D := O [ T ];
  76.         T := T + 1;
  77.         L := L + 1;
  78.         For Z := 1 to A do Begin
  79.           V [ I ] := D;
  80.           I := I + 1;
  81.         End;
  82.       End
  83.       Else Begin
  84.         V [ I ] := D;
  85.         I := I + 1;
  86.       End;
  87.     Until I = 321;
  88.     I := 1;
  89.     For Q := 0 to 3 do Begin
  90.       S ( Q );
  91.       For Y := 1 to 80 do Begin
  92.         B [ G , Y ] := V [ I ];
  93.         I := I + 1;
  94.       End;
  95.     End;
  96.   End;
  97.   Close ( DATEI );
  98.   S ( 4 );
  99.   Readln;
  100.   Closegraph;
  101. End.
  102.  
  103. Die folgenden 2 Proceduren dienen zum  lesen und
  104. schreiben von Ausschnitten. Da diese  Proceduren
  105. auf den Put/Getimage Proceduren beruhen   liegen
  106. die Beschränkungen in der Größe der  Ausschnitte
  107. im Wesen dieser Proceduren und in Größe des noch
  108. freien Heaps.
  109. Anmerkung: Der Vorteil dieser Routinen  ligt  in
  110. der Einfachheit und  darin, daß  sie  bei  allen
  111. (fast     allen)    Graphikmodi    funktioniern.
  112. Herkules, CGA, EGA, VGA oder SVGA, es  ist  egal
  113. Hauptsache man  hat  die  Graphikfunktionen  von
  114. Pascal mit Initgraph aktiviert.
  115.  
  116. Procedure SAVE_AUSSCHNIT ( X1 , Y1 , X2 , Y2 :
  117.                 Integer ; DATEI_NAME : String );
  118. Var SIZE , OK : Word;
  119.     DATEI : File;
  120.     PUFFER : Pointer;
  121. Begin
  122.   SIZE := Imagesize ( X1 , Y1 , X2 , Y2 );
  123.   Assign ( DATEI , DATEI_NAME );
  124.   Rewrite ( DATEI , 1 );
  125.   Getmem ( PUFFER , SIZE );
  126.   Getimage ( X1 , Y1 , X2 , Y2 , PUFFER^ );
  127.   {$I-}
  128.   Blockwrite ( DATEI , PUFFER^ , SIZE , OK );
  129.   {$I+}
  130.   If Ioresult <> 0 Then Exit;
  131.   Close ( DATEI );
  132.   Freemem ( PUFFER , SIZE );
  133. End;
  134.  
  135. Procedure LOAD_AUSSCHNIT ( X , Y : Integer ;
  136.                           DATEI_NAME : String );
  137. Var DATEI : File;
  138.     B , H : Integer;
  139.     PIC : Pointer;
  140.     SIZE : Word;
  141. Begin
  142.   Assign ( DATEI , DATEI_NAME );
  143.   {$I-}
  144.   Reset ( DATEI , 1 );
  145.   If Ioresult <> 0 Then Exit;
  146.   Blockread ( DATEI , B , 2 );
  147.   If Ioresult <> 0 Then Exit;
  148.   Blockread ( DATEI , H , 2 );
  149.   If Ioresult <> 0 Then Exit;
  150.   SIZE := Imagesize ( 0 , 0 , B , H );
  151.   Getmem ( PIC , SIZE );
  152.   Seek ( DATEI , 0 );
  153.   Blockread ( DATEI , PIC^ , SIZE );
  154.   {$I+}
  155.   If Ioresult <> 0 Then Exit;
  156.   Close ( DATEI );
  157.   Putimage( X , Y , PIC^ , NormalPut );
  158.   Freemem ( PIC , SIZE );
  159. End;
  160.  
  161. Die letzten 2 Routinen funktionieren bei einer
  162. Auflösung von 640x480 Pixeln und 256 Farben.
  163. Die Graphikfunktionen von TP müßen über
  164. Initgraph und die entsprechenden Treiber
  165. initialisiert worden sein. Es wird immer der
  166. ganze Bildschirm abgespeichert bzw. geladen,
  167. da das ganze unkomprimiert ist,  werden die
  168. Datein 307200 Byte groß.
  169. Die "Putpixel Aktionen" sind dazu da, auf die
  170. entsprechende Graphikplan umzuschalten, ohne
  171. dabei irgendwelchen Assamblercode zu verwenden.
  172. Übergeben wird immer der Dateiname und zurück
  173. kommt der Ioresult Fehlercode.
  174.  
  175. Uses Graph;
  176. Function LOADSCREEN_256 ( NAME : String ) : Intege
  177. Var DATEI : File;
  178.     DATEI_INHALT : Pointer;
  179.     PIXEL : Array [ 1 .. 5 ] of Byte;
  180.     F : Integer;
  181. Begin
  182.   Assign ( DATEI , NAME );
  183.   {$I-}
  184.   Reset ( DATEI , 1 );
  185.   F := Ioresult;
  186.   {$I+}
  187.   If F <> 0 Then Begin
  188.     LOADSCREEN_256 := F;
  189.      Exit;
  190.   End;
  191.   {$I-}
  192.   Blockread ( DATEI , PIXEL , 5 );
  193.   F := Ioresult;
  194.   {$I+}
  195.   If F <> 0 Then Begin
  196.     LOADSCREEN_256 := F;
  197.     Exit;
  198.   End;
  199.   DATEI_INHALT := Ptr ( $A000 , 1 );
  200.   Putpixel ( 0 , 0 , PIXEL [ 1 ] );
  201.   {$I-}
  202.   Blockread ( DATEI , DATEI_INHALT^ , 65535 );
  203.   F := Ioresult;
  204.   {$I+}
  205.   If F <> 0 Then Begin
  206.     LOADSCREEN_256 := F;
  207.     Exit;
  208.   End;
  209.   Putpixel ( 256 , 102 , PIXEL [ 2 ] );
  210.   {$I-}
  211.   Blockread ( DATEI , DATEI_INHALT^ , 65535 );
  212.   F := Ioresult;
  213.   {$I+}
  214.   If F <> 0 Then Begin
  215.     LOADSCREEN_256 := F;
  216.   Exit;
  217.   End;
  218.   Putpixel ( 512 , 204 , PIXEL [ 3 ] );
  219.   {$I-}
  220.   Blockread ( DATEI , DATEI_INHALT^ , 65535 );
  221.   F := Ioresult;
  222.   {$I+}
  223.   If F <> 0 Then Begin
  224.     LOADSCREEN_256 := F;
  225.     Exit;
  226.   End;
  227.   Putpixel ( 128 , 307 , PIXEL [ 4 ] );
  228.   {$I-}
  229.   Blockread ( DATEI , DATEI_INHALT^ , 65535 );
  230.   F := Ioresult;
  231.   {$I+}
  232.   If F <> 0 Then Begin
  233.     LOADSCREEN_256 := F;
  234.     Exit;
  235.   End;
  236.   Putpixel ( 384 , 409 , PIXEL [ 5 ] );
  237.   {$I-}
  238.   Blockread ( DATEI , DATEI_INHALT^ , 45056 );
  239.   F := Ioresult;
  240.   {$I+}
  241.   If F <> 0 Then Begin
  242.     LOADSCREEN_256 := F;
  243.     Exit;
  244.   End;
  245.   Close ( DATEI );
  246.   LOADSCREEN_256 := 0;
  247. End;
  248.  
  249. Function SAVESCREEN_256 ( NAME : String ) : Intege
  250. Var DATEI : File;
  251.     DATEI_INHALT : Pointer;
  252.     PIXEL : Array [ 1 .. 5 ] of Byte;
  253.     F : Integer;
  254. Begin
  255.   Assign ( DATEI , NAME );
  256.   {$I-}
  257.   Rewrite ( DATEI , 1 );
  258.   F := Ioresult;
  259.   {$I+}
  260.   If F <> 0 Then Begin
  261.     SAVESCREEN_256 := F;
  262.     Exit;
  263.   End;
  264.   {$I-}
  265.   Blockwrite ( DATEI , PIXEL , 5 );
  266.   F := Ioresult;
  267.   {$I+}
  268.   If F <> 0 Then Begin
  269.     SAVESCREEN_256 := F;
  270.     Exit;
  271.   End;
  272.   DATEI_INHALT := Ptr ( $A000 , 1 );
  273.   PIXEL [ 1 ] := Getpixel ( 0 , 0 );
  274.   {$I-}
  275.   Blockwrite ( DATEI , DATEI_INHALT^ , 65535 );
  276.   F := Ioresult;
  277.   {$I+}
  278.   If F <> 0 Then Begin
  279.     SAVESCREEN_256 := F;
  280.     Exit;
  281.   End;
  282.   PIXEL [ 2 ] := Getpixel ( 256 , 102 );
  283.   {$I-}
  284.   Blockwrite ( DATEI , DATEI_INHALT^ , 65535 );
  285.   F := Ioresult;
  286.   {$I+}
  287.   If F <> 0 Then Begin
  288.     SAVESCREEN_256 := F;
  289.     Exit;
  290.   End;
  291.   PIXEL [ 3 ] := Getpixel ( 512 , 204 );
  292.   {$I-}
  293.   Blockwrite ( DATEI , DATEI_INHALT^ , 65535 );
  294.   F := Ioresult;
  295.   {$I+}
  296.   If F <> 0 Then Begin
  297.     SAVESCREEN_256 := F;
  298.     Exit;
  299.   End;
  300.   PIXEL [ 4 ] := Getpixel ( 128 , 307 );
  301.   {$I-}
  302.   Blockwrite ( DATEI , DATEI_INHALT^ , 65535 );
  303.   F := Ioresult;
  304.   {$I+}
  305.   If F <> 0 Then Begin
  306.     SAVESCREEN_256 := F;
  307.     Exit;
  308.   End;
  309.   PIXEL [ 5 ] := Getpixel ( 384 , 409 );
  310.   {$I-}
  311.   Blockwrite ( DATEI , DATEI_INHALT^ , 45056 );
  312.   F := Ioresult;
  313.   {$I+}
  314.   If F <> 0 Then Begin
  315.     SAVESCREEN_256 := F;
  316.     Exit;
  317.   End;
  318.   {$I-}
  319.   Seek ( DATEI , 0 );
  320.   F := Ioresult;
  321.   {$I+}
  322.   If F <> 0 Then Begin
  323.     SAVESCREEN_256 := F;
  324.     Exit;
  325.   End;
  326.   {$I-}
  327.   Blockwrite ( DATEI , PIXEL , 5 );
  328.   F := Ioresult;
  329.   {$I+}
  330.   If F <> 0 Then Begin
  331.     SAVESCREEN_256 := F;
  332.     Exit;
  333.   End;
  334.   Close ( DATEI );
  335.   SAVESCREEN_256 := 0;
  336. End;
  337. Die  Routine ist für ein reines  Pascal  Progamm
  338. relativ   zügig,  könnte   aber   noch   dadurch
  339. beschleunigt   werden,  daß  die   Datein  durch
  340. Rewrite  bzw. Reset  nicht  mit  einer  Recsize-
  341. Größe von 1 sondern eben Größer geöffnet werden.
  342. (Der Begriff Recsize kommt aus der TP Hilfe.)
  343.  
  344. Ich hoffe Dir etwas weitergeholfen zu haben. Auf
  345. meiner  Festplatte  gibt es  noch  mehr  solcher
  346. Routinen  die  sich  mit  diesem Thema befassen,
  347. aber alle in diese Mail  zuschreiben  halte  ich
  348. für  sinnlos, da  ich  nicht  weiß  was Du genau
  349. brauchst.
  350. ================================================
  351.  BRBE 07-17-00000000-97
  352.   ║█▐│║▌█││▐║▌▐│ │▌▌║│║
  353.   ║█▐│║▌█││▐║▌▐│ │▌▌║│║
  354.  9║783443234║131723472║
  355.  
  356. Peace
  357. Black Baron
  358. .
  359. .
  360.