Save graphics to disk file

Discussion:

(too old to reply)

Chuck

2006-11-05 23:59:26 UTC

I have some old Turbo Pascal 4.5 for DOS programs. Part of the outputs are XY
plots of the results of the program. I have a GraphPrn.pas unit that prints
the graphics to a DOS dot matrix printer. The original unit .pas source code
was given to me. Is there any way I can modify the unit source code to save
the graphics to a disk file so that it can be opened and printed to a windows
printer? I do not have a windows version of Turbo Pascal.

I haven't written any code for more than 10 years so any help will be very much
appreciated.

Chuck
--

Matt Claessen

2006-11-06 23:23:22 UTC

Permalink

Hi,

Post by Chuck
I have some old Turbo Pascal 4.5 for DOS programs. Part of the outputs are XY
plots of the results of the program. I have a GraphPrn.pas unit that prints
the graphics to a DOS dot matrix printer. The original unit .pas source code
was given to me. Is there any way I can modify the unit source code to save
the graphics to a disk file so that it can be opened and printed to a windows
printer? I do not have a windows version of Turbo Pascal.

GraphPrn does not ring any bells, it is probably written in house.
The code you need will also depend on the graphics mode that is used.
In the distant past, I have adapted a screendump routine from Borland's
Graphix Toolbox
to make it dump a VGA graphics screen (640x480, 16 colors) to among others a
PCX file.
PCX files can be printed running Windows, e.g. with IrfanView.
If you can use it, I will gladly post the code.

There is no TP 4.5, you will probably have one of 4.0 5.0 or 5.5, all for
DOS.

regards, Matt

Chuck

2006-11-07 01:01:50 UTC

Permalink

On Tue, 7 Nov 2006 00:23:22 +0100, "Matt Claessen" <***@forget.it> wrote:

Matt

Post by Matt Claessen
GraphPrn does not ring any bells, it is probably written in house.
The code you need will also depend on the graphics mode that is used.
In the distant past, I have adapted a screendump routine from Borland's
Graphix Toolbox
to make it dump a VGA graphics screen (640x480, 16 colors) to among others a
PCX file.
PCX files can be printed running Windows, e.g. with IrfanView.
If you can use it, I will gladly post the code.
There is no TP 4.5, you will probably have one of 4.0 5.0 or 5.5, all for
DOS.
regards, Matt

Thanks for the reply. You are correct, my TP is version 5.0.
It has been a very long time but it is very possible that GraphPrn is a name I
used. It contains 2 procedures and 2 functions that I did not write.

Procedure Hardcopy ( Gmode : Integer );
Procedure AssignLST( Port : Byte );
Function LSTNoFunction( Var F : TextRec ) : Integer;
Function LSTOutPutToPrinter( Var F : TextRec ) : Integer;

Procedure AssignLST( Port : Byte );
Begin
With TextRec(LST) do
Handel := $FFF0;
Mode := fmOutput;
Bufsize := SizeOf (Buffer);
BufPtr := @Buffer;
BufPos := 0;
OpenFunc := @LSTNoFunction;
InOutFunc := @LSTOutPutToPrinter;
FlushFunc := @LSTOutPutToPrinter;
CloseFunc := @LSTOutPutToPrinter;
UserData[1] := Port - 1;
End;

Begin
AssignLST( 1 );
End;

I suspect the [1] is LPT1 port.
Could the AssignLST be changed to a BMP ( or PCX ) file on the hard drive?
I never was much of a programmer and never wrote programs for any one but
myself.. All the programs I wrote were long integration routines to simply
crunch the numbers. I have modified one program to output the text portion to
a text file. It works fine.

Yes I would like to have your VGA screen dump to a pcx file.
I have several graphics viewers that can handel pcx. All can print

Matt Claessen

2006-11-07 12:28:28 UTC

Permalink

Hi,

Post by Chuck
Yes I would like to have your VGA screen dump to a pcx file.

Ok, here is the procedure. Comments and some variables are in Dutch, but
you'll get it.

--------------------------------------------------------------

PROCEDURE dumppcx(filenaam:STRING);
CONST header:ARRAY[1..128] OF BYTE=
($0A, { PCX flag }
$05, { version 3.0 }
$01, { Run Length encoding }
$01, { 1 bit per pixel }
$00,$00, { x coordinaat linker bovenhoek }
$00,$00, { y coordinaat linker bovenhoek }
$7F,$02, { x coordinaat rechter benedenhoek }
$DF,$01, { y coordinaat rechter benedenhoek }
$80,$02, { horizontale dots per inch }
$DE,$01, { verticale dots per inch }
$FF,$FF,$FF, { palette kleur no 0 }
$00,$00,$BF, { palette kleur no 1 }
$00,$BF,$00, { palette kleur no 2 }
$00,$BF,$BF, { palette kleur no 3 }
$BF,$00,$00, { palette kleur no 4 }
$BF,$00,$BF, { palette kleur no 5 }
$BF,$BF,$00, { palette kleur no 6 }
$00,$00,$00, { palette kleur no 7 }
$FF,$FF,$FF, { palette kleur no 8 }
$00,$00,$FF, { palette kleur no 9 }
$00,$FF,$00, { palette kleur no 10 }
$00,$FF,$FF, { palette kleur no 11 }
$FF,$00,$00, { palette kleur no 12 }
$FF,$00,$FF, { palette kleur no 13 }
$FF,$FF,$00, { palette kleur no 14 }
$00,$00,$00, { palette kleur no 15 }
$00, { reserved (was video mode) }
$04, { aantal color planes }
$50,$00, { bytes per regel }
$01,$00, { palette info = kleur }
$80,$02, { horizontal screen size }
$DE,$01, { vertical screen size }
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00);
VAR teller,scanline:INTEGER;
uitvoer:FILE OF BYTE;

PROCEDURE pcx_encode(data:BYTE;pteller:BYTE);
BEGIN
IF ((data AND $C0)=$C0) OR (pteller>1)
THEN BEGIN
pteller:=pteller OR $C0;
WRITE(uitvoer,pteller);
END;
WRITE(uitvoer,data);
END;

PROCEDURE doline;
VAR plane,data_teller,lijn_teller,nieuwe_byte,vorige_byte:BYTE;
BEGIN
FOR plane:=0 TO 3 DO { lees 4 bitplanes VGA }
BEGIN { = 16 kleuren }
PORTW[$03CE]:=plane*256+$0004; { kies bitplane in VGA }
vorige_byte:=MEM[base_vga:scanline*80]; { init }
data_teller:=1;
lijn_teller:=1;
WHILE lijn_teller<80 DO
BEGIN
nieuwe_byte:=MEM[base_vga:scanline*80+lijn_teller];
lijn_teller:=lijn_teller+1;
IF nieuwe_byte=vorige_byte
THEN BEGIN
data_teller:=data_teller+1;
IF data_teller=63
THEN BEGIN
pcx_encode(vorige_byte,data_teller);
data_teller:=0;
END;
END
ELSE BEGIN
IF data_teller>0 THEN pcx_encode(vorige_byte,data_teller);
vorige_byte:=nieuwe_byte;
data_teller:=1;
END;
END;
IF data_teller>0 THEN pcx_encode(vorige_byte,data_teller);
END;
END;

BEGIN { dumppcx }
ASSIGN(uitvoer,filenaam);
REWRITE(uitvoer);
FOR teller:=1 TO 128 DO WRITE(uitvoer,header[teller]);
PORTW[$03CE]:=$0005; { zet VGA op mode 0 (=default) }
PORTW[$03CE]:=$0002; { zet color compare VGA op 0
(=default) }
PORTW[$03CE]:=$0F07; { zet color don't care VGA op 15
(=default) }
FOR scanline:=0 TO 479 DO doline;
PORTW[$03CE]:=$0004; { zet VGA terug op bitplane 0
(=default) }
CLOSE(uitvoer);
END;

-------------------------------------------------------------------

HTH, regards, Matt

Chuck

2006-11-07 16:05:18 UTC

Permalink

On Tue, 7 Nov 2006 13:28:28 +0100, "Matt Claessen" <***@forget.it> wrote:

Matt,

Thanks for the code.

I made a new Unit {PCXdump} and copied the code into it.

It failed to compile. Only one error.
base_vga in 2 lines MEM[base_vga:scanline*80]; {init}
was Unknown Identifier.

Chuck
--

Post by Matt Claessen

Post by Chuck
Yes I would like to have your VGA screen dump to a pcx file.

Ok, here is the procedure. Comments and some variables are in Dutch, but
you'll get it.

Matt Claessen

2006-11-07 12:43:01 UTC

Permalink

Hi,

I read through the code, and found another constant you need:

const base_vga=$A000;

Post by Chuck
Function LSTNoFunction( Var F : TextRec ) : Integer;
Function LSTOutPutToPrinter( Var F : TextRec ) : Integer;

These should be present in some unit that you include. Can't say
anything more about them. Code like this is highly dependent on video
and printer hardware. It would need extensive documentation and effort
to change.

regards, Matt

Femme Verbeek

2006-11-07 16:20:11 UTC

Permalink

First idea is to press alt+prt scrn. If the mode is 16x640x480, windows
will copy the screen to the clipboard, so you can paste it in any
program that handles

For other resolutions or automatic saving e.g. for moving images use my
code below. I tried a lot of bitmap generators found on the internet,
but most had still bugs in it. Especially the rgb colors were not
correctly represented.

Just include the unit in your uses clause.
When the picture is on the screen call graftobmp16;
The picture is saved to a file called SCRX????.BMP
The ???? is replaced by a number that is incremented each call. The
procedure checks for the presence of scrx*.bmp files and numbers on.
Other screen resolutions than 640x480 are permitted.

Tested in BP 7.0. under win XP, ME. 98

good luck

-- Femme

unit graphbmp;
interface
Procedure GrafToBMP16; {16 color BMP}

implementation
uses dos,graph;

Type
ColorType = Record
blue: Byte;
Green: Byte;
red: Byte;
Reserved: Byte;
End;

Procedure GETRGB ( Col: Byte; Var RGB: colortype );
Var
RGB_: colortype;
Begin
Asm
Mov Ah, $10;
Mov Al, $15;
Mov Bl, Col;
Int $10
Mov RGB_.Red, Dh;
Mov RGB_.Green, Ch;
Mov RGB_.Blue, Cl;
End;
RGB:=RGB_;
End;

Const BMPnum:Integer=-1;

Procedure InitGraf2BMP;
Var X,Y,I : Integer;
FN : PathStr;
SR : SearchRec;
T : Text;
Begin
BMPnum := 0;
FindFirst('SCRX????.BMP',Archive or ReadOnly,SR);
while DOSerror=0 do
Begin
FN := Copy(SR.Name,5,4);
Val(FN,X,Y);
if Y=0 then
if X >= BMPnum then
BMPnum := X+1;
FindNext(SR);
End;
End;

Procedure GrafToBMP16; {16 color BMP}
Const BMPhead:Array[0..53] of Byte=
($42,$4D,$16,$6A,$02,$00,0,0,0,0,$76,0,0,0,$28,0,0,0, {no graphix}
$80,$02,0,0, {bmpsize x}
$E0,$01,0,0, {bmpsize y}
$01,0, {bits per plane}
$04,0, {bits per pixel}
0,0,0,0, {bitompression}
0,0,0,0, {imsize}
0,0,0,0, {resolution x}
0,0,0,0, {resolution y}
$10,0,0,0, {colors used}
0,0,0,0 {colorsimportant}
);
Var written,X,Y : Integer;
F : File;
FN : PathStr;
B : Array[0..800] of Byte;
iclr:byte;
bgr:colortype;
Begin
Str(BMPnum:4,FN);
for X := 1 to 3 do
if FN[X]=' ' then
FN[X] := '0'; {fill blanks -> '0'}
Inc(BMPnum);
Write(^G);
FN := 'SCRX'+FN; {you may modify 'SCRX' here and on the other locs}
FN := FN+'.BMP';
Assign(F,FN);
Rewrite(F,1);
bmphead[18]:=lo(getmaxx+1);
bmphead[19]:=hi(getmaxx+1);
bmphead[22]:=lo(getmaxy+1);
bmphead[23]:=hi(getmaxy+1);

BlockWrite(F,BMPhead,sizeof(BMPhead),written);

for iclr:=0 to 15 do
begin
getrgb(iclr,bgr);
bgr.blue:=bgr.blue * 4;
bgr.green:=bgr.green * 4;
bgr.red:=bgr.red * 4;
bgr.reserved:=0;
blockwrite(F,bgr,sizeof(bgr),written);
end;

For Y := getmaxy downto 0 do
Begin
for X := 0 to getmaxx div 2 do
B[X] := GetPixel(X*2+1,Y) OR
GetPixel(X*2,Y) shl 4 ;
BlockWrite(F,B,(getmaxx+1) div 2,written);
End;
Close(F);
{ Write(^G); {beep}
End;
begin
InitGraf2BMP;
end.

Chuck

2006-11-07 21:40:54 UTC

Permalink

On Tue, 07 Nov 2006 17:20:11 +0100, Femme Verbeek <***@nospam.tcenl.com> wrote:

Femme,

Thanks for the reply.

There may be significant differences between TP 5.0 for DOS and BP 7.0 for
Windows. Your Unit failed to compile. It hiccuped on Asm and Mov Unknown
Identificer(s). It should have at least recognized Mov, but it didn't.
The compiler also said RGB:=RCB_; in the same Procedure GETRCB was a
duplicate. Didn't understand that at all. The rest of the Unit compiled OK.

alt-prt screen works, but it isn't really what I wanted to do.

What little I know about programing, I taught myself. And it is becomong
painfully obvious just how little that is.

Thanks for trying to help.

Chuck
--

Post by Femme Verbeek
First idea is to press alt+prt scrn. If the mode is 16x640x480, windows
will copy the screen to the clipboard, so you can paste it in any
program that handles
For other resolutions or automatic saving e.g. for moving images use my
code below. I tried a lot of bitmap generators found on the internet,
but most had still bugs in it. Especially the rgb colors were not
correctly represented.
Just include the unit in your uses clause.
When the picture is on the screen call graftobmp16;
The picture is saved to a file called SCRX????.BMP
The ???? is replaced by a number that is incremented each call. The
procedure checks for the presence of scrx*.bmp files and numbers on.
Other screen resolutions than 640x480 are permitted.
Tested in BP 7.0. under win XP, ME. 98
good luck
-- Femme
unit graphbmp;
interface
Procedure GrafToBMP16; {16 color BMP}
implementation
uses dos,graph;
Type
ColorType = Record
blue: Byte;
Green: Byte;
red: Byte;
Reserved: Byte;
End;
Procedure GETRGB ( Col: Byte; Var RGB: colortype );
Var
RGB_: colortype;
Begin
Asm
Mov Ah, $10;
Mov Al, $15;
Mov Bl, Col;
Int $10
Mov RGB_.Red, Dh;
Mov RGB_.Green, Ch;
Mov RGB_.Blue, Cl;
End;
RGB:=RGB_;
End;
Const BMPnum:Integer=-1;
Procedure InitGraf2BMP;
Var X,Y,I : Integer;
FN : PathStr;
SR : SearchRec;
T : Text;
Begin
BMPnum := 0;
FindFirst('SCRX????.BMP',Archive or ReadOnly,SR);
while DOSerror=0 do
Begin
FN := Copy(SR.Name,5,4);
Val(FN,X,Y);
if Y=0 then
if X >= BMPnum then
BMPnum := X+1;
FindNext(SR);
End;
End;
Procedure GrafToBMP16; {16 color BMP}
Const BMPhead:Array[0..53] of Byte=
($42,$4D,$16,$6A,$02,$00,0,0,0,0,$76,0,0,0,$28,0,0,0, {no graphix}
$80,$02,0,0, {bmpsize x}
$E0,$01,0,0, {bmpsize y}
$01,0, {bits per plane}
$04,0, {bits per pixel}
0,0,0,0, {bitompression}
0,0,0,0, {imsize}
0,0,0,0, {resolution x}
0,0,0,0, {resolution y}
$10,0,0,0, {colors used}
0,0,0,0 {colorsimportant}
);
Var written,X,Y : Integer;
F : File;
FN : PathStr;
B : Array[0..800] of Byte;
iclr:byte;
bgr:colortype;
Begin
Str(BMPnum:4,FN);
for X := 1 to 3 do
if FN[X]=' ' then
FN[X] := '0'; {fill blanks -> '0'}
Inc(BMPnum);
Write(^G);
FN := 'SCRX'+FN; {you may modify 'SCRX' here and on the other locs}
FN := FN+'.BMP';
Assign(F,FN);
Rewrite(F,1);
bmphead[18]:=lo(getmaxx+1);
bmphead[19]:=hi(getmaxx+1);
bmphead[22]:=lo(getmaxy+1);
bmphead[23]:=hi(getmaxy+1);
BlockWrite(F,BMPhead,sizeof(BMPhead),written);
for iclr:=0 to 15 do
begin
getrgb(iclr,bgr);
bgr.blue:=bgr.blue * 4;
bgr.green:=bgr.green * 4;
bgr.red:=bgr.red * 4;
bgr.reserved:=0;
blockwrite(F,bgr,sizeof(bgr),written);
end;
For Y := getmaxy downto 0 do
Begin
for X := 0 to getmaxx div 2 do
B[X] := GetPixel(X*2+1,Y) OR
GetPixel(X*2,Y) shl 4 ;
BlockWrite(F,B,(getmaxx+1) div 2,written);
End;
Close(F);
{ Write(^G); {beep}
End;
begin
InitGraf2BMP;
end.

Iain Macmillan

2006-11-08 01:36:51 UTC

Permalink

Post by Chuck
There may be significant differences between TP 5.0 for DOS and BP 7.0 for
Windows. Your Unit failed to compile. It hiccuped on Asm and Mov Unknown
Identificer(s).

asm is available on TP6 (DOS) - can't say for sure that that wasn't the
first version to use it though.

Post by Chuck
It should have at least recognized Mov, but it didn't.

Never mind. You don't have to use assembler, you can use the Intr procedure
instead

Procedure GETRGB ( Col: Byte; Var RGB: colortype );
Var
RGB_: colortype;
regs:Registers;
Begin
regs.Ah:=$10;
regs.Al:=$15;
regs.Bl:=Col;
Intr($10,regs);
RGB_.Red:=regs.Dh;
RGB_.Green:=regs.Ch;
RGB_.Blue:=regs.Cl;
RGB:=RGB_;
End;

Post by Chuck
The compiler also said RGB:=RCB_; in the same Procedure GETRCB was a
duplicate. Didn't understand that at all.

Perhaps the earlier errors confused it.
If it still doesn't like it in the above try changing all RGB_ to localRGB
or some such.

Chuck

2006-11-08 20:57:02 UTC

Permalink

On Wed, 08 Nov 2006 01:36:51 +0000, "Iain Macmillan" <***@ariesps.co.uk>
wrote:

Iain,

Thank you very much for your help. I do appreciate it very much. I hope you
didn't spend a lot of time on this because what I'm doing is only a hobby. No
one else will ever be using the program.

Your procedure works perfectly. However, I get some weird colors in the BMP
file. So I went back to the program file and discovered that no colors were
specified in the screen plots which looked OK with a light gray background and
blue lines and text. This must be a default setting. I'll go back and change
the original program set colors the way I want them. No need 15 years ago when
the only printer was a dot matrix printer with a black ribbon.

Chuck
--

Post by Iain Macmillan
asm is available on TP6 (DOS) - can't say for sure that that wasn't the
first version to use it though.

Post by Chuck
It should have at least recognized Mov, but it didn't.

Never mind. You don't have to use assembler, you can use the Intr procedure
instead
Procedure GETRGB ( Col: Byte; Var RGB: colortype );
Var
RGB_: colortype;
regs:Registers;
Begin
regs.Ah:=$10;
regs.Al:=$15;
regs.Bl:=Col;
Intr($10,regs);
RGB_.Red:=regs.Dh;
RGB_.Green:=regs.Ch;
RGB_.Blue:=regs.Cl;
RGB:=RGB_;
End;

Post by Chuck
The compiler also said RGB:=RCB_; in the same Procedure GETRCB was a
duplicate. Didn't understand that at all.

Perhaps the earlier errors confused it.
If it still doesn't like it in the above try changing all RGB_ to localRGB
or some such.

Markus Humm

2006-11-06 20:41:10 UTC

Permalink

Hello,

I don't know TP 4.x well but I assume the app. uses the unit Graph and
the BGI drivers?

If you need export functionality to Windows you should use the BMP
format. Some units for that can be found in SWAG which can be found at
www.gdsoft.com (or .ord?). They might work for you.

Greetings

Markus

Chuck

2006-11-07 20:09:48 UTC

Permalink

For what it is worth, the following is what I was using when I was printing in
DOS to a 24 pin dot matrix printer. It worked very well in a number of
different programs. I never knew who the original prorgammer was.

UNIT GraphPRN;

INTERFACE

USES Dos, Graph;

VAR
LST : Text;

PROCEDURE Hardcopy (Gmode: Integer);

IMPLEMENTATION

PROCEDURE Hardcopy (Gmode: Integer);

CONST
BITS : ARRAY [0..7] OF BYTE = (128,64,32,16,8,4,2,1);

VAR
X, Y, YOfs : Integer;
BitData, MaxBits : Byte;
Vport : ViewPortType;
Height, Width : Word;
HiBit, LoBit : Char;
LineSpacing,
GraphixPrefix : String[10];

BEGIN
LineSpacing := #27+'3'+#24;
Case Gmode Of
-1: GraphixPrefix := #27+'K';
-2: GraphixPrefix := #27+'L';
-3: GraphixPrefix := #27+'Y';
-4: GraphixPrefix := #27+'Z';
0..7: GraphixPrefix := #27+'*'+Chr(gmode);
ELSE
EXIT;
END;
GetViewSettings( Vport );
Height := Vport.Y2 - Vport.Y1;
Width := ( Vport.X2 + 1 ) - Vport.X1;
HiBit := Chr(Hi(Width));
LoBit := Chr(LO(Width));
Write( LST, LineSpacing );
Y := 0;
WHILE Y < Height DO
BEGIN
Write( LST, GraphixPrefix, LoBit, HiBit );
FOR X:= 0 TO Width-1 DO
BEGIN
BitData := 0;
IF Y + 7 <= Height
THEN MaxBits := 7
ELSE MaxBits := Height - Y;
FOR YOfs := 0 TO MaxBits DO
BEGIN
IF GetPixel( X, YOfs+Y ) >0
THEN BitData := BitData OR Bits[YOfs];
END;
Write( LST, Chr(BitData) );
END;
WriteLn ( LST );
Inc(Y,8);
END;
END;

{$F+}

FUNCTION LSTNoFunction( Var F: TextRec ) : Integer;
begin
LSTNoFunction := 0;
END;

FUNCTION LSTOutputToPrinter( Var F: TextRec ) : Integer;
VAR
Regs: Registers;
P : Word;
BEGIN
With F do
BEGIN
P := 0;
Regs.AH := 16;
While (P < BufPos) and ((regs.ah and 16) = 16) do
BEGIN
Regs.AL := Ord(BufPtr^[P]);
Regs.AH := 0;
Regs.DX := UserData[1];
Intr($17,Regs);
Inc(P);
END;
BufPos := 0;
END;
IF (Regs.AH and 16) = 16
THEN LSTOutputToPrinter := 0
ELSE IF (Regs.AH and 32) = 32
THEN LSTOutputToPrinter := 159
ELSE LSTOutputToPrinter := 160;
END;

{$F-}

PROCEDURE AssignLST( Port:Byte);
BEGIN
With TextRec(Lst) do
BEGIN
Handle := $FFF0;
Mode := fmOutput;
BufSize := SizeOf(Buffer);
BufPtr := @Buffer;
BufPos := 0;
OpenFunc := @LSTNoFunction;
InOutFunc := @LSTOutputToPrinter;
FlushFunc := @LSTOutputToPrinter;
CloseFunc := @LSTOutputToPrinter;
UserData[1] := Port - 1;
END;
END;

BEGIN
AssignLST(1);
END.