home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / anivga12 / exampl12.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-11  |  4KB  |  127 lines
  1. {$A+,B-,D+,L+,N-,E-,O-,R-,S-,V-,G-,F-,I-,X+}
  2. {$M 16384,0,655360}
  3. PROGRAM Example12;
  4. USES ANIVGA,CRT,DOS;
  5. CONST FirstLoadNumber=1;
  6.       FirstSpriteNumber=1;
  7.       FONTDIR='FONT\'; {Path and name of the font directory}
  8.       ch:CHAR=#0; {sets ch to that value everytime the program starts}
  9. VAR i,x,y,nr:INTEGER;
  10.     LastLoadNumber:BYTE;
  11.     DirInfo:SearchRec;
  12.     s,t:STRING;
  13.     PalName:PathStr;
  14.     tempPal:Palette;
  15.  
  16. PROCEDURE CheckFileErr(name:STRING);
  17. { in: Error = error value}
  18. {     name  = file to deal with}
  19. {out: If there was an error with the file, the program stops in a clean way}
  20. BEGIN
  21.  IF Error<>Err_None
  22.   THEN BEGIN
  23.         CloseRoutines;
  24.         WRITELN('Couldn''t access file '+name+' : '+GetErrorMessage);
  25.         halt(1)
  26.        END;
  27. END;
  28.  
  29. BEGIN
  30.  ClrScr;
  31.  WRITELN('Please wait while I''m loading the fonts '+FONTDIR+'*.FNT...');
  32.  WRITELN('Use I    to scroll the graphic screen; <ESC> to quit');
  33.  WRITELN('   J K');
  34.  WRITELN('    M');
  35.  LastLoadNumber:=FirstLoadNumber;
  36.  PalName:=''; {holds name of palette of (last) color font}
  37.  
  38.  FindFirst (FONTDIR+'*.FNT', Anyfile, DirInfo);
  39.  IF DosError<>0
  40.   THEN BEGIN
  41.         WRITELN('Error: Couldn''t locate the font directory '+FONTDIR);
  42.         Halt(1)
  43.        END;
  44.  WHILE(DosError = 0) do
  45.   BEGIN
  46.    WRITE(DirInfo.Name:20);
  47.    LoadFont(FONTDIR+DirInfo.Name); CheckFileErr(DirInfo.Name);
  48.    s:='Font '+DirInfo.Name;
  49.    IF FontType=TagMonoFont
  50.     THEN s:=s+' (mono, '
  51.     ELSE BEGIN
  52.           s:=s+' (color, ';
  53.           PalName:=FONTDIR+Copy(DirInfo.Name,1,POS('.',DirInfo.Name))+'PAL';
  54.           LoadPalette(PalName,0,tempPal); {get Palette}
  55.           CheckFileErr(PalName);
  56.          END;
  57.    IF FontProportion=TagProportional
  58.     THEN s:=s+'prop., ??x'
  59.     ELSE BEGIN
  60.           Str(FontWidth,t);
  61.           s:=s+'fixed, '+t+'x'
  62.          END;
  63.    Str(FontHeight,t);
  64.    s:=s+t+')';
  65. (* IF FontType=TagMonoFont THEN MakeTextSprite('!',LastLoadNumber) ELSE *)
  66.    MakeTextSprite(s,LastLoadNumber);
  67.    INC(LastLoadNumber);
  68.    FindNext (DirInfo);
  69.   END;
  70.  LoadFont(''); {switch back to internal font again}
  71.  MakeTextSprite('Font (internal) (mono, fixed, 6x6)',LastLoadNumber);
  72.  
  73.  InitGraph;
  74.  SetPalette(tempPal,TRUE);
  75.  SetAnimateWindow(16,4,XMAX-4,YMAX-40);
  76.  
  77.  GraphTextColor:=LightBlue; GraphTextBackground:=GraphTextColor;
  78.  BackgroundOutTextXY(5,WinYMAX+5,'Use I,J,K,M to scroll around, <ESC> quits!');
  79.  BackgroundOutTextXY(5,WinYMAX+5+14,'(Note that if there is more than one '+
  80.   'color font,');
  81.  BackgroundOutTextXY(5,WinYMAX+5+14+8,' only the last one''s color palette '+
  82.   'will be correct)');
  83.  GraphTextOrientation:=vertical;
  84.  BackgroundOutTextXY(0,0,'EXAMPL12.PAS');
  85.  GraphTextOrientation:=horizontal;
  86.  
  87.  Color:=66;
  88.  BackgroundLine(WinXMIN-1,WinYMIN-1,WinXMAX+1,WinYMIN-1);
  89.  BackgroundLine(WinXMAX+1,WinYMIN-1,WinXMAX+1,WinYMAX+1);
  90.  BackgroundLine(WinXMAX+1,WinYMAX+1,WinXMIN-1,WinYMAX+1);
  91.  BackgroundLine(WinXMIN-1,WinYMAX+1,WinXMIN-1,WinYMIN-1);
  92.  
  93.  BackgroundLine(0,WinYMAX+1,XMAX,WinYMAX+1);
  94.  BackgroundLine(0,YMAX,XMAX,YMAX);
  95.  BackgroundLine(0,WinYMAX+1,0,YMAX);
  96.  BackgroundLine(XMAX,WinYMAX+1,XMAX,YMAX);
  97.  
  98.  x:=WinXMIN+5;
  99.  y:=WinYMIN+5;
  100.  
  101.  FOR i:=FirstLoadNumber TO LastLoadNumber DO
  102.   BEGIN
  103.    nr:=FirstSpriteNumber+(i-FirstLoadNumber);
  104.    SpriteN[nr]:=i;
  105.    SpriteX[nr]:=x; SpriteY[nr]:=y;
  106.    INC(y,MaxFontHeight)
  107.   END;
  108.  
  109.  Animate;
  110.  REPEAT
  111.   if KeyPressed
  112.    THEN BEGIN
  113.          WHILE KeyPressed do ch:=UpCase(ReadKey);
  114.          CASE ch OF
  115.           'I','E':dec(StartVirtualY,10);  {change position of whole scene with}
  116.           'J','S':dec(StartVirtualX,10);  {E,S,D,X}
  117.           'K','D':inc(StartVirtualX,10);
  118.           'M','X':inc(StartVirtualY,10);
  119.          END;
  120.          IF POS(ch,'IJKMESDX')>0 THEN Animate;
  121.         END;
  122.  
  123.  UNTIL (ch='Q') OR (ch=#27);
  124.  
  125.  CloseRoutines;
  126. END.
  127.