home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / gif / tpgif / example1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-10  |  4.8 KB  |  169 lines
  1. Program Example1;
  2.   {Simple program for Turbo Pascal version 5.0 showing the use of SCR2GIFU.PAS
  3.   unit for screen compression to GIF graphics file which includes the LZW
  4.   routines in CMPRSS.INC.  To use the unit, simply include SCR2GIFU in
  5.   your USES statement, then call 'ScreenToGif(FileName:String):Integer' when
  6.   you are ready to send the screen to a GIF file.  The following is a simple
  7.   program demonstrating the SCR2GIFU unit.  It demonstrates
  8.   automatic selection of a file name 'SCR0000.GIF' through 'SCR9999.GIF',
  9.   display of a test screen, and saving to a GIF file.  This program uses the
  10.   TP GRAPH.TPU graphics unit to automatically select a graphics mode.
  11.  
  12.   For details of the SCR2GIFU unit usage, see the header of the
  13.   SCR2GIFU.PAS file.
  14.  
  15.   Written by Rob Crockett [76167,1561] April 1992.  The include file
  16.   CMPRSS.INC written by Bob Berry [76555,167] 1988. }
  17.  
  18.  Uses CRT,
  19.       GRAPH,
  20.       SCR2GIFU;
  21.  
  22.  Function FileExists(FileName: String):Boolean;
  23.      Var
  24.        BinFile : File;
  25.      Begin
  26.        Assign(BinFile,FileName);
  27.        {$I-} Reset(BinFile); {$I+}
  28.        If IOResult=0
  29.          Then
  30.            Begin
  31.              Close(BinFile);
  32.              FileExists:=True;
  33.            End
  34.          Else FileExists:=False;
  35.      End; {of FileExists}
  36.  
  37.  Function GetGifFileName: String;
  38.    {Generates numbered GIF file names until a name is found that is
  39.     not in the current directory.  Named 'SCR0000.GIF' to 'SCR9999.GIF'.
  40.     Utilizes the 'FileExists' procedure.}
  41.  
  42.    Const
  43.      Preface = 'SCR';
  44.      Suffix = '.GIF';
  45.    Var
  46.      GifFileName,
  47.      FileNumberString: String;
  48.      FileNumber      : Integer;
  49.    Begin
  50.      FileNumber:=-1;
  51.      Repeat
  52.        FileNumber:=Succ(FileNumber);
  53.        Str(FileNumber,FileNumberString);
  54.        If (Length(FileNumberString)<4) then
  55.          Repeat
  56.            FileNumberString:='0'+FileNumberString;
  57.          Until (Length(FileNumberString)=4);
  58.        GifFileName:=Preface+FileNumberString+Suffix;
  59.      Until ((Not FileExists(GifFileName)) OR (FileNumber=9999));
  60.      GetGifFileName:=GifFileName;
  61.    End;
  62.  
  63.  
  64. Procedure DrawFigures;
  65.   {Draws a test graphics screen}
  66.  
  67.   Var
  68.     I,J,
  69.     XCenter,YCenter,
  70.     Width,Height      : Integer;
  71.     Radius            : Word;
  72.     XString,YString,
  73.     CString           : String[3];
  74.     InChar            : Char;
  75.   Begin
  76.     XCenter:=GetMaxX DIV 2;
  77.     YCenter:=GetMaxY DIV 2;
  78.     Radius:=GetMaxX DIV 6;
  79.     Height:=TextHeight('T');
  80.     Width:=TextWidth('000');
  81.  
  82.     PutPixel(XCenter,YCenter,LightMagenta);
  83.  
  84.     If GetMaxColor<=15
  85.       Then
  86.          For I:=0 to GetMaxColor do
  87.            Begin
  88.              SetColor(I);
  89.              Str(I,CString);
  90.              OutTextXY(10,10+I*Height,CString);
  91.            End
  92.        Else
  93.          For I:=0 to 22 do
  94.            For J:=0 to 11 do
  95.              Begin
  96.                SetColor(I+J*23);
  97.                Str(I+J*23,CString);
  98.                OutTextXY(10+J*Width,10+I*Height,CString);
  99.             End;
  100.  
  101.     SetColor(Blue);
  102.     Circle(XCenter,YCenter,Radius);
  103.  
  104.     SetColor(Blue);
  105.     Rectangle(0,0,GetMaxX,GetMaxY);
  106.     Rectangle(100,100,115,115);
  107.  
  108.     For I:=1 to 1000 do
  109.       Begin
  110.         PutPixel((GetMaxX div 2)+Random((GetMaxX div 2)-1),
  111.               Random(GetMaxY-1),1+Random(GetMaxColor));
  112.       End;
  113.  
  114.     For I:=1 to 500 do
  115.       Begin
  116.         SetColor(Random(GetMaxColor));
  117.         Line((GetMaxX div 6)*4,(GetMaxY div 4),
  118.           Random(GetMaxX div 2)+(GetMaxX div 2),
  119.           Random(GetMaxY div 3)+1);
  120.       End;
  121.   End;
  122.  
  123. Procedure StartTone;
  124.   Begin
  125.     Sound(1000);
  126.     Delay(50);
  127.     NoSound;
  128.   End;
  129.  
  130. Procedure OkTone;
  131.   Begin
  132.     Sound(900);
  133.     Delay(100);
  134.     Sound(1000);
  135.     Delay(100);
  136.     NoSound;
  137.   End;
  138.  
  139. Procedure NotOkTone;
  140.   Begin
  141.     Sound(50);
  142.     Delay(500);
  143.     NoSound;
  144.   End;
  145.  
  146.  
  147. {**********MAIN PROGRAM**************************************************}
  148.  
  149. Var
  150.   GifFileName: String;
  151.   GraphDriver,GraphMode,
  152.   GifCompressError: Integer;
  153. Begin
  154.   GraphDriver:=Detect;                         {automatic mode selection}
  155.   InitGraph(GraphDriver,GraphMode,'');         {open graphics, GRAPH.TPU...}
  156.                                                {..in current directory.}
  157.   DrawFigures;                                 {draw some graphics}
  158.   GifFileName:=GetGifFileName;                 {find name not already used}
  159.   SetColor(1);                                 {set color for graphics write}
  160.   OutTextXY(2,2,GifFileName);                  {write file name in corner}
  161.   StartTone;                                   {tone at start of save}
  162.   GifCompressError:=ScreenToGif(GifFileName);  {save screen to GIF file}
  163.   CloseGraph;                                  {close graphics and exit}
  164.   If GifCompressError=0                        {status tones}
  165.     Then OkTone
  166.     Else NotOkTone;
  167. End.
  168.  
  169.