(* CRUF_FMS использует: UNIF_FMS *)
{$A+,B-,D-,E+,F-,G-,I+,L+,N-,O+,R+,S+,V+,X-}
{$M 16384,0,65536}
unit CRUF_FMS; INTERFACE
const TEMPO_DIR : String = ''; { Каталог временных файлов }
function Create_Unic_File(var Path : String) : integer;
function Crunf(var DFname : String) : boolean;
procedure SetNewChars;
procedure SetOldChars;
IMPLEMENTATION
Uses DOS, UNIF_FMS;
{ Create_Unic_File : Создает новый файл в каталоге TEMPO_DIR }
{ RES : = 0, если O'k; + = TEMPO_DIR+ Имя_файла }
function Create_Unic_File(var Path : String) : integer;
var Se,Off : word;
R : integer;
begin Path:=TEMPO_DIR+#0+Csps(12);
Se:=Seg(Path[1]);
Off:=Ofs(Path[1]);
Asm
mov r,0
mov ah,$5A
mov bx,ds
mov dx,off
mov ds,se
mov cx,0
int $21
jnc @cl
mov ds,bx
mov r,ax
jmp @con
@cl:mov ds,bx
mov bx,ax
mov ah,$3e
int $21
jnc @con
mov r,ax
@con: nop
end;
Create_Unic_File:=R;
while Path[ord(Path[0])] <> #0 do Dec(Path[0]);
Dec(Path[0])
end;
{ Crunf : }
{ DFname - каталог|полное-имя-файла,где|рядом должен находиться NewFile }
{ RES : = True, если O'k; + DFname = Path + Имя_файла }
function Crunf(var DFname : String) : boolean;
var D : DirStr;
N : NameStr;
E : ExtStr;
S : String;
begin Fsplit(DFname,D,N,E);
S:=TEMPO_DIR;
TEMPO_DIR:=D;
Crunf:=(Create_Unic_File(DFname) = 0);
TEMPO_DIR:=S end;
const en220223:array[1..14*4] of byte=
( 63, 31, 15, 7, 3, 1, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0,$01,$01,$03,$02,$06,$84,$CC,$68,$38,$10, 0, 0,
0, 0, 0, 0, 0,$08,$1C,$3E,$1C,$08, 0, 0, 0, 0,
255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0);
const vn220223:array[1..16*4] of byte=
(127, 63, 31, 15, 7, 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0,$01,$01,$03,$02,$06,$84,$CC,$68,$38,$10, 0, 0, 0,
0, 0, 0, 0, 0, 0,$08,$1C,$3E,$1C,$08, 0, 0, 0, 0, 0,
255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0);
const e220223:array[1..14*4] of byte=
( 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0);
const v220223:array[1..16*4] of byte=
( 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0);
var I,S,O : word;
Numb : byte;
procedure SetNewChars;
begin asm
mov ah,11h
mov al,30h
mov bh,0
int 10h
mov i,cx {'byte per char=',i,' screen rows=',numb}
mov numb,dl
end;
if (Numb = 49) or (I = 16) then begin {vga}
{saveoldfont}
asm {settextmode}
mov ah,0
mov al,3
end;
S:=Seg(vn220223);
O:=Ofs(vn220223);
asm {set vga font}
mov ah,11h
mov al,0 {10h}
mov es,s
mov bp,o
mov cx,4 {256}
mov dx,220 {0}
mov bl,0
mov bh,16
int 10h
end
end else begin {ega}
{saveoldfont}
asm {settextmode}
mov ah,0
mov al,3
end;
S:=Seg(en220223);
O:=Ofs(en220223);
asm {set ega font}
mov ah,11h
mov al,0 {10h}
mov es,s
mov bp,o
mov cx,4 {256}
mov dx,220 {0}
mov bl,0
mov bh,14
int 10h
end
end end;
procedure SetOldChars;
begin if (numb = 49) or (i = 16) then begin { vga }
S:=Seg(v220223);
O:=Ofs(v220223);
asm {set vga font}
mov ah,11h
mov al,0 { 10h }
mov es,s
mov bp,o
mov cx,4 { 256 }
mov dx,220 { 0 }
mov bl,0
mov bh,16
int 10h
end
end else begin { ega }
S:=Seg(e220223);
O:=Ofs(e220223);
asm {set ega font}
mov ah,11h
mov al,0 {10h}
mov es,s
mov bp,o
mov cx,4 {256}
mov dx,220 {0}
mov bl,0
mov bh,14
int 10h
end
end end;
end.
(****
CONST EEW : array [1..16] of String[16] =
('00000000', 0
'00000000', 0
'00000000', 0
'00000001', 1
'00000001', 1
'00000011', 3
'00000010', 2
'00000110', 6
'10000100', $84
'11001100', $CC
'01101000', $68
'00111000', $38
'00010000', $10
'00000000', 0
'00000000', 0
'00000000'); 0
CONST EEW : array [1..16] of String[16] =
('00000000',
'00000000',
'00000000',
'00001111',
'00001000',
'00001000',
'00001000',
'00001000',
'00001000',
'00001000',
'00001000',
'00001000',
'11111000',
'00000000',
'00000000',
'00000000');
CONST EEW : array [1..16] of String[16] =
('00000000',
'00000000',
'00000000',
'00000000',
'00000000',
'00000000',
'00001000',
'00011100',
'00111110',
'00011100',
'00001000',
'00000000',
'00000000',
'00000000',
'00000000',
'00000000');
procedure YYYY;
var I,J,R : integer;
A : array [1..16] of byte;
begin for I:=1 to 16 do begin
R:=0;
for J:=1 to 8 do
if EEW[I,J] = '1' then R:=R+R+1
else R:=R+R;
A[I]:=R
end;
Move(A,vn220223[33],16) end;
const en220223:array[1..14*4] of byte=
( 63, 31, 15, 7, 3, 1, 0, 0, 0, 0, 0, 0, 0, 0,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0);
const vn220223:array[1..16*4] of byte=
(127, 63, 31, 15, 7, 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0);
const e220223:array[1..14*4] of byte=
( 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0);
const v220223:array[1..16*4] of byte=
( 0, 0, 0, 0, 0, 0, 0, 0,255,255,255,255,255,255,255,255,
240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,240,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
255,255,255,255,255,255,255,255, 0, 0, 0, 0, 0, 0, 0, 0);
|