[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{Hi !!!
Thanx for answering on my mail, here are two sources which i grabed from
Data Master 1.0 for VGA, it will probably work on other cards, but i tested
them only on VGA 640x480x16 in Turbo Pascal 7.0
There are two sources:
1. SaveScn.Pas (Capture Graphical Screens to file)
Creates simple Graphical look of screen, and save it to file.
All procedures are independent and can be cuted to another programs
which deal with graphics. It can save all or just a part of screen.
Procedures Ikona and BIkona are taked from unit Grafika and they are
creation of Kristijan Lukacin (programmer for graphics on Data Master,
i deal with files, and other non-graphics, or with little graphics parts
of program).
2. ReadScrn.Pas (Reading and Showing Saved Images)
This will show saved image to screen (here isn't solved showing saved
images of edge of screen, if ANY part of saved image goes over screen
edge nothing will be showed on screen).
Thanx !!!
AMATRIX Software Developement Coorporation
1994, Croatia
Communication with us thrue
E-mail: piko@cromath.math.hr
Snail mail: Varoska 67
41040 Zagreb
Croatia
Markusevacka cesta
41000 Zagreb
Croatia
Fax/Phone: (99 385)(0)41 283 505, contact person Kresimir Mihalj
(99 385)(0)41 277 221, contact person Kristijan Lukacin
}
{***************************************************************************}
{ Save all or just part of graphical screen to file
{***************************************************************************}
PROGRAM SaveImage;
USES Graph, Dos, CRT;
Var GD, GM: Integer;
hmm: Boolean;
Procedure CIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
Begin
SetColor(White);
SetFillStyle(SolidFill,2);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(White);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(DarkGray);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(White);
OutTextXY(x1+3,y1+2+text,TekstIkone);
end {Ikona};
Procedure Ikona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
Begin
SetColor(White);
SetFillStyle(SolidFill,LightGray);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(White);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(DarkGray);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(White);
OutTextXY(x1+3,y1+2+text,TekstIkone);
end {Ikona};
Procedure BIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Stisnuta Ikona} Begin
SetColor(White);
SetFillStyle(SolidFill,LightGray);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(Black);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(White);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(DarkGray);
OutTextXY(x1+3,y1+2+text,TekstIkone);
Delay(300);
end {Bikona};
PROCEDURE Make_Amatrix_Image_Data;
VAR ch: Char;
k:LongInt;
st: String;
d: Text;
e,z,w: File Of Char;
BEGIN
Assign(d,'IMAGE.AID');
Rewrite(d);
Writeln(d,'Amatrix Image Data Version 1.0 (c) 1994 by Amatrix');
Writeln(d, 'Developed By Kresimir Mihalj');
Writeln(d);
Write(d,'AISD/3 ');
k:=0;
Assign(e,'IMAGE2.TMP');
Reset(e);
WHILE Not Eof(e) DO
BEGIN
Read(e,Ch);
k:=k+1;
END;
Append(d);
Reset(e);
Writeln(d,k);
WHILE Not Eof(e) DO
BEGIN
Read(e,Ch);
Write(d,Ch);
END;
Close(e);
Append(d);
Writeln(d);
Write(d,'AIDD/3 ');
k:=0;
Assign(w,'IMAGE3.TMP');
Reset(w);
WHILE Not Eof(w) DO
BEGIN
Read(w,Ch);
k:=k+1;
END;
Reset(w);
Writeln(d,k);
WHILE Not Eof(w) DO
BEGIN
Read(w,Ch);
Write(d,Ch);
END;
Writeln(d);
Close(w);
Write(d,'AID/3 ');
Assign(z,'IMAGE1.TMP');
Reset(z);
k:=0;
WHILE Not Eof(z) DO
BEGIN
Read(z,Ch);
k:=k+1;
END;
Reset(z);
Writeln(d,k);
WHILE Not Eof(z) DO
BEGIN
Read(z,Ch);
Write(d,Ch);
END;
Close(z);
Close(d);
END;
PROCEDURE Save_Image_in_Temp_Files(X1,Y1,X2,Y2: Integer);
VAR Size,Result: Word;
P: Pointer;
Ch: Char;
yy1,yy2,k: Integer;
g: File of Word;
h: File of Integer;
f: File;
BEGIN
Assign(F,'IMAGE1.TMP');
reWrite(F,1);
Assign(g, 'IMAGE2.TMP');
Rewrite(g);
Assign(h, 'IMAGE3.TMP');
Rewrite(h);
k:=(Y2-Y1) DIV 3;
Write(h,k);
Size:=ImageSize(x1,y1,x2,y1+k);
Write(g,Size);
GetMem(P,Size);
GetImage(x1,y1,x2,y1+k,P^);
BlockWrite(F,P^,Size,Result);
if Ioresult <> 0 then Halt(2);
FreeMem(P,Size);
Size:=ImageSize(x1,y1+k,x2,y1+(k*2));
Write(g,Size);
GetMem(P,Size);
GetImage(x1,y1+k,x2,y1+(k*2),P^);
BlockWrite(F,P^,Size,Result);
if Ioresult <> 0 then Halt(2);
FreeMem(P,Size);
Size:=ImageSize(x1,y1+(k*2),x2,y2);
Write(g,Size);
GetMem(P,Size);
GetImage(x1,y1+(k*2),x2,y2,P^);
BlockWrite(F,P^,Size,Result);
if Ioresult <> 0 then Halt(2);
FreeMem(P,Size);
Make_Amatrix_Image_Data;
Rewrite(f);
close(F);
Erase(f);
Rewrite(g);
Close(g);
Erase(g);
Rewrite(h);
Close(h);
Erase(h);
END;
BEGIN
Gd:=Detect;
InitGraph(Gd, Gm, '\turbo\tp\'); { CHANGE THIS !!! }
if GraphResult <> grOk then Halt(1);
{********* Create some graphics *********}
ikona(200,160,440,380,0,' ');
Bikona(205,165,435,375,0,' ');
Ikona(210,170,430,195,0,' ');
Ikona(210,202,430,245,0,' ');
Ikona(210,252,430,370,0,' ');
SetTextStyle(0,0,2);
SetColor(1);
OutTextXY(238,177,'WARNING !!!');
SetColor(5);
OutTextXY(237,176,'WARNING !!!');
SetColor(4);
OutTextXY(236,175,'WARNING !!!');
SetColor(13);
OutTextXY(235,174,'WARNING !!!');
SetTextStyle(0,0,1);
SetColor(9);
OutTextXY(221,212,'Delete also include wipe !');
SetColor(15);
OutTextXY(219,210,'Delete also include wipe !');
SetColor(9);
OutTextXY(221,221,'Deleted files cannot be');
SetColor(15);
OutTextXY(219,219,'Deleted files cannot be');
SetColor(9);
OutTextXY(221,231,'undeleted in any way !');
SetColor(15);
OutTextXY(219,229,'undeleted in any way !');
SetColor(8);
OutTextXY(270,260,'Erase & Wipe');
SetColor(15);
OutTextXY(268,258,'Erase & Wipe');
SetColor(9);
OutTextXY(270,280,'command1.com');
SetColor(15);
OutTextXY(268,278,'command1.com');
SetColor(9);
OutTextXY(305,290,'arhs');
SetColor(15);
OutTextXY(303,288,'arhs');
SetColor(9);
OutTextXY(282,300,'123456789');
SetColor(15);
OutTextXY(280,298,'123456789');
SetColor(9);
OutTextXY(279,310,'22-12-1994');
SetColor(15);
OutTextXY(277,308,'22-12-1994');
SetColor(9);
OutTextXY(286,320,'12:12:12');
SetColor(15);
OutTextXY(284,318,'12:12:12');
Ikona(237,342,273,360,0,' ');
Ikona(240,345,270,357,0,'Yes');
Ikona(297,342,325,360,0,' ');
Ikona(300,345,322,357,0,'No');
Ikona(349,342,407,360,0,' ');
Ikona(352,345,404,357,0,'Always');
{ ********* end of graphic **************}
Save_Image_in_Temp_Files(0,0,639,479); {Save whole screen to file}
REPEAT UNTIL Keypressed;
END.
{***************************************************************************}
{ Show saved image to screen
{***************************************************************************}
Program ShowPic;
USES Graph, Dos, CRT;
Var GD, GM: Integer;
X, Y, Button: Integer ;
hmm: Boolean;
Size,Result: Word;
P: Pointer;
Ch: Char;
f: File;
g: File Of Word;
h: File Of Integer;
Procedure CIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
Begin
SetColor(White);
SetFillStyle(SolidFill,2);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(White);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(DarkGray);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(White);
OutTextXY(x1+3,y1+2+text,TekstIkone);
end {Ikona};
Procedure Ikona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
Begin
SetColor(White);
SetFillStyle(SolidFill,LightGray);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(White);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(DarkGray);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(White);
OutTextXY(x1+3,y1+2+text,TekstIkone);
end {Ikona};
Procedure BIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Stisnuta Ikona} Begin
SetColor(White);
SetFillStyle(SolidFill,LightGray);
Bar(x1,y1,x2,y2);
SetColor(Black);
SetLineStyle(0,0,1);
Rectangle(x1-1,y1-2,x2+1,y2+1);
SetColor(Black);
Line(x1,y1-1,x2,y1-1);
Line(x1,y1,x1,y2-1);
SetColor(DarkGray);
Line(x1+1,y2,x2,y2);
Line(x2,y2,x1,y2);
SetTextStyle(0,0,0);
SetColor(White);
OutTextXY(x1+5,y1+4+text,TekstIkone);
SetColor(DarkGray);
OutTextXY(x1+3,y1+2+text,TekstIkone);
Delay(300);
end {Bikona};
Procedure TS(Var ad:Text; Pos:LongInt); {Seek for Text Files}
Type dW=Array[0..1] of Word;
Var ap:LongInt;
ds: LongInt;
Rg:Registers;
erg:LongInt;
begin
With Rg do
begin
ah:=$42;
al:=1;
bx:=TextRec(ad).Handle;
cx:=dW(Pos)[1];
dx:=dW(Pos)[0];
MSDos(Rg);
if Flags and fCarry<>0 then
begin
InOutRes:=ax;
ds:=0
end
else ds:=rg.ax+rg.dx*65536;
end;
ap:=ds-TextRec(ad).Bufend+TextRec(ad).BufPos;
if ap<>pos then With Textrec(ad) do
begin
if Mode=fmOutput then flush(ad);
With Textrec(ad) do
begin
if (ap+(bufend-bufpos)<Pos) or (ap>Pos) then
begin
bufpos:=0;
bufend:=0;
With Rg do
begin
ah:=$42;
al:=0;
bx:=TextRec(ad).Handle;
cx:=dW(pos)[1];
dx:=dW(pos)[0];
MSDos(Rg);
if Flags and fCarry<>0 then
begin
InOutRes:=ax;
ds:=0
end
else ds:=rg.ax+rg.dx*65536;
end;
end
else
begin
inc(bufpos, pos-ap);
end;
end;
end;
end;
PROCEDURE Make_Image_Temp_Files;
VAR ch: Char;
k,KK,Per,Per1:LongInt;
m,pos: Integer;
st: String;
d: TEXT;
e,z,w: File Of Char;
ok:Boolean;
BEGIN
ikona(170,180,470,300,0,' ');
Bikona(175,185,465,295,0,' ');
ikona(180,190,460,290,0,' ');
SetColor(8);
OutTextXY(258,198,'Reading Image');
SetColor(15);
OutTextXY(256,196,'Reading Image');
Ikona(210,235,430,265,0,' ');
Bikona(215,240,425,260,0,' ');
Assign(d,'IMAGE.AID');
Reset(d);
TS(d,84);
st:='';
FOR kk:=1 TO 7 DO
BEGIN
Read(d, Ch);
st:=st+ch;
END;
IF (st='AISD/3 ') THEN OK:=True;
IF ok THEN
BEGIN
Readln(d,k);
Assign(e,'IMAGE2.TMP');
REWRITE(e);
FOR kk:=1 TO k DO
BEGIN
Read(d,ch);
Write(e,ch);
END;
Readln(d);
Close(e);
END;
ok:=False;
st:='';
FOR kk:=1 TO 7 DO
BEGIN
Read(d,ch);
st:=st+ch;
END;
IF (st='AIDD/3 ') THEN ok:=True;
IF ok THEN
BEGIN
Readln(d,k);
ASSIGN(w,'IMAGE3.TMP');
REWRITE(w);
FOR kk:=1 TO k DO
BEGIN
Read(d,ch);
Write(w,ch);
END;
Readln(d);
Close(w);
END;
ok:=False;
st:='';
FOR kk:=1 TO 6 DO
BEGIN
Read(d,ch);
st:=st+ch;
END;
IF (st='AID/3 ') THEN ok:=True;
IF ok THEN
BEGIN
Readln(d,k);
per:=k DIV 100;
per1:=Per;
m:=0;
pos:=0;
ASSIGN(z,'IMAGE1.TMP');
REWRITE(z);
FOR kk:=1 TO k DO
BEGIN
Read(d,ch);
Write(z,ch);
IF kk=per THEN
BEGIN
m:=m+2;
{ ******* Bar for reading image *********}
CIkona(220,245,220+m,255,0,' ');
Per:=Per+Per1;
pos:=pos+1;
Str(pos,st);
st:=st+' %';
SetFillStyle(1,7);
Bar(307,211,340,229);
SetColor(8);
OutTextXY(310,220,st);
SetColor(15);
OutTextXY(308,218,st);
END;
END;
Close(z);
END;
Close(d);
ClearDevice;
END;
PROCEDURE Show_Pic(X,Y : Integer); {This shows image}
VAR k: Integer;
BEGIN
Assign(F,'IMAGE1.TMP');
reset(F,1);
Assign(g, 'IMAGE2.TMP');
Reset(g);
ASSIGN(h,'IMAGE3.TMP');
Reset(h);
Read(g,Size);
GetMem(P,Size);
BlockRead(F,P^,Size,Result);
PutImage(X,Y,P^,NormalPut);
FreeMem(P,Size);
Read(h,k);
Read(g,Size);
GetMem(P,Size);
BlockRead(F,P^,Size,Result);
PutImage(x,y+k,P^,NormalPut);
FreeMem(P,Size);
Read(g,Size);
GetMem(P,Size);
BlockRead(F,P^,Size,Result);
PutImage(x,y+(k*2),P^,NormalPut);
FreeMem(P,Size);
Rewrite(f);
close(F);
Erase(f);
Rewrite(g);
Close(g);
Erase(g);
END;
BEGIN
ClrScr;
Gd:=Detect;
InitGraph(Gd, Gm, '\turbo\tp\'); { CHANGE THIS !! }
if GraphResult <> grOk then Halt(1);
IF Gd<>9 THEN
BEGIN
SetColor(White);
OutTextXY(10, GetMaxY DIV 2, 'Sorry but this was tested only on VGA');
OutTextXY(10, (GetMaxY DIV 2)+10, 'It will probably work on other card,');
OutTextXY(10, (GetMaxY DIV 2)+20, 'but all graphics here are for 640x480x16');
OutTextXY(10, (GetMaxY DIV 2)+40, 'All you have to do is to remove this lines');
OutTextXY(10, (GetMaxY DIV 2)+50, 'and try. Probably you need to change something');
OutTextXY(10, (GetMaxY DIV 2)+10, 'like colors, constants and so on ...');
Delay(10000);
CloseGraph;
Halt(1);
END;
Make_Image_Temp_Files;
Show_Pic(0,0);
REPEAT UNTIL Keypressed;
END.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]