Napisałeś ciekawy program, procedurę, funkcję podziel się z innymi

Zacznę pierwszy... Ekran wirtualny
Bardzo często zachodzi potrzeba utworzenia planszy większej niż jest w stanie wyświetlić ekran i płynnego poruszania się po niej w trybie 13h 320x200x256.
Jest to jedno z wyzwań które spędzają sen z oczu osobom które chcą napisać swoją pierwszą grę przygodową, w której ludzik porusza się po bardzo długiej planszy.
Często napotykanym problemem jest alokacja pamięci dla danych większych niż 64kb, a przecież nasza wirtualna plansza jest duzo duzo większa niż 64kb i aby
ją zapisać potrzebujemy dostać się naszej pamięci Extended czyli XMS, innymi słowy do naszych kości pamięci których mamy w dzisiejszych czasach około 1GB
Kilka funkcji modułu CoolXMS załatwia nam cały problem z dostępem do pamięci. Nie podejmę się opisu modułu bo jest to temat na conajmniej książkę,
wystarczy że go skompilujecie bez zagłębiania się w assembler. Dziecko nie musi znać budowy cząsteczkowej klocków żeby zbudować z nich domek albo autko : )

W skład mojego ekranu wirtualnego wchodzą dwa listingi Unit CoolXMS i program CoolTest.

Unit:


Unit CoolXMS;

Interface

Var XMSErrorCode : Byte;
XMSAddress : Pointer;

function XMSDriver : Boolean; {sprawdza czy jest zainstalowany himem.sys}
function XMSTotalMemory : Word; {zwraca calkowita ilosc dostepnej pamieci w kB}
function XMSLargestBlock : Word; {zwraca rozmiar najwiekszego bloku pamieci}
function XMSAllocate(Size: Word) : Word; {rezerwuje pamiec}
function XMSRelease(Handle : Word) : Boolean; {zwalnia pamiec }
function XMSMoveTo(Source : Pointer;Size : LongInt; {przenosi dane do pamieci}
Handle : Word;Offset : LongInt) : Boolean;
function XMSMoveFrom(Handle : Word;Offset : LongInt; {przenosi dane z pamieci}
Size : LongInt;Dest : Pointer) : Boolean;

Implementation

type
TMoveStruct = record
movelen : LongInt;
case Integer of
0: (SHandle : Word;
SPtr : pointer;
XMSHdl : Word;
XMSOffset : LongInt);
1: (XMSH : Word;
XMSOfs : LongInt;
DHandle : Word;
DPtr : pointer);
end;

var MoveParms : TMoveStruct;

function XMSDriver : Boolean;
const HimemSeg : Word = 0;
HimemOfs : Word = 0;
begin
XMSErrorCode:= 0;
asm
mov ax,4300h
int 2fh
cmp al,80h
jne @1
mov ax,4310h
int 2fh
mov himemofs,bx
mov himemseg,es
@1:
end;
XMSDriver:= (HimemSeg <> 0);
XMSAddress:= Ptr(himemseg,himemofs);
end;

function XMSTotalMemory : Word;
begin
XMSErrorCode := 0;
XMSTotalMemory:= 0;
if XMSAddress = nil then
if not XMSDriver then exit;
asm
mov ah,8
call XMSAddress
or ax,ax
jnz @1
mov XMSErrorCode,bl
xor dx,dx
@1:
mov @Result,dx
end;
end;

function XMSLargestBlock : Word;
begin
XMSErrorCode := 0;
XMSLargestBlock:= 0;
if XMSAddress = nil then
if not XMSDriver then exit;
asm
mov ah,8
call XMSAddress
or ax,ax
jnz @1
mov XMSErrorCode,bl
@1:
mov @Result,ax
end;
end;

function XMSAllocate(Size: Word): Word;
begin
XMSAllocate:= 0;
XMSErrorCode := 0;
if XMSAddress = nil then
if not XMSDriver then exit;
asm
mov ah,9
mov dx,Size
call XMSAddress
or ax,ax
jnz @1
mov XMSErrorCode,bl
xor dx,dx
@1:
mov @Result,dx
end;
end;

function XMSRelease(Handle: Word): Boolean;
var OK : Word;
begin
XMSErrorCode := 0;
XMSRelease:= false;
if XMSAddress = nil then
if not XMSDriver then exit;
asm
mov ah,0Ah
mov dx,Handle
call XMSAddress
or ax,ax
jnz @1
mov XMSErrorCode,bl
@1:
mov OK,ax
end;
XMSRelease:= (OK <> 0);
end;

function XMSMoveTo(Source : Pointer;Size : LongInt;Handle : Word;Offset : LongInt): Boolean;
var Status : Word;
begin
XMSErrorCode := 0;
XMSMoveTo := false;
if XMSAddress = nil then
if not XMSDriver then exit;
MoveParms.MoveLen := Size;
MoveParms.SHandle := 0;

MoveParms.SPtr := Source;
MoveParms.XMSHdl := Handle;
MoveParms.XMSOffset := Offset;
asm
mov ah,0Bh
mov si,offset MoveParms
call XMSAddress
mov Status,ax
or ax,ax
jnz @1
mov XMSErrorCode,bl
@1:
end;
XMSMoveTo := (Status <> 0);
end;

function XMSMoveFrom(Handle : Word;Offset : LongInt;Size : LongInt;Dest : Pointer) : Boolean;
var Status : Word;
begin
XMSErrorCode := 0;
XMSMoveFrom := false;
if XMSAddress = nil then
if not XMSDriver then exit;
MoveParms.MoveLen := Size;
MoveParms.XMSh:= Handle;
MoveParms.XMSOfs:= Offset;
MoveParms.DHandle:= 0;
MoveParms.DPtr:= Dest;
asm
mov ah,0Bh
mov si,offset MoveParms
call XMSAddress
mov Status,ax
or ax,ax
jnz @1
mov XMSErrorCode,bl
@1:
end;
XMSMoveFrom:= (Status<>0)
end;

Begin
XMSAddress:=nil;
XMSErrorCode:=0
End.

Przykładowy program wykorzystujący unit CoolXMS.

Aby prawidłowo działał utwórz plik bmp z swoją plansza o rozmiarze 1024x768 i 256 kolorach o nazwie "test.bmp" w katalogu w którym znajduje się program

Uses Crt,CoolXMS;
Var x,y,j : LongInt;
Handle : Word;
Ch : Char;

procedure LoadBMPToXMS;
var Palette : array [0..255,0..3] of Byte;
LineBuf : array [0..1023] of Byte;
i : LongInt;
f : file;
begin
Assign(f,'test.bmp');
Reset(f,1);
Seek(f,54);
BlockRead(f,Palette,SizeOf(Palette));
for i:=0 to 255 do
begin
port[$3c9]:= Palette[ i,2] div 4;
port[$3c9]:= Palette[ i,1] div 4;
port[$3c9]:= Palette[ i,0] div 4
end;
for i:=767 downto 0 do
begin
BlockRead(f,LineBuf,1024);
XMSMoveTo(@LineBuf,1024,Handle,i*1024);
end;
Close(f)
end;

Begin
Handle:=XMSAllocate(787);
asm
mov ax,13h
int 10h
end;
LoadBMPToXMS;
repeat
if KeyPressed then Ch:=ReadKey;
case Ch of
#72 : if y>0 then Dec(y);
#80 : if y<768-200 then Inc(y);
#75 : if x>0 then Dec(x);
#77 : if x<1024-320 then Inc(x);
end;
for j:=0 to 199 do
XMSMoveFrom(Handle,(y+j)*1024+x,320,Ptr($a000,j*320));
until Ch=#27;
XMSRelease(Handle);
End.

Co robi powyższy program?

1. Przy pomocy modulu CoolXMS, alokuje sobie pamiec potrzebna do zapamietania
bitmapy o rozmiarze 1024x768, czyli jakies 786432 bajtow co daje nam 787kB.
Jedna rzecz jest super, pamiec extended jest zorganizowana liniowo wiec
odpada nam problem z blokami po 64k kazdy i mozemy zapisywac dane ciurkiem
Uzywam do tego funkcji XMSAllocate.

2. Inicjuje tryb 320x200@256.

3. Odczytuje palete kolorow zawarta w pliku BMP i ustawiam wedlug niej karte.

4. Odczytuje bitmape linia po lini (liniami dlugosci 1024) i wpisuje kolejno
do pamieci XMS przy pomocy funkcji XMSMoveTo.

5. No i juz koniec. Mamy bitmape w pamieci. Teraz wystarczy za pomoca funkcji
XMSMoveFrom odczytywac z pamieci linie po 320 pikseli i wyswietlać je na
ekranie.

pozdrawiam Stefan Pruszkiewicz