Error 100

[king999]

В чем ошибка??? Программа отдельно от меню работает а вместе не работает... Подскажите как исправить. Постояно выдает Error 100: Disk read error

Код: Выделить всё

uses Dos,crt;
const number_item=3;
      MaxBufLen = 65520;
var c:char;
    i:integer;
procedure out_menu(flag:integer);
var f_1,f_2,f_3:byte;
begin
f_1:=1;
f_2:=1;
f_3:=1;
if flag=1 then f_1:=16;
if flag=2 then f_2:=16;
if flag=3 then f_3:=16;

     textcolor(f_1);
     gotoxy(30,8);
     writeln('File');
     textcolor(f_2);
     gotoxy(30,10);
     writeln('EDIT');
     textcolor(f_3);
     gotoxy(30,12);
     writeln('HELP');
     textcolor(1);
     gotoxy(1,1);
     writeln('q-exit, d-down, u-up, e-enter');
end;

procedure file_;
type
 RGB = record
  Red,
  Green,
  Blue : Byte;
 end;

 PCXHeader = record
  Maker        : Byte;
  Version      : Byte;
  Code         : Byte;
  BitsPerPixel : Byte;
  XLow         : Word;
  YLow         : Word;
  XHigh        : Word;
  YHigh        : Word;
  Hres         : Word;
  Vres         : Word;
  Palette      : array [0..15] of RGB;
  VMode        : Byte;
  PlaneCount   : Byte;
  BytesPerLine : Word;
  Reserved     : array [0..59] of byte;
 end;

 BufType = array [1..MaxBufLen] of Byte;
 PtrToByte = ^Byte;

 Pallette = array [0..255] of RGB;
var
 name:string;
 PCXFile  : File;
 FileName : PathStr;
 Header   : PCXHeader;
 VGAPtr   : PtrToByte;
 Count    : Byte;
 Data     : Byte;
 i        : Byte;
 Regs     : Registers;
 PlaneNum : Byte;
 Bytes    : Word;
 Lines    : Word;
 Buf      : ^BufType;
 BufPtr   : Word;
 BufLen   : Word;
 Pal      : Pallette;
 VGAFile  : Boolean;

Function RGBColor(ColorNum : Byte) : Byte;
 begin
  RGBColor := (((Header.Palette[ColorNum].Red div 85) and 1) shl 5) +
              (((Header.Palette[ColorNum].Red div 85) and 2) shl 1) +
              (((Header.Palette[ColorNum].Green div 85) and 1) shl 4) +
              (((Header.Palette[ColorNum].Green div 85) and 2) shl 0)+
              (((Header.Palette[ColorNum].Blue div 85) and 1) shl 3)+
              (((Header.Palette[ColorNum].Blue div 85) and 2) shr 1);
 end;

BEGIN
Write('File name : ');
ReadLn(name);
name:=name+'.pcx';


 Assign(PCXFile,name);
 Reset(PCXFile, 1);

BlockRead(PCXFile, Header, SizeOf(PCXHeader));

 VGAFile := Header.BitsPerPixel = 8;        { …б«Ё 8 ЎЁв, в® 256 梥⮢.  }
                                            { ЌҐ *ЄбЁ®¬*, *® p*Ў®в*Ґв.    }
 if VGAFile then
  begin
   Seek(PCXFile, FileSize(PCXFile)-SizeOf(Pal)); { ‚ 256-梥в*®¬ д*©«Ґ    }
   BlockRead(PCXFile, Pal, SizeOf(pal));         { Ї*«Ёвp* ў б*¬®¬ Є®*жҐ. }
   Seek(PCXFile, SizeOf(header));
  end;

 New(Buf);
 BufLen := 0;
 BufPtr := 1;
 Lines  := 0;


 if VGAFile then
  asm                                        { „®бв*в®з*® ¬гв®p**п ¤«п    }
   lea si, pal                               { Ї*бЄ*«п Їp®жҐ¤гp* §*Јpг§ЄЁ }
   mov cx, 768                               { VGAи*®© Ї*«Ёвpл.           }
  @1:
   shr byte ptr [si], 1
   shr byte ptr [si], 1
   inc si
   loop @1

   mov ax, 0013h                             { 320x200x256colors          }
   int 10h

   mov ax, 1012h
   xor bx, bx
   mov cx, 256
   mov dx, seg pal
   mov es, dx
   mov dx, offset pal
   int 10h                                   { ўбо Ї*«Ёвpг - Јгp⮬.      }
  end
 else
  begin                                      { Ђ б EG®© в*Є *Ґ ᤥ«*вм.   }
   Regs.AX:=$0010;
   Intr($10, Regs);

   for i := 0 to 15 do
    begin
     Regs.AH := $10;
     Regs.AL := 0;
     Regs.BL := i;
     Regs.BH := RGBColor(i);
     Intr($10, Regs);
    end;

   { Write mode }
   Port[$3CE] := 5;                          { €*Ёв Ї®pв®ў ¤«п §*ЇЁбЁ.    }
   Port[$3CF] := 0;

   Bytes := 1;
   PlaneNum := 1;
   Port[$3C4] := 2;                          { Џ«** #1.                   }
   Port[$3C5] := 0;
  end;

 VGAPtr := Ptr($A000, $0000);

[king999]

Код: Выделить всё

repeat
  if BufPtr > BufLen then
   begin
    BlockRead(PCXFile, Buf^, MaxBufLen, BufLen);
    BufPtr := 1;
   end;

  Data := Buf^[BufPtr];
  Inc(BufPtr);

  if Data and $C0 = $C0 then                 { ђ*бЇ*Є®ўЄ* RLE-Є®¬ЇpҐббЁЁ. }
   begin
    Count := Data and $3F;
    if BufPtr > BufLen then
     BlockRead(PCXFile, Data, 1)
    else
     begin
      Data := Buf^[BufPtr];
      Inc(BufPtr);
     end;
   end
  else
   Count := 1;

  for i := 1 to Count do
   begin
    PtrToByte(Longint(VGAPtr) + Bytes - 1)^ := Data;
    Inc(Bytes);
    if Bytes > Header.BytesPerLine then
     begin
      Bytes := 1;
      if VGAFile then
       begin
        Inc(Longint(VGAPtr), Header.BytesPerLine); { VGA => Їp®б⮠㢥«Ё- }
        Inc(Lines);                                { зЁвм бзҐвзЁЄ.        }
       end
      else
       begin                                       { EGA => ЇҐpҐЄ«оз*вм   }
        if PlaneNum > 3 then                       { Ї«**л ®в 0 ¤® 3, *   }
         begin                                     { Ї®в®¬ - бзҐвзЁЄ.     }
          PlaneNum := 0;
          Inc(Longint(VGAPtr), Header.BytesPerLine);
          Inc(Lines);
         end;
        Inc(PlaneNum);
        Port[$3C4] := 2;                           { ‘®Ўб⢥**® ўлЎ®p     }
        Port[$3C5] := 1 shl (PlaneNum-1);          { Ї«***.               }
       end;
     end;
   end;
 until Lines > Header.YHigh;                       { Љ*¦Ёбм, ўбҐ.         }

 ReadKey;

 Dispose(Buf);
 Close(PCXFile);

 TextMode(3);
end;
procedure edit;
begin
window(20,10,70,20);
textbackground(5);
clrscr;
window(21,11,69,19);
textbackground(4);
clrscr;
writeln('Item EDIT');
writeln('Any key to EXIT to main menu');
repeat until keypressed;
window(1,1,80,25);
textbackground(6);
end;

procedure help;
begin
window(20,5,50,15);
textbackground(0);
clrscr;
window(17,4,47,13);
textbackground(3);
clrscr;
writeln('Item FILE');
writeln('Any key to EXIT to main menu');
repeat until keypressed;
window(1,1,80,25);
textbackground(6);
end;

begin
i:=1;
textbackground(6);
clrscr;
     repeat
           clrscr;
           if (i>number_item) or (i<1) then i:=1;
           out_menu(i);
           c:=readkey;
           if  c='d' then i:=i+1;
           if c='u' then i:=i-1;
           if c='e' then
              case i of
                   1:file_;
                   2:edit;
                   3:help;
              end;

     until c='q';
end.