Aby zachować fragment ekranu graficznego w napisanym przez siebie programie pascalowym, najlepiej posłużyć się stosunkowo szybką procedurą ekranową GetImage, która wskazany obszar zapamięta na stosie lub w tablicy. Co jednak zrobić, jeśli chcemy zapamiętaną w ten sposób ilustracją posłużyć się w przyszłości lub jeśli ilustracji jest tak dużo, że nie starcza dostępnej pamięci? Odpowiedź jest prosta - należy je zapamiętać na dysku.
Zachowanie, a następnie odtworzenie ich powinno być na tyle szybkie, aby czas, w którym to następuje nie był uciążliwie zauważalny. Najprostszym rozwiązaniem tego problemu okazało się znowu wykorzystanie GetImage oraz PutImage. Zamiast jednak zapamiętywać dane na stosie, trzeba je umieścić na dysku przy użyciu również stosunkowo szybkiej procedury dyskowej BlockWrite. Tak zapamiętaną ilustrację można odczytać z dysku za pomocą analogicznych procedur służących do czytania bloku z dysku - BlockRead i wyświetlających ten blok na ekranie - PutImage.
W przedstawionym module SaveWin znajdują się procedury zapisujące fragment ekranu z nadaniem mu nazwy :get_screen_n, który można również odczytać, podając odpowiednią nazwę :put_screen_n lub put_screen_xy_n. Występują też i te procedury, które podania nazwy nie potrzebują: get_screen - ten rodzaj ilustracji wyświetlić można przy wykorzystaniu put_image lub put_image_xy. Ilustracje, którym nie nadajemy nazwy, mogą służyć do chwilowego zapamiętania ekranu lub jego fragmentu (np. podczas przysłaniania elementów na ekranie - ja użyłem tego do realizacji wielopoziomowego menu). Są one odtwarzane w kolejności odwrotnej niż ta, w jakiej zostały zapamiętane (typowa struktura stosu), a plik przechowujący ten obraz znika z dysku.
Szczegółowy opis poszczególnych procedur i zmiennych zawiera źródło modułu SaveWin, a sposób zastosowania przedstawia przykładowy program Test_Sav.
Listing - SaveWin
{ Moduł SAVEWIN zawiera:
- procedurę zapamiętującą wybrany fragment ekranu:
get_screen(x1, y1, x2, y2 : integer) ,
- procedurę zapamiętującą wybrany fragment ekranu pod
określoną nazwą:
get_screen_n(x1,y1,x2,y2 : integer ; name : string)
- procedurę wyświetlającą zapamiętany fragment w
oryginalnym miejscu: put_screen ,
- procedurę wyświetlającą zapamiętany fragment w
dowolnym miejscu: put_screen_xy(x, y : integer),
- procedurę wyświetlającą zapamiętany fragment o
określonej nazwie w oryginalnym miejscu:
put_screen_n(name : string) ,
- procedurę wyświetlającą zapamiętany fragment o
określonej nazwie w oryginalnym miejscu:
put_screen_xy_n(x, y : integer ; name : string)
}
unit savewin;
{graph wymagany ze względu na używanie}
{procedur graficznych getimage, putimage itd.}
interface uses graph;
{numer otwartego okna używany}
{do nadawania nazwy plikowi z ekranem}
var screen_nr : integer;
procedure get_screen(x1,y1,x2,y2: integer);
procedure get_screen_n(x1,y1,x2,y2: integer;
name: string);
procedure put_screen;
procedure put_screen_n(name: string);
procedure put_screen_xy(x,y: integer);
procedure put_screen_xy_n(x,y: integer;
name: string);
implementation
var user_pos: boolean; {TRUE jeśli użyto put_screen_xy}
user_pos_x, user_pos_y: integer; {pozycja podana w
put_screen_xy}
f: file;
{* zapamiętuje obszar ekranu graficznego na dysku *}
procedure to_disk(x1,y1,x2,y2: integer);
var size,h : word;
p : pointer;
last_y,cur_y : integer;
the_end : boolean; {warunek zakończenia pętli}
dx, dy : integer;
fullsize,maxsize : longint;
{przestawia wartości argumentów}
procedure skip(var a,b: integer);
var tmp : integer;
begin
tmp := a;
a := b;
b := tmp;
end;
begin
if x1 > x2 then skip(x1,x2); {w razie potrzeby...}
if y1 > y2 then skip(y1,y2); {...zamień argumenty}
maxsize := 64000; {maks.rozmiar zapisywanego bloku}
fullsize := longint(y2-y1) * (x2-x1) div 2;{rozmiar
pamięci potrzebny do zapamiętania obszaru}
cur_y := y1;
dx := x2 - x1;
dy := y2 - y1;
if fullsize > maxsize
then h := 2 * maxsize div dx
else h := 480;
blockwrite(f, x1, 2); {* zapisuje współrzędne: }
blockwrite(f, y1, 2); { lewego górnego narożnika}
blockwrite(f, dx, 2); { szerokość rysunku}
blockwrite(f, dy, 2); { wysokość rysunku}
blockwrite(f, h, 2); { maks. wysokość bloków}
the_end := false;
repeat
last_y := cur_y;
cur_y := cur_y + h;
if cur_y >= y2 then
begin
cur_y := y2;
the_end := true; {zakończenie w przypadku...}
{... osiągnięcia dolnej krawędzi obszaru...}
{... przez cur_y}
end;
size := imagesize(x1, last_y, x2, cur_y );
getmem(p, size);
getimage(x1, last_y, x2, cur_y, p^);
blockwrite(f, size, 2); {zapis fragmentu...}
blockwrite(f, p^, size); {...ekranu na dysk}
freemem(p, size);
until the_end;
close(f);
end;
{*** odtwarza fragment ekranu graficznego ***}
{*** zapamiętany na dysku ***}
procedure to_screen;
var l,h,size : word;
rez,cur_y, dx,dy,x0,y0 : integer;
p : pointer;
blad : boolean;
begin
{$I-} reset(f,1); {$I+}
{SaveWin...}
|
Listing - SaveWin Cd...
rez := ioresult;
if rez = 0 then
begin
blockread(f, x0, 2);
blockread(f, y0, 2);
blockread(f, dx, 2);
blockread(f, dy, 2);
blockread(f, h, 2);
end;
if user_pos then
begin
x0 := user_pos_x;
y0 := user_pos_y;
end;
cur_y := y0;
if rez = 0 then
begin
{$I-}
blad := false;
repeat
blockread(f, size, 2, l);
if ioresult 0 then
begin
blad := true;
break;
end;
if l = 0 then break;
getmem(p, size);
blockread(f, p^, size); {odczyt fragmentu...}
{...ekranu z dysku}
if ioresult 0 then
begin
blad := true;
break;
end;
putimage(x0, cur_y, p^, normalput);
freemem(p, size);
cur_y := cur_y + h;
until false;
{$I+}
if blad then
begin
setcolor(white);
settextstyle(0,0,1);
bar(x0,y0,x0+120,y0+50);
outtextxy(x0+3, y0+18, 'Zły format !!!');
end;
close(f);
end;
end;
procedure get_screen(x1,y1,x2,y2: integer);
var str_screen : string[3]; {numer zapisanego ekranu}
begin
inc(screen_nr); {numer nowego okna}
str(screen_nr, str_screen); {ustalenie nazwy pliku}
assign(f, 'scr' + str_screen);
rewrite(f, 1);
to_disk(x1, y1, x2, y2);
end;
procedure get_screen_n(x1, y1, x2, y2 : integer;
name : string);
begin
assign(f, name);
rewrite(f, 1);
to_disk(x1, y1, x2, y2);
end;
procedure put_screen;
var str_screen : string[3];
begin
if screen_nr > 0 then
begin
str(screen_nr, str_screen);
dec(screen_nr);
assign(f, 'scr'+ str_screen);
user_pos := false;
to_screen;
erase(f); {usuwa niepotrzebny już plik}
end;
end;
procedure put_screen_xy(x,y: integer);
var str_screen : string[3];
begin
if screen_nr > 0 then
begin
str(screen_nr, str_screen);
dec(screen_nr);
assign(f, 'scr'+ str_screen);
user_pos := true;
user_pos_x := x;
user_pos_y := y;
to_screen;
erase(f); {usuwa niepotrzebny już plik}
end;
end;
procedure put_screen_n(name: string);
begin
assign(f, name);
user_pos := false;
to_screen;
end;
procedure put_screen_xy_n(x,y: integer; name: string);
begin
assign(f, name);
user_pos := true;
user_pos_x := x;
user_pos_y := y;
to_screen;
end;
begin
screen_nr := 0;
end.
{*** koniec modułu SaveWin ***}
|
--- * --- * ---
Listing - Demo.pas
{* program demonstruje działanie procedur *}
{* modułu savewin *}
uses savewin, graph;
var driver,mode,i : integer;
begin
driver := detect;
initgraph(driver, mode, 'c:\tp\bgi');
{zrób dowolny obrazek}
randomize;
for i := 1 to 100
do lineto(random(getmaxx), random(getmaxy));
outtextxy(10,getmaxy-30, 'Nacisnij ENTER');
{zapamiętaj fragment ekranu...}
get_screen(10, 10 , 300, 200);
readln;
cleardevice; {wyczyść cały ekran}
{...a teraz odtwórz zapamiętany obszar}
put_screen;put_screen;
outtextxy(10,10,'Odtworzony z dysku fragment');
{Zapamiętaj fragment pod określoną nazwą...}
{rozszerzenie dowolne - ja stosuję PAC}
get_screen_n(200, 100, 300, 200, 'rysunek.pac');
{...i odtwórz go wiele razy}
outtextxy(100, 300, 'Odtwarzana ilustracja ->');
for i := 1 to 100
do put_screen_xy_n(200+i*2, 100+i*2, 'rysunek.pac');
readln;
closegraph;
end.
|
Andrzej Postrzednik
PC Kurier, Styczeń 1995r