home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hráč 1997 February
/
Hrac_09_1997-02_cd.bin
/
UTILS
/
PROGRAM
/
1SVGA.ZIP
/
FONTS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-18
|
2KB
|
75 lines
{ Show all fonts XXYYnnn#.fnt }
uses Dos,SVGA256,Txt;
var FontFiles:array[0..2047] of string[12];
Max:integer;
{ ─────────────── GetFontFiles ─────────────── }
procedure GetFontFiles(Path:string);
var DirInfo:SearchRec;
St:string[12];
begin
Max:=0;
FindFirst(Path,Archive,DirInfo);
while DosError=0 do begin
St:=DirInfo.Name;
if (St[1]<='9') and (St[1]>='0') then
begin FontFiles[Max]:=St; Inc(Max); end;
FindNext(DirInfo);
end;
if Max=0 then begin Writeln('Fonts not found !'); Halt(1); end;
Dec(Max);
end;
{ ─────────────── ShowFonts ─────────────── }
procedure ShowFonts;
const C:array[1..2] of byte=(104,54);
var Buf:pointer;
I,K,P,X,X0,Y,Size,Count,Col,FontType:integer;
St,St2:string[12];
Font1:array[0..767] of byte;
begin
GetMem(Buf,20000);
Bar(0,0,320,8,C[2]); Bar(0,8,320,184,C[1]); Bar(0,192,320,8,C[2]);
FileRead('0808sim#.fnt',0,96,8,Font1);
InstallFont(2,8,8,32,96,8,Font1);
Print2(8,0,64,'Show all fonts');
Print2(8,192,64,'Cursors,PgUp,PgDn,Home,End-Select a font');
P:=0; Str(Max+1,St2); St2:='/'+St2;
repeat
St:=FontFiles[P];
if Pos('#',St)=0 then FontType:=1 else FontType:=2;
Val(Copy(St,1,2),X,I);
Val(Copy(St,3,2),Y,I);
X0:=X; if X=9 then X:=8; X:=(X+7) shr 3 shl 3;
Size:=X*Y shr 3; Count:=FileLen(St,Size); Col:=304 div X;
FileRead(St,0,Count,Size,Buf^);
InstallFont(2,8,8,32,96,8,Font1);
Bar(160,0,160,8,C[2]);
Print2(160,0,80,St); Str(P+1,St); Print2(264,0,92,St+St2);
Bar(0,8,320,184,C[1]);
InstallFont(1,X,Y,0,Count,X,Buf^);
for I:=0 to Count-1 do
Print(X*(I mod Col)+8,Y*(I div Col)+12,64+I mod 32,Chr(I));
if Count=96 then InstallFont(FontType,X,Y,32,Count,X0,Buf^)
else if Count=256 then InstallFont(FontType,X,Y,0,Count,X0,Buf^)
else InstallFont(FontType,X,Y,97,Count,X0,Buf^);
PrintColor(1,8,140, 64,1,'Pet Shop Boys/Very');
PrintColor(1,8,140+Y,80,1,'Can you forgive her?');
K:=Key;
case K of
$4800:Dec(P); $5000:Inc(P); { Up, Down }
$4900:Dec(P,5); $5100:Inc(P,5); { PgUp, PgDn }
$4700:P:=0; $4F00:P:=Max; { Home, End }
end;
if P<0 then P:=Max; if P>Max then P:=0;
until K=$011B;
FreeMem(Buf,20000);
end;
begin
GetFontFiles('*.fnt');
SetMode(1); ShowFonts;
SetMode(0);
end.