При обращении напрямую к видеопамяти, вывести изображение

{Данная программа преобразует монохромные изображения любого размера в битовую карту.}
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls;
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ProgressBar1: TProgressBar;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
  f:file of word;
  f2:file of byte;
  fr:TextFile;
  p,rp:longint;
  width,height:word;
  a:byte;
  bt,vs:array of byte;
  q:array[1..8] of byte;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
{$I+}
 
procedure TForm1.BitBtn1Click(Sender: TObject);
var i,j,kol:integer;
begin
if opendialog1.Execute then begin
 assignFile(f,opendialog1.Files[0]);
 reset(f);
 for i:=1 to 12 do begin read(f,height);
      if i=10 then width:=height;
       end;
  CloseFile(f);
 assignFile(f2,opendialog1.Files[0]);
 reset(f2); rp:=filesize(f2)-62; p:= rp div height; SetLength(bt, rp);
 for i:=1 to 62 do read(f2,a); Progressbar1.Position:=20;
 for i:=63 to rp do read(f2,bt[i-63]); CloseFile(f2); Progressbar1.Position:=40;
SetLength(vs, rp); kol:=0; Progressbar1.Position:=50; 
for i:=height - 1 downto 0 do
for j:=i*p to i*p+p-1 do begin
           vs[kol]:=bt[j];
           inc(kol);
           end;
SetLength(bt, rp*8); kol:=0; Progressbar1.Position:=70;
for i:=0 to length(vs) - 1 do begin
 for j:=1 to 8 do begin
     q[j]:=vs[i] mod 2;
     vs[i]:=vs[i] div 2;
     end;
 for j:=8 downto 1 do begin
     bt[kol]:= q[j];
     inc(kol);
     end;
     end;
     vs:=nil; Progressbar1.Position:=100;
 Form1.Text:=opendialog1.Files[0]; 
end;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var i,j:integer;
begin
if savedialog1.Execute then begin Progressbar1.Position:=0;
assignFile(fr,savedialog1.Files[0]); rewrite(fr); writeln(fr,width,' ',height);
 for i:=0 to height - 1 do begin  Progressbar1.Position:=10;
   for j:=0 to width - 1 do write(fr,bt[i*p*8+j]);
 writeln(fr);
 end;
 bt:=nil;   Progressbar1.Position:=90;
 CloseFile(fr); Progressbar1.Position:=100;
 Form1.Text:=savedialog1.Files[0];
 end;
end;
end.

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
{$G+,A+}
TYPE point = record
  koord: integer; {nachalo poligona}
  high: integer;  {kolichestvo strok}
  scale: integer; {shirina 1-oi stroki v pixel}
  naklon: integer;{estesstv naklon poligona sleva}
  naklon2:integer;{naklon poligona sprava}
  naklon3:integer;{estesstv naklon poligona sprava}
  end;
CONST points : array[1..10] of point=
  {----N-----}
  ((koord:6452;high:10;scale:16;naklon:0;naklon2:0;naklon3:0),
  (koord:76;high:42;scale:20;naklon:0;naklon2:0;naklon3:0),
  (koord:42;high:42;scale:20;naklon:0;naklon2:0;naklon3:0),
  {----E----}
  (koord:3324;high:22;scale:20;naklon:0;naklon2:0;naklon3:0),
  (koord:128;high:10;scale:52;naklon:0;naklon2:0;naklon3:0),
  (koord:10354;high:10;scale:52;naklon:0;naklon2:0;naklon3:0),
  (koord:5261;high:10;scale:22;naklon:0;naklon2:0;naklon3:0),
  {---N----}
  (koord:6644;high:10;scale:16;naklon:0;naklon2:0;naklon3:0),
  (koord:234;high:42;scale:20;naklon:0;naklon2:0;naklon3:0),
  (koord:268;high:42;scale:20;naklon:0;naklon2:0;naklon3:0));
 
  
  TestCount: word=10000;
var
  vidmode,scrpage: byte;
  minus: integer;
  time1, time2, time3, time4, time5, time6: word;
 
BEGIN
  asm
    mov ah,$f
    int 10h
    mov vidmode,al
    mov scrpage,bh
{--------------------------------------------------}
    mov ax,$13
    int 10h
    mov ax,$a000
    mov es,ax
 
    xor ah,ah    {timer}
    int 1ah
    mov time1,dx
    mov cx,TestCount
 
   @for_time:
   push cx
   lea si,points
   mov cx,10
   @new_pryam_polyg:
    mov ax,$f00f
    mov minus,0
    xor dx,dx
    xor bx,bx
    push cx
    mov di,[si]
    add si,2
    mov cx,[si]
    add si,2
 
    @new_line:
    push cx
    push bx
    push di
 
    mov cx,[si]
    //sub cx,minus
                 {dobavili 1 pixel esli nech addr}
    mov bx,di
    and bl,1
    jz @not_add_1pix_in_beg
    mov [es:di],ah
    inc di
    dec cx
    @not_add_1pix_in_beg:
                 {zalili po 2 pixel}
    shr cx,1
    rep stosw
                 {dobavili 1 pixel esli zalili ne vse}
    jnc @not_add_1pix_in_end
    mov [es:di],al
    @not_add_1pix_in_end:
 
    pop di
    add di,320
 
    mov bx,[si+6] {est naklon sprava}
    //add minus,bx
                         {kursivnii naklon}
    add dx,$7000
    sbb di,0
    pop bx
    add bx,[si+4]
    adc minus,0
 
    add di,[si+2]        {estesstvennii naklon sleva}
 
    not ax
    pop cx
    loop @new_line
    add si,8
    pop cx
   loop @new_pryam_polyg
    pop cx
    dec cx
   jnz @for_time
    xor ah,ah    {timer}
    int 1ah
    mov time2,dx
{------------------------------------------------------}
    mov ax,$13
    int 10h
    mov ax,$a000
    mov es,ax
 
    xor ah,ah    {timer}
    int 1ah
    mov time3,dx
    mov cx,TestCount
   @for_time2:
   push cx
   lea si,points
   mov cx,10
  @new_pryam_polyg2:
    db 66h
    mov ax,$f00f
    dw $f00f
    mov minus,0
    xor dx,dx
    xor bx,bx
    push cx
    mov di,[si]
    add si,2
    mov cx,[si]
    add si,2
 
   @new_line2:
    push cx
    push bx
    push di
 
    mov cx,[si]
    //sub cx,minus
                 {dobavili 1 pixel esli nech addr}
    mov bx,di
    shr bl,1
    jnc @not_add_1pix_in_beg2
    mov [es:di],ah
    inc di
    dec cx
    @not_add_1pix_in_beg2:
                {dobavili 2 pixel esli addr ne delitsya na 4}
    shr bl,1
    jnc @not_add_2pix_in_beg2
    stosw
    sub cx,2
    @not_add_2pix_in_beg2:
                {zalili po 4 pixel}
    push cx
    shr cx,2
    db 66h
    rep stosw
            {dobavili 2 pixel esli zalili ne vse}
    jnc @not_add_2pix_in_end2
    stosw
    @not_add_2pix_in_end2:
           {dobavili 1 pixel esli zalili ne vse}
    pop cx
    and cx,1
    rep stosb
 
    pop di
    add di,320
 
    mov bx,[si+6] {est naklon sprava}
    //add minus,bx
                         {kursivnii naklon}
    add dx,$7000
    sbb di,0
    pop bx
    add bx,[si+4]
    adc minus,0
 
    add di,[si+2]        {estesstvennii naklon sleva}
 
    db 66h
    not ax
    pop cx
   loop @new_line2
    add si,8
    pop cx
  loop @new_pryam_polyg2
    pop cx
    dec cx
   jnz @for_time2
    xor ah,ah    {timer}
    int 1ah
    mov time4,dx
 
    mov al,vidmode
    xor ah,ah
    int 10h
    mov ah,5
    mov al,scrpage
    int 10h
  end;
  if time2<time1 then time1:=65535-time1+time2
  else time1:=time2-time1;
  if time4<time3 then time3:=65535-time3+time4
  else time3:=time4-time3;
  if time6<time5 then time5:=65535-time5+time6
  else time5:=time6-time5;
  writeln('Results (fps):');
  writeln('1 and 2-bit universal zalivka     ',TestCount/(time1/18):10:0);
  writeln('1,2 and 4-bit universal zalivka   ',TestCount/(time3/18):10:0);
  
  readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.