[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{$Q-,R-}
{
 THIS PROGRAM IS COPYRIGHTED BY BOJAN LANDEKIC AND IS MADE AVAILABLE TO
 ALL PASCAL PROGRAMMERS WHO WANTED AN EASY WAY OF CREATING BITMAPS FOR USAGE
 IN THEIR PROGRAMS.  I DID THIS AS I WAS SICK AND TIRED OF USING THE PASCAL
 EDITOR FOR PUTTING IN THE 0's AND 1's :)..

 IF YOU FIND A WAY OF IMPROVING IT, PLEASE LET ME KNOW SO THAT I MAY MAKE THE
 NEXT VERSION.  PLEASE DO NOT RELEASE YOUR MODIFIED VERSION.

 THANK YOU

 THIS SHOULD BE INCLUDED IN SWAG WITHOUT THIS LINE  (BUT WITH ABOVE LINES!)
}

Program Convert_PCX;
{converts .PCX files to pascal loadable images}
Uses StrIO,
     ModeX,
     Pcx,
     Fade,
     Crt;

Var
   IncFile: Text;          {includable file}
   R,
   G,
   B,                    {pallete}
   Count   : Byte;       {for counting 80 chars}
   X,
   Y      : Word;        {picture}
   Piece  : String;   {part used from string}
   max_x,
   C,
   max_y  : Word;

Var
   xR,
   xB,
   xG     : Byte;

BEGIN
     If ParamCount = 0 Then
        Begin
             Writeln;
             Writeln('USAGE: C_PCX [FILENAME.PCX] [FILENAME.PAS] [X] [Y]');
             Writeln;
             Writeln('FILENAME.PCX - Contains the FULL path, filename and extensions of the PCX');
             Writeln('FILENAME.PAS - Is the name of the UNIT without the extension');
             Writeln('               Unit will be called FILENAME, and your things inside it');
             Writeln('               will be called PAL_FILENAME for Pallete, and IMG_FILENAME');
             Writeln('               will contain the image (see TEST_P.PAS)');
             Writeln('X            - Up to what X to convert');
             Writeln('Y            - Down to what Y to convert');
             Writeln;
             Writeln;
             Halt(1);
        End;

     Assign(incFile, ParamStr(2) + '.PAS');
     Rewrite(IncFile);
     Init_VGA;
     Show_PCX(ParamStr(1));
     Piece := ParamStr(2);
     Max_X := ATOI(ParamStr(3));
     Max_Y := ATOI(ParamStr(4));
     {saves the palette}
     Writeln(IncFile);
     Writeln(IncFile, 'UNIT ' + ParamStr(2) + ';');
     Writeln(IncFile);
     Writeln(IncFile);
     Writeln(IncFile, 'INTERFACE');
     Writeln(IncFile);
     Writeln(IncFIle, '{The palette data}');
     Writeln(IncFIle, 'CONST ', Piece, '_Pal : Array [0..255, 1..3] Of Byte = (');


     For X := 0 To 255 Do
         Begin
              GetCol(X, xR, xG, xB);
              If X = 255 Then
                 Begin
                      Write(Incfile, '(', xR, ',');
                      Write(Incfile, xG, ',');
                      Writeln(Incfile, xB, '));');
                 End
              Else
                  Begin
                       Write(Incfile, '(', xR, ',');
                       Write(Incfile, xG, ',');
                       Writeln(Incfile, xB, '),');
                  End;
              SetCol(X, xR, xG, xB);
         End;
     Writeln(IncFile);
     Writeln(IncFIle, '{The picture data}');
     Writeln(IncFile, 'CONST ', Piece, '_X = ', Max_X, ';');
     Writeln(IncFile, 'CONST ', Piece, '_Y = ', Max_Y, ';');
     Writeln(IncFIle, 'CONST ', Piece, '_Img : Array [0..', Max_X - 1, ', 0..', Max_Y - 1, '] Of Byte = (');
     {saves the picture}
     Count := 0;
     DirectVideo := False;
     TextColor(15);
     For Y := 0 To Max_Y - 1 Do
         Begin
              Write(IncFile, '(');
              For X := 0 To Max_X - 1 Do
                  Begin
                       Inc(Count);
                       C := GetPix(X, Y, View_Page);
{                       If (X = (Max_X - 1) DIV 2) Then
                          Writeln(IncFile, '');}
                       If (X = Max_X - 1) Then
                          Write(IncFIle, C)
                       Else
                           Write(IncFile, C, ',');
                       SetPix(X, Y, C - 15, View_Page);
                  End;
              If (Y = Max_Y - 1) AND (X = Max_X - 1) Then
                 Writeln(IncFile, ')')
              Else
                  Writeln(IncFile, '),');
         End;
     Writeln(IncFile, ');');
     Writeln(IncFile);
     Writeln(IncFile, 'IMPLEMENTATION');
     Writeln(IncFile);
     Writeln(IncFile, 'BEGIN');
     Writeln(IncFile, 'END.');
     Writeln(IncFile);
     Init_Text;
     Close(IncFile);
END.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]