home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / INTRO93.ZIP / UBFVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-27  |  4KB  |  139 lines
  1. Uses Dos,TPCrt,TPString,UBFUnit,Graph320;
  2.  
  3. Var
  4.  FontX,FontY   : Byte;
  5.  CharNumber    : Word;
  6.  S             : String;
  7.  B             : Byte;
  8.  FontP         : Pointer;
  9.  PalBuffer1    : PalArray;
  10.  MemoryPicture : Array [0..3999] of Byte;
  11.  X,Y           : Word;
  12.  Ch            : Char;
  13.  Spacing       : Byte;
  14.  
  15.  (**************************************************************************)
  16.  
  17. Procedure Pal;     External; {$L FONTPAL.OBJ}   { 1K}
  18.  
  19.  (**************************************************************************)
  20.  
  21. {$F-}
  22. Procedure Get_Font (SIZE,Word1,Word2:Word;Byte1,A,B,FONTCHARS:Byte);
  23.  
  24.  VAR
  25.    TEMP     : Word;
  26. Begin
  27.                Asm
  28.                 PUSH DS
  29.                 PUSH ES
  30.                 PUSH BP
  31.                 PUSH DX
  32.                 PUSH BX
  33.                 PUSH AX
  34.                 MOV AX,Word1
  35.                 MOV DS,AX
  36.                 MOV SI,Word2
  37.                 MOV DI,320
  38.                 MOV TEMP,DI
  39.                 MOV AX,$A000
  40.                 MOV ES,AX
  41.                 MOV BH,FONTCHARS
  42.                 XOR CH,CH
  43. @LOOP4:         MOV AH,BYTE PTR Byte1
  44. @LOOP3:         MOV AL,LOW B
  45. @LOOP2:         MOV DX,DI
  46.                 MOV CL,LOW A
  47. @LOOP1:         MOVSB
  48.                 ADD DI,319
  49.                 LOOP @LOOP1
  50.                 MOV DI,DX
  51.                 INC DI
  52.                 DEC AL
  53.                 JNZ @LOOP2
  54.                 DEC BH
  55.                 JZ  @QUIT
  56.                 DEC AH
  57.                 JNZ @LOOP3
  58.                 MOV DI,TEMP
  59.                 ADD DI,SIZE
  60.                 MOV TEMP,DI
  61.                 JMP @LOOP4
  62. @QUIT:          POP AX
  63.                 POP BX
  64.                 POP DX
  65.                 POP BP
  66.                 POP ES
  67.                 POP DS
  68.                End;
  69. End;
  70. {$F+}
  71.  
  72.  (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  73.  
  74. Begin
  75.  Move (@Pal^,UBFPalette,768);
  76.  WriteLn (' Bonijoni''s Ultimate BitMap Format Viewer v1.0. 12-12-92. By: Bonijoni');
  77.  WriteLn ('   Fast .UBF Viewer. UBF Format Originally by Mr.Spock And Bonijoni');
  78.  WriteLn;
  79.  If ParamCount<1 then
  80.   Begin
  81.    WriteLn ('Usage: UBFVIEW.EXE [FILENAME.UBF]');
  82.    Halt;
  83.   End;
  84.  S:=ParamStr(1);
  85.  If JustExtension(S)='' then S:=ForceExtension(S,'UBF');
  86.  S:=StUpCase(S);
  87.  If MemAvail<65000 then
  88.   Begin
  89.    WriteLn (' ■ Not Enough Memory to Display Font');
  90.    WriteLn (' ■ Done UnSuccesfuly.');
  91.    Halt;
  92.   End;
  93.  GetMem(FontP,65000);
  94.  WriteLn (' ■ Opening FontFile ',S);
  95.  
  96.  B:=LoadUBF(S,FontP,FontX,FontY,CharNumber);
  97.  Case Chr(B) Of
  98.   #1 : Begin
  99.         WriteLn (' ■ UBF File Was Not Found!');
  100.         WriteLn (' ■ Done UnSuccesfuly.');
  101.         Halt;
  102.        End;
  103.   #2 : Begin
  104.         WriteLn (' ■ File Specified is Not UBF!');
  105.         WriteLn (' ■ Done UnSuccesfuly.');
  106.         Halt;
  107.        End;
  108.   #3 : Begin
  109.         WriteLn (' ■ UBF File has a General IO Error');
  110.         WriteLn (' ■ Done UnSuccesfuly.');
  111.         Halt;
  112.        End;
  113.   #4 : Begin
  114.         WriteLn (' ■ Loaded Okay With Pallete');
  115.        End;
  116.  End;
  117.  {Capture Screen}
  118.  Move (Mem[$B800:0000],MemoryPicture,4000);
  119.  For X:=0 to 767 do PalBuffer1[X]:=0;
  120.  X:=WhereX;
  121.  Y:=WhereY;
  122.  GotoMode ($13);
  123.  SetPal(PalBuffer1);
  124.  B:=CharNumber;
  125.  Get_Font ((FontY+1)*320,Seg(FontP^),Ofs(FontP^),(319 DIV FontX),FontY,FontX,B);
  126.  FadeInPal (UBFPalette,PalBuffer1);
  127.   Repeat
  128.    Repeat Until KeyPressed;
  129.     If KeyPressed then Ch:=ReadKey;
  130.   Until (Ch>=#27);
  131.  Ch:=#0;
  132.  ErasePal(PalBuffer1);
  133.  FadeInPal (PalBuffer1,UBFPalette);
  134.  GotoMode ($03);
  135.  GotoXY(X,Y);
  136.  Move (MemoryPicture,Mem[$B800:0000],4000);
  137.  WriteLn (' ■ Displayed Succesfully');
  138.  FreeMem(FontP,65000);
  139. End.