home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR16
/
SPOOLAQ.ZIP
/
SPOOL2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-12
|
18KB
|
561 lines
{************************************************}
{ }
{ program SPOOL2 }
{ demo program based on TVGUID15.PAS }
{ (Copyright (c) 1990 by Borland International)}
{ }
{ this program uses the SPOOL-tpu to print }
{ in the background }
{ }
{ this is part of SPOOL.EXE }
{************************************************}
{$V-}
{$X+}
program Spool2;
uses Objects, Drivers, Views, Menus, Dialogs, MsgBox, App, Spooler;
const
FileToRead = 'SPOOL2.PAS';
MaxLines = 100;
WinCount: Integer = 0;
cmFileOpen = 100;
cmNewWin = 101;
cmNewDialog = 102;
cmFileToSpool = 103; (* !!! added !!! *)
var
LineCount: Integer;
Lines: array[0..MaxLines - 1] of PString;
type
DialogData = record
CheckBoxData: Word;
RadioButtonData: Word;
InputLineData: string[128];
end;
TMyApp = object(TApplication)
MySpooler : PSpooler;
constructor Init;
destructor Done; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure Idle; virtual; (* !!! added !!! *)
procedure FileToSpool; (* !!! added !!! *)
procedure NewDialog;
procedure NewWindow;
end;
PInterior = ^TInterior;
TInterior = object(TScroller)
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
procedure Draw; virtual;
end;
PDemoWindow = ^TDemoWindow;
TDemoWindow = object(TWindow)
RInterior, LInterior: PInterior;
constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
function MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
procedure SizeLimits(var Min, Max: TPoint); virtual;
end;
PDemoDialog = ^TDemoDialog;
TDemoDialog = object(TDialog)
end;
procedure ReadFile;
var
F: Text;
S: String;
begin
LineCount := 0;
Assign(F, FileToRead);
{$I-}
Reset(F);
{$I+}
if IOResult <> 0 then
begin
Writeln('Cannot open ', FileToRead);
Halt(1);
end;
while not Eof(F) and (LineCount < MaxLines) do
begin
Readln(F, S);
Lines[LineCount] := NewStr(S);
Inc(LineCount);
end;
Close(F);
end;
procedure DoneFile;
var
I: Integer;
begin
for I := 0 to LineCount - 1 do
if Lines[I] <> nil then DisposeStr(Lines[i]);
end;
{ TInterior }
constructor TInterior.Init(var Bounds: TRect; AHScrollBar,
AVScrollBar: PScrollBar);
begin
TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
Options := Options or ofFramed;
SetLimit(128, LineCount);
end;
procedure TInterior.Draw;
var
Color: Byte;
I, Y: Integer;
B: TDrawBuffer;
begin
Color := GetColor(1);
for Y := 0 to Size.Y - 1 do
begin
MoveChar(B, ' ', Color, Size.X);
i := Delta.Y + Y;
if (I < LineCount) and (Lines[I] <> nil) then
MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color);
WriteLine(0, Y, Size.X, 1, B);
end;
end;
{ TDemoWindow }
constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
var
S: string[3];
R: TRect;
begin
Str(WindowNo, S);
TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
GetExtent(Bounds);
R.Assign(Bounds.A.X, Bounds.A.Y, Bounds.B.X div 2 + 1, Bounds.B.Y);
LInterior := MakeInterior(R, True);
LInterior^.GrowMode := gfGrowHiY;
Insert(Linterior);
R.Assign(Bounds.B.X div 2, Bounds.A.Y, Bounds.B.X, Bounds.B.Y);
RInterior := MakeInterior(R,False);
RInterior^.GrowMode := gfGrowHiX + gfGrowHiY;
Insert(RInterior);
end;
function TDemoWindow.MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
var
HScrollBar, VScrollBar: PScrollBar;
R: TRect;
begin
R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1);
VScrollBar := New(PScrollBar, Init(R));
VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
if Left then VScrollBar^.GrowMode := gfGrowHiY;
Insert(VScrollBar);
R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
HScrollBar := New(PScrollBar, Init(R));
HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
if Left then HScrollBar^.GrowMode := gfGrowHiY + gfGrowLoY;
Insert(HScrollBar);
Bounds.Grow(-1,-1);
MakeInterior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar));
end;
procedure TDemoWindow.SizeLimits(var Min, Max: TPoint);
var R: TRect;
begin
TWindow.SizeLimits(Min, Max);
Min.X := LInterior^.Size.X + 9;
end;
{ TMyApp }
constructor TMyApp.Init;
var
Rectangle : TRect;
begin
TApplication.Init;
MySpooler := nil;
end;
destructor TMyApp.Done;
begin
TApplication.Done;
if MySpooler<>nil then
Dispose( MySpooler, Done);
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmNewWin: NewWindow;
cmNewDialog: NewDialog;
cmFileToSpool : FileToSpool; (* !!! added !!! *)
else
Exit;
end;
ClearEvent(Event);
end;
end;
procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~F~ile', hcNoContext, NewMenu(
NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
NewLine(
(* added: the new entry in the menu: *)
NewItem('~S~tart Spooling', '', 0, cmFileToSpool, hcNoContext,
NewLine(
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))))),
NewSubMenu('~W~indow', hcNoContext, NewMenu(
NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
NewItem('~D~ialog', 'F2', kbF2, cmNewDialog, hcNoContext,
nil)))),
nil))
)));
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F4~ New', kbF4, cmNewWin,
NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
nil)))),
nil)
));
end;
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ added: output the data to the printer ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
procedure TMyApp.Idle;
begin
TApplication.Idle;
if MySpooler<>nil then
MySpooler^.SpoolOneChar;
end; (* ------------------------------------------- Idle *)
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ added: which file to spool, which port to use etc. ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
procedure TMyApp.FileToSpool;
type
SpoolDlgData = record
FileName : string[64];
Port : word;
HWAccess : word;
Baud : word;
Data : word;
Stop : word;
Parity : word;
FlowControl : word;
end;
var
Dialog : PDialog;
FileName : PInputLine;
Rectangle : TRect;
Button : PButton;
RadioButtons : PRadioButtons;
Text : PStaticText;
LabelText : PLabel;
RetCode : Word;
DialogData : SpoolDlgData;
PortNo,
BaudRate,
DataBits,
StopBits,
Parity,
FlowControl : word;
begin
(* ------------------------------------------------------------------ *)
(* *)
(* only 1 file allowed (demo only) *)
(* *)
(* ------------------------------------------------------------------ *)
if MySpooler<>nil then
begin
MessageBox( 'Spooler could be created only once.',
nil, mfInformation + mfOKButton );
exit;
end;
(* ------------------------------------------------------------------ *)
(* *)
(* OK: not active yet: present dialog *)
(* *)
(* ------------------------------------------------------------------ *)
Rectangle.Assign(2,1,77,20);
Dialog := New(PDialog,Init(Rectangle,'enter data for printing'));
Rectangle.Assign(3,9,34,10);
Text := New(PStaticText,Init(Rectangle,'printer connected via COMx:'));
Dialog^.Insert(Text);
Rectangle.Assign(3,3,27,4);
FileName := New(PInputLine,Init(Rectangle,64));
Rectangle.Assign(3,2,27,3);
LabelText := New(PLabel,Init(Rectangle,'name of file to print:',FileName));
Dialog^.Insert(LabelText);
Dialog^.Insert(FileName);
Rectangle.Assign(33,2,45,8);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('LPT 1',
NewSItem('LPT 2',
NewSItem('COM 1',
NewSItem('COM 2',
NewSItem('COM 3',
NewSItem('COM 4',nil))))))));
Rectangle.Assign(31,1,47,2);
LabelText := New(PLabel,Init(Rectangle,'outputting via:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(50,3,67,5);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('Yes',
NewSItem('No: use DOS',nil))));
Rectangle.Assign(50,2,67,3);
LabelText := New(PLabel,Init(Rectangle,'hardware-access:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(13,10,73,11);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem(' 300',
NewSItem(' 600',
NewSItem('1200',
NewSItem('2400',
NewSItem('4800',
NewSItem('9600',nil))))))));
Rectangle.Assign(2,10,13,11);
LabelText := New(PLabel,Init(Rectangle,'baud:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(19,11,45,12);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('8 bits ',
NewSItem('7 bits',nil))));
Rectangle.Assign(2,11,9,12);
LabelText := New(PLabel,Init(Rectangle,'data:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(19,12,45,13);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('1 bit ',
NewSItem('2 bits',nil))));
Rectangle.Assign(2,12,8,13);
LabelText := New(PLabel,Init(Rectangle,'stop:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(19,13,43,14);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('odd ',
NewSItem('even',nil))));
Rectangle.Assign(2,13,10,14);
LabelText := New(PLabel,Init(Rectangle,'parity:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(19,14,42,15);
RadioButtons:= New(PRadioButtons,Init(Rectangle,
NewSItem('XON/XOFF',
NewSItem('DTR',nil))));
Rectangle.Assign(2,14,16,15);
LabelText := New(PLabel,Init(Rectangle,'flow control:',RadioButtons));
Dialog^.Insert(LabelText);
Dialog^.Insert(RadioButtons);
Rectangle.Assign(13,16,21,18);
Button := New(PButton,Init(Rectangle,'O~K~',cmOK,bfDefault));
Button^.AmDefault := True;
Dialog^.Insert(Button);
Rectangle.Assign(48,16,60,18);
Button := New(PButton,Init(Rectangle,'Cancel',cmCancel,bfNormal));
Dialog^.Insert(Button);
Dialog^.SelectNext(False);
(* *)
(* set the default-values for the dialog *)
(* *)
with DialogData do
begin
FileName := '' ;
Port := 0; (* = LPT 1 *)
HWAccess := 0; (* = Yes *)
Baud := 5; (* = 9600 *)
Data := 0; (* = 8 bits *)
Stop := 0; (* = 1 bit *)
Parity := 0; (* = odd *)
FlowControl := 0; (* = XON/XOFF *)
end;
Dialog^.SetData(DialogData);
RetCode := DeskTop^.ExecView(Dialog);
if RetCode=cmOK then
Dialog^.GetData(DialogData);
Dispose(Dialog,Done);
(* ------------------------------------------------------------------ *)
(* *)
(* create Spooler-object *)
(* *)
(* ------------------------------------------------------------------ *)
if RetCode=cmOK then
begin
GetExtent( Rectangle );
with Rectangle do
begin
a.x := b.x - 9; (* we want it to appear in the *)
b.x := b.x - 1; (* upper right corner, in the *)
b.y := a.y + 1; (* right position of the menu *)
end;
MySpooler := new( PSPooler, Init(Rectangle, DialogData.FileName) );
insert( MySpooler );
if DialogData.Port<2 then
begin
(* following the code for outputting the data via LPT1 *)
case DialogData.Port of
0 : MySpooler^.SetParallel( Spool_LPT1 );
1 : MySpooler^.SetParallel( Spool_LPT2 );
end;
end
else
begin
(* if COM1 - COM4 is selected we must know more: *)
case DialogData.Port of
2 : PortNo := Spool_COM1;
3 : PortNo := Spool_COM2;
4 : PortNo := Spool_COM3;
5 : PortNo := Spool_COM4;
end;
case DialogData.Baud of
0 : BaudRate := Spool_300;
1 : BaudRate := Spool_600;
2 : BaudRate := Spool_1200;
3 : BaudRate := Spool_2400;
4 : BaudRate := Spool_4800;
5 : BaudRate := Spool_9600;
end;
case DialogData.Data of
0 : DataBits := Spool_8Bit;
1 : DataBits := Spool_7Bit;
end;
case DialogData.Stop of
0 : StopBits := Spool_1Stop;
1 : StopBits := Spool_2Stop;
end;
case DialogData.Parity of
0 : Parity := Spool_Odd;
1 : Parity := Spool_Even;
end;
case DialogData.FlowControl of
0 : FlowControl := Spool_FlowXONXOFF;
1 : FlowControl := Spool_FlowDTR;
end;
(* switch spooler to serial *)
MySpooler^.SetSerial( PortNo, BaudRate, DataBits, StopBits,
Parity, FlowControl);
end;
(* DOS or direct HW-access: *)
MySpooler^.UseDos(DialogData.HWAccess=1);
(* let's go: *)
MySpooler^.StartSpooling;
end;
end; (* ---------------------------------------------- FileToSpool *)
procedure TMyApp.NewDialog;
var
Bruce: PView;
Dialog: PDemoDialog;
R: TRect;
C: Word;
begin
R.Assign(20, 6, 60, 19);
Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
with Dialog^ do
begin
R.Assign(3, 3, 18, 6);
Bruce := New(PCheckBoxes, Init(R,
NewSItem('~H~varti',
NewSItem('~T~ilset',
NewSItem('~J~arlsberg',
nil)))
));
Insert(Bruce);
R.Assign(2, 2, 10, 3);
Insert(New(PLabel, Init(R, 'Cheeses', Bruce)));
R.Assign(22, 3, 34, 6);
Bruce := New(PRadioButtons, Init(R,
NewSItem('~S~olid',
NewSItem('~R~unny',
NewSItem('~M~elted',
nil)))
));
Insert(Bruce);
R.Assign(21, 2, 33, 3);
Insert(New(PLabel, Init(R, 'Consistency', Bruce)));
R.Assign(3, 8, 37, 9);
Bruce := New(PInputLine, Init(R, 128));
Insert(Bruce);
R.Assign(2, 7, 24, 8);
Insert(New(PLabel, Init(R, 'Delivery instructions', Bruce)));
R.Assign(15, 10, 25, 12);
Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
R.Assign(28, 10, 38, 12);
Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
SelectNext(False);
end;
C := DeskTop^.ExecView(Dialog);
Dispose(Dialog, Done);
end;
procedure TMyApp.NewWindow;
var
Window: PDemoWindow;
R: TRect;
begin
Inc(WinCount);
R.Assign(0, 0, 45, 13);
R.Move(Random(34), Random(11));
Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
DeskTop^.Insert(Window);
end;
var
MyApp: TMyApp;
begin
ReadFile;
MyApp.Init;
MyApp.Run;
MyApp.Done;
DoneFile;
end.