Program ScreenLoad; const bufsize = 129; type filstr = string[14]; var Source : file; fildata : byte absolute $3F80; recsread : integer; colours : array[0..15] of byte; Procedure Load(filename : filstr); begin repeat Assign(source, filename); {$I-} reset(source); {$I+} while (IOresult<>0) do begin writeln('Could Not File File ',filename); write('Please Re-Enter: '); readln(filename); clrscr; Assign(source, filename); {$I-} reset(source); {$I+} end; until IOresult=0; repeat blockread(source,fildata,bufsize,recsread); until recsread = 0; close(source); end; Procedure Movedata; begin inline($11/$00/$C0/ $21/$00/$40/ $01/$FF/$3F/ $ED/$B0); end; Procedure Setcolour; begin inline($21/colours/ $3E/$00/ $4E/ $41/ $F5/ $E5/ $CD/$9B/$BE/ $32/$BC/ $E1/ $F1/ $23/ $3C/ $FE/$10/ $38/$EF); end; Procedure Mode(mo : byte); begin Inline($3A/mo/ $CD/$9B/$BE/ $0E/$BC); end; Procedure Pause; begin Inline($CD/$9B/$BE/ $18/$BB); end; Procedure ResetColour; begin Inline($CD/$9B/$BE/ $02/$BC); end; Procedure Setupinks(inkcol : byte); begin gotoxy(1,2); write('Enter the colour for Ink ',inkcol,':'); readln(colours[inkcol]); gotoxy(28,2); write(' '); while (colours[inkcol]<0) or (colours[inkcol]>26) do begin writeln; write('Please Re-enter inkcol (vaid colours between 0 & 26)',inkcol,':'); readln(colours[inkcol]); clrscr; end; end; Procedure Processdata; var mde, count : byte; filename2 : filstr; begin gotoxy(1,1); write('Enter Screen Mode (0 to 2):'); readln(mde); while (mde<0) or (mde>2) do begin write('Por favor, vuelva introduzca el Modo (las respuestas validas son 0,1 o 2):'); readln(mde); end; clrscr; gotoxy(1,1); writeln('Ahora puedes introducir los colores de Tinta para la pantalla'); if mde=0 then for count:=0 to 15 do setupinks(count); if mde=1 then for count:=0 to 3 do setupinks(count); if mde=2 then for count:=0 to 1 do setupinks(count); gotoxy(1,4); write('Por favor, introduzca el nombre del archivo:'); readln(filename2); mode(mde); setcolour; load(filename2); end; begin resetcolour; clrscr; Processdata; movedata; pause; resetcolour; write(chr(04)+'2'); end.