Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Не загружается .BMP картинка (Pascal)

440
07 октября 2010 года
[FENIX]
83 / / 29.01.2007
Всем привет. Народ, подскажите пожалуйста кто может:
Это программа-лупа, т.е. пользователь наводит курсор (тут не курсор, а прямоугольник), и изображение как бы увеличивается.

Язык Pascal.

Программа *.bmp файл загружать не хочет, подскажите пожалуйста, что мне исправить:
Код:
uses
  Dos;

const
  VideoMem = $A000;

type
  TColor = packed record
    r, g, b: Byte;
  end;

  TPalette = array [0..255] of TColor;
  PPalette = ^TPalette;

  TImage = packed array [0..320*200-1] of Byte;
  PImage = ^TImage;

var
  Palette: TPalette;

procedure SetGrMode(AMode: Byte);
var
  Regs: Registers;
begin
  Regs.AH := $00;
  Regs.AL := AMode;

  Intr($10, Regs);
end;

procedure SetOneColor(AIndex: Integer; AColor: TColor);
begin
  Port[$3C8] := AIndex;
  Port[$3C9] := AColor.r shr 2;
  Port[$3C9] := AColor.g shr 2;
  Port[$3C9] := AColor.b shr 2;
end;

procedure SetGrdPal(const ANewPal: TPalette);
var
  I: Integer;
begin
  for I := 0 to 255 do
    SetOneColor(I, ANewPal);
end;

procedure ClearImage(AImage: PImage);
var
  I: Longint;
begin
  for I := 0 to 320*200 - 1 do
    AImage^ := 0;
end;

procedure CopyImage(AImage, ADestImage: PImage);
begin
  ADestImage^ := AImage^;
end;

procedure ShowImage(AImage: PImage);
var
  Screen: TImage absolute VideoMem:0000;
  I: Longint;
begin
  for I := 0 to 320*200 - 1 do
    Screen := AImage^;
end;

function LoadImage(AImage: PImage; APal: PPalette; AFileName: string): Boolean;
var
  F: file;
  W, H, L: LongInt;
  I: Byte;
  B: Byte;
  X, Y: Integer;
begin
  LoadImage := False;

  {$I-}
  Assign(F, AFileName);
  Reset(F, 1);
  {$I+}
  if IOResult <> 0 then
  begin
    WriteLn('IOResult <> 0');
    readln;
  end;

  Seek(F, $12);
  BlockRead(F, W, SizeOf(W));
  BlockRead(F, H, SizeOf(H));

  if (W <> 320) or (H <> 200) then
    Exit;

  Seek(F, $36); {gfdfg $3A}

  for I := 0 to 255 do
  begin
    BlockRead(F, B, SizeOf(B));
    APal^.R := B;
    BlockRead(F, B, SizeOf(B));
    APal^.G := B;
    BlockRead(F, B, SizeOf(B));
    APal^.B := B;
    BlockRead(F, B, SizeOf(B)); { Alpha }
  end;

  Seek(F, $436);

  {BlockRead(F, AImage^, SizeOf(AImage^));}
  for Y := H - 1 downto 0 do
    for X := 0 to W - 1 do
      BlockRead(F, AImage^[Y*320+X], 1);

  Close(F);
end;




function GetMouseX: Word;
var
  w: Word;
begin
  asm
    mov ah,0
    mov al,$3
    int $33
    mov w,cx
  end;
  GetMouseX := w;
end;

function GetMouseY: Word;
var
  w: Word;
begin
  asm
    mov ah,0
    mov al,$3
    int $33
    mov w,dx
  end;
  GetMouseY := w;
end;

procedure ShowMouseCursor;
begin
  asm
    mov ah,0;
    mov al,1;
    int $33;
  end;
end;

procedure HideMouseCursor;
begin
  asm
    mov ah,0;
    mov al,2;
    int $33;
  end;
end;

procedure SetMouseClip(x1, y1, x2, y2: Word);
begin
  asm
    mov ah,0
    mov al,$7
    mov cx,x1
    mov dx,x2
    int $33

    mov ah,0
    mov al,$8
    mov cx,y1
    mov dx,y2
    int $33
  end;
end;



var
  ZoomX, ZoomY, ZoomR, ZoomSR: Integer;

procedure Zoom(AImage: PImage; AResImage: PImage);
var
  X, Y, A: Integer;
begin
  for Y := - ZoomR div 2 to ZoomR div 2 do
    for X := - ZoomR div 2 to ZoomR div 2 do
    begin
      {A := 320*Y + X;
      AResImage^[A] := AImage^[A];}
      AResImage^[320*(ZoomY + Y) + ZoomX + X] :=
        AImage^[320*(ZoomY + Y div 2) + ZoomX + X div 2];
    end;
end;



var
  Image, BImage: PImage;
  I: Integer;
  Res: Boolean;
  Key: Char;
begin
  GetMem(Image, 64000);
  GetMem(BImage, 64000);

  Res := LoadImage(Image, @Palette, 'bm.bmp');

  SetGrMode($13);
  SetGrdPal(Palette);

  SetGrdPal(Palette);

  ZoomX := 160;
  ZoomY := 100;
  ZoomR := 50;
  ZoomSR := ZoomR div 2;

  SetMouseClip(1 + ZoomSR, 1 + ZoomSR, 320 - ZoomSR, 200 - ZoomSR);
  HideMouseCursor;

  while Port[$60] <> 1 do
  begin
    ZoomX := GetMouseX;
    ZoomY := GetMouseY;

    CopyImage(Image, BImage);
    Zoom(Image, BImage);
    ShowImage(BImage);
  end;

  SetGrMode(3);
  FreeMem(Image, 64000);
  FreeMem(BImage, 64000);
end.


Файл bm.bmp находится в той же папке, что и .PAS-файл.
Вот архив с исходником:http://narod.ru/disk/25760902000/%D0%9B%D1%83%D0%BF%D0%B0.rar.html
EXE-файл работает как надо, а запускаю PAS-файл на выполнение, и вылазиет ошибка ((.
440
10 октября 2010 года
[FENIX]
83 / / 29.01.2007
Всё, проблема решена, тему можно закрывать.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог