DP Tool Club 16

home *** CD-ROM | disk | FTP | other *** search

/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / maj / swag / printing.swg < prev next >

Wrap

Text File | 1994-08-29 | 138KB | 2 lines

SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00038 PRINTING/PRINTER MANAGEMENT ROUTINES 1 05-28-9313:55ALL SWAG SUPPORT TEAM HP Envelope Printing IMPORT 77 ε╡φÖ {In a following message, the Complete Turbo Pascal source code For DJENV.PASπis presented For all who may be interested in what it does, or illustrates.ππThe Program prints the "return" and "to:" addresses on a long ("#10")πbusiness sized envelope in a HP DeskJet series Printer.ππAlong the way it illustrates:ππ 1) How to test For existence of a specific Fileππ 2) How to Read from a structured-Type Fileππ 3) How to Write to a structured-Type Fileππ 4) How to do Text-Type output to any of: LPT1...LPT3, NUL, or a disk Fileπ With the same code.ππ 5) How to change fonts in PCL 3 (although this is not explained, it isπ done to give small print For the return address and larger printπ For the to: address.)ππ 6) How to use TechnoJock's Turbo toolkit For "full-screen I/O". There areπ three Procedures in the Program which REQUIRE the toolkit to Compile.π These routines could be modified For non-Full-Screen action whichπ would allow you to not use the TT toolkit. if you don't want to makeπ the modifications, and don't have the TT toolkit, you may File requestππ DJENV.ZIPππ from my system at 1:106/100. It has both the source code presented hereπ and a Compiled .EXE File, ready to roll.ππ if you'd like to play With it, but don't have a DJ or LASERJET-CompatibleπPrinter, then you may tell the Program to print to a disk File or even NULπinstead of LPT1, etc.ππ Whatever addresses you enter, plus the name of the "print device" youπuse, will be saved in the File DJENV.CFG . With a little work, DJENV.CFGπcould easily become a mini-database and allow you to retrieve from anyπnumber of previous envelope setups, instead of just the last one you used.πI may eventually do this, but no time frame is currently anticipated Forπit's Completion.ππ You may print 1 to many copies of the setup after you have entered it'sπinfo. The Program paUses beFore each envelope and gently nudges you toπprepare an envelope For printing and then to hit Return. (Any keyπreturning a key code will do as well as Return.)ππ Loading the envelopes is a Complete MANUAL operation. While the DJπhas a software command to load envelopes, you must still manuallyπposition the envelope For loading. if the envelope doesn't load cleanlyπ(and in my experience, about 1 in every 10 or 15 will go in crooked...), Iπfelt it would be better to deal With that BEForE attempting to print. Afterπthe envelope is in position to load, then it is necessary to hit two of theπpanel buttons together to have the DJ500 to pull the envelope intoπposition. When that is acComplished correctly, then hit Return to print toπthe envelope.ππHope some of you find this useful/interesting/maybe even helpful!π}ππProgram DJ_Envelopes;ππ{ This Program illustrates how to Program For envelope printingπ With the HP DeskJet series of Printer. It would possibly workπ For any PCL 3 (or better) Printer which can load envelopes.ππ note: Loading envelopes on the DJ Printers *IS* a bit trickyπ and requires cooperative envelopes. Be sure to read theπ part in your manual about use of envelopes, selecting goodπ Printer-use envelopes, and especially about LOADinG themπ manually. I have used the following inexpensive envelopesπ With some degree of success. They were purchased at aπ discount business/office supply store, BIZMART, but as theπ brand is national, you can probably find them most anywhere:ππ MEAD Management Series, no. 75604π Number 10 size, 4-1/8" x 9-1/2"π BARCODE# 43100 75064ππ (100 of them cost about $2.00)πππ This Program is PUBLIC doMAin and may be freely distributed, modified,π even SOLD. (if you can find somebody stupid enough to pay For a PDπ Program, MorE POWER to YOU! I would ask that you at least send meπ their names....)ππ The author is: Justin Marquez FidoNet 1:106/100 Houston, TX USAπ}ππUsesπ FASTTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π WinTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π IOTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π Crt, { Crt Unit For ClrScr }π Dos; { Req'd to be able to use the EXIST Procedure as I wrote it }ππConstπ Return_Size = #27+'&l0O'+ #27+'(10U' +#27+'(s1p6v0s41010bt2Q';π Addressee_Size = #27+'&l0O'+ #27+'(10U' +#27+'(s1p12v0s4103b1t2Q';π Config_File = 'DJENV.CFG';ππTypeπ Add_Strg = String[60];ππ Address_Data = Record { this is the Format of the "config File" }π Who_from: Array[1..5] of Add_Strg;π Last_to : Array[1..5] of Add_Strg;π PRN_DEV : String;π end;ππVarπ Return_Address,π Address : Array[1..5] of Add_Strg;ππ lst : Text;ππ Last_Data : Address_Data;π CF_Data : File of Address_Data; { going to be the config File }ππ Print_to: String;ππ n,π Counter,π How_Many : Integer;ππFunction EXIST(Filename :String): Boolean;π{ Determines if a File exists or not. NO WILDCARDS!π Main Program or Unit MUST have "Uses Dos;" in it!π}πVarπ Attr : Word;π f : File;πbeginπ Assign(f,Filename);π GetFAttr(f,Attr);π if Attr = 0 thenπ Exist := False elseπ Exist := True;πend; { of exist Function }ππProcedure DrawScreen1;π {Requires TechnoJock's toolkit, Used to set up For the full-screen I/O}πbeginπ ClrScr;π WriteCenter(1,Blue,White,' Enter Address Info, and hit F10 when done ...');π WriteCenter(2,Blue,White,' (Use CURSor keys For up & dn, RETURN For left &πright) ');π WriteAt( 1, 5, White,Blue,'RETURN ADDRESS inFO...');π WriteAt( 3, 6, White,Blue,' Line #1 :');π WriteAt( 3, 7, White,Blue,' Line #2 :');π WriteAt( 3, 8, White,Blue,' Line #3 :');π WriteAt( 3, 9, White,Blue,' Line #4 :');π WriteAt( 3,10, White,Blue,' Line #5 :');π WriteAt( 1,13, White,Blue,'ADDRESSEE inFO .... ');π WriteAt( 3,14, White,Blue,' Line #1 :');π WriteAt( 3,15, White,Blue,' Line #2 :');π WriteAt( 3,16, White,Blue,' Line #3 :');π WriteAt( 3,17, White,Blue,' Line #4 :');π WriteAt( 3,18, White,Blue,' Line #5 :');π WriteAt( 3,20, White,Blue,'Send Output to :');π WriteAt( 3,21, White,Blue,'[ Ex: LPT1 or LPT2 or NUL (For testing) ]');π WriteAt( 3,23, White,Blue,'Print How Many?:');πend; { of pvt Procedure drawscreen1 }ππProcedure FS_IO;π{ Requires TechnoJock's Turbo toolkit }πVarπ counter : Integer;πbeginπ Create_Fields(12);π { # U D L R x y }π Add_Field( 1,12, 2,12, 2,27, 6);π Add_Field( 2, 1, 3, 1, 3,27, 7);π Add_Field( 3, 2, 4, 2, 4,27, 8);π Add_Field( 4, 3, 5, 3, 5,27, 9);π Add_Field( 5, 4, 6, 4, 6,27,10);π Add_Field( 6, 5, 7, 5, 7,27,14);π Add_Field( 7, 6, 8, 6, 8,27,15);π Add_Field( 8, 7, 9, 6, 9,27,16);π Add_Field( 9, 8,10, 8,10,27,17);π Add_Field(10, 9,11, 9,11,27,18);π Add_Field(11,10,12,10,12,27,20);π Add_Field(12,11, 1,11, 1,27,23);ππ For n := 1 to 5 DoππString_Field(n,Return_Address[n],'**********************************************π****');π For n := 1 to 5 DoππString_Field(n+5,Address[n],'**************************************************'π);ππString_Field(11,Print_to,'**************************************************');π Integer_Field(12,How_Many,'',0,0);π PROCESS_inPUT(1);π Dispose_Fields;πend; { of Procedure FS_IO }ππProcedure Init;πbeginπ if ParamCount < 1π thenπ Print_to := 'LPT1'π elseπ Print_to := ParamStr(1);π if Exist(config_File)π thenπ beginπ Assign(CF_Data,ConFig_File); { How to READ a Record from a File }π ReSet(CF_Data);π Seek(CF_Data,0);π Read(CF_DATA,Last_Data);π Close(CF_Data);π With Last_Data doπ beginπ For n := 1 to 5 doπ beginπ Return_Address[n] := Who_From[n] ;π Address[n] := Last_to[n];π end;π Print_to := PRN_DEV;π end;π endπ elseπ beginπ Return_Address[1] :='';π Return_Address[2] :='';π Return_Address[3] :='';π Return_Address[4] :='';π Return_Address[5] :='';π Address[1] := '';π Address[2] := '';π Address[3] := '';π Address[4] := '';π Address[5] := '';π end;π How_Many := 1;πend;ππProcedure OutPut_to_DJ500;πbeginπ Assign(lst,Print_to);π ReWrite(lst);π Write(Lst,#27+'&l8D');π Write(lst,Return_Size);π For n := 1 to 5 Doπ WriteLn(lst,Return_Address[n]);π Write(Lst,#27+'&l5D');π Write(lst,Addressee_Size);π For n := 1 to 3 Do Writeln(lst);π For n := 1 to 5 Doπ WriteLn(lst,'π ',Address[n]);π WriteLn(lst,#12);π WriteLn(lst,#27+'E');π close(lst)πend;ππProcedure Save_Config_File;πbeginπ Assign(CF_Data,ConFig_File); { How to Write a Record to a File }π ReWrite(CF_Data);π With Last_Data doπ beginπ For n := 1 to 5 doπ beginπ Who_From[n] := Return_Address[n];π Last_to[n] := Address[n];π end;π PRN_DEV := Print_to;π end;π Seek(CF_Data,0);π Write(CF_DATA,Last_Data);π Close(CF_Data);πend;ππProcedure Pause;π{ Requires TechnoJock's Turbo toolkit }πbeginπ TempMessageBOX(20,10,Green,Blue,2,'Load an envelope (manually) and HitπRETURN.');πend;ππProcedure PRinT_ENVELOPES;πbeginπ ClrScr;π GotoXY(2,1);π Write('Printing Envelope #:');π Counter := 1;π if How_Many > 1π thenπ beginπ For Counter := 1 to How_Many Doπ beginπ WriteLn(' ',Counter);π Pause;π OutPut_to_DJ500;π end;π endπ elseπ beginπ WriteLn(' ',Counter,' ( and only 1 ...)');π Pause;π OutPut_to_DJ500;π end;πend;ππbeginπ Init;π DrawScreen1;π FS_IO;π PRinT_ENVELOPES;π Save_Config_File;πend.π 2 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-G-TST.PAS IMPORT 4 ε╡\ Usesπ Graph, Crt, kasutils,ljGraph;ππVar gd,gm : Integer;π y0,y1,y2,x1,x2 : Integer;πbeginπ egavga_exe;π gd := detect;π InitGraph(gd,gm,'');π setcolor(10);π line(50,100,431,242);π setcolor(blue);π Y0 := 10;π Y1 := 60;π Y2 := 110;π X1 := 10;π X2 := 50;π Bar3D(X1, Y0, X2, Y1, 10, topOn);π Bar3D(X1, Y1, X2, Y2, 10, topoff);π printpause(False);π readln;π closeGraph;πend. 3 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-GRAPH.PAS IMPORT 62 ε╡φ~ { PW> Does anyone have any code or info on how to Program Graphics on an HPπ PW> Laserjet?ππ--------------<start here >------------π}ππUnit LJGraph;π{$F+,O+}πInterfaceππConstπ PorTRAIT =0;π LandSCAPE =1;π GRAYSCALE =2;ππVarπ SCRNIMAGE :Pointer;π NEGATIVE :Boolean;π PROMPTPOS :Integer;π GraphDRIVER,GraphMODE:Integer;ππProcedure PRinTPAUSE(inVERT:Boolean);ππImplementationππUses Graph,Printer,Crt;ππ Procedure PROMPTLinE(MSG:String);π Varπ CHRHT,π MAXX,π MAXY :Integer;πππ beginπ MAXX:=GETMAXX;π MAXY:=GETMAXY;π SETCOLor(BLACK);π SETTextSTYLE(DEFAULTFONT,HorIZDIR,1);π SETTextJUSTifY(CENTERText,toPText);π CHRHT:=TextHEIGHT('H');π PROMPTPOS:=MAXY-(CHRHT+4);π GETMEM(SCRNIMAGE,IMAGESIZE(0,PROMPTPOS,MAXX,MAXY));π GETIMAGE(0,PROMPTPOS,MAXX,MAXY,SCRNIMAGE^);π BAR(0,PROMPTPOS,MAXX,MAXY);π RECTANGLE(0,PROMPTPOS,MAXX,MAXY);π OUTTextXY(MAXX div 2,MAXY-(CHRHT+2),MSG);π end;ππ Function FMT(MSGPOS:Real):Integer;π Varπ WIDTH :Integer;ππ beginπ WIDTH:=6;π if(MSGPOS<1000.0)thenπ DEC(WIDTH);π if(MSGPOS<100.0)thenπ DEC(WIDTH);π if(MSGPOS<10.0)thenπ DEC(WIDTH);π FMT:=WIDTH;π end;ππ Function SETGRAYSCALE(SCANLinE,GPIXEL:Integer):Integer;π Varπ GRAY :Integer;ππ beginπ GRAY:=0;π if(GraphDRIVER=CGA) and(GraphMODE<>CGAHI)thenπ beginπ Case SCANLinE ofπ 0:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 9;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 6;π end;π 1:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 4;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 11;π end;π 2:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 13;π end;π 3:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 9;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 6;π end;π end;π endπ elseπ beginπ Case SCANLinE ofπ 0:π beginπ if GPIXEL and 4<>0 thenπ GRAY:=GRAY or 5;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 10;π end;π 1:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 8;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 5;π end;π 2:π beginπ if GPIXEL and 4<>0 thenπ GRAY:=GRAY or 5;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 10;π end;π 3:π beginπ if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 5;π end;π end;π end;π if NEGATIVE thenπ GRAY:=GRAY xor $0F;π SETGRAYSCALE:=GRAY;π end;ππ Procedure LJGraphIC(MODE:Integer);π Constπ ESC =#$1B;π GRendS =ESC+'*rB';π GRinIT =ESC+'E'+ESC+'&11H'+ESC+π '&10'+ESC+'*pOY'+ESC+'*t';ππ Varπ I,π J,π K,π P,π Q,π M,π MAXX,π MAXY :Integer;π XASP,π YASP :Word;π XPRN,π YPRN,π PRSTEP,π ASPR :Real;ππ beginπ PUTIMAGE(0,PROMPTPOS,SCRNIMAGE^,COPYPUT);π MAXX:=GETMAXX+1;π MAXY:=GETMAXY+1;π GETASPECTRATIO(XASP,YASP);π ASPR:=XASP/YASP;π SETVIEWPorT(0,0,MAXX,MAXY,False);π Case MODE ofπ PorTRAIT:π beginπ XPRN:=690.0;π YPRN:=500.0;π PRSTEP:=7.2/ASPR;π Write(LST,GRinIT,'100R');π For J:=0 to MAXY doπ beginπ Write(LST,ESC,'&A',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');π For I:=0 to MAXX div 8 doπ beginπ M:=0;π For K:=0 to 7 doπ beginπ M:=M SHL 1;π if GETPIXEL(I*8+K,J)<>0 thenπ inC(M);π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π LandSCAPE:π beginπ XPRN:=1000.0;π YPRN:=1000.0;π PRSTEP:=9.6*ASPR;π Write(LST,GRinIT,'75R');π For J:=0 to MAXX-1 doπ beginπ Write(LST,ESC,'&a',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');π For I:=0 to MAXY div 8 doπ beginπ M:=0;π For K:=0 to 7 doπ beginπ M:=M SHL 1;π if GETPIXEL(MAXX-J-1,I*8+K)<>0 thenπ inC(M);π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π GRAYSCALE:π beginπ XPRN:=1000.0;π YPRN:=1000.0;π PRSTEP:=2.4*ASPR;π Write(LST,GRinIT,'300R');π For J:=0 to MAXX doπ For P:=0 to 3 doπ beginπ Write(LST,ESC,'&a',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXY div 2,'W');π For I:=0 to MAXY div 2 doπ beginπ M:=0;π For K:=0 to 1 doπ beginπ M:=M SHL 4;π M:=M or SETGRAYSCALE(P,GETPIXEL(MAXX-J,I*2+K));π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π end;π Write(LST,#$0C,ESC,'&10',ESC,'(8U',ESC,'(sp10h12vsb0T',ESC,'&11H');π end;πππ Procedure PRinTPAUSE(inVERT:Boolean);π Varπ CH :Char;π doNE :Boolean;ππ beginπ DETECTGraph(GraphDRIVER,GraphMODE);π doNE:=False;π NEGATIVE:=inVERT;π While not doNE doπ beginπ PROMPTLinE('PRESS THE <P> KEY to PRinT THIS Graph '+π 'or ANY OTHER to Exit....');π While KeyPressed doπ CH:=ReadKey;π CH:=ReadKey;π PUTIMAGE(0,PROMPTPOS,SCRNIMAGE,COPYPUT);π Case UPCase(CH)ofπ 'P':π beginπ LJGraphIC(GRAYSCALE);π doNE:=True;π end;π elseπ doNE:=True;π end;π DISPOSE(SCRNIMAGE);π end;π end;πend.π{π---------- stop here --------πSo first you init the Graph driver. Next you draw the Graph you want. thenπyou use printpause afterwards you can close the Graphdriver.π} 4 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-GRPH2.PAS IMPORT 18 ε╡ê >Does anyone have any code or info on how to print Graphics on an HPπ>Laserjet?ππ The best thing to do would be to purchase the Technical ReferenceπManual through HP Support Materials (800)227-8164. (I don't know if thisπis an international number since you are in Canada) I don't own aπLaserJet, but own a DeskJet and my manual sold For $21.95. They go intoπgreat detail on the codes For all of the Text and Graphic Functions.ππ There are some books on Laser Printer Graphics you could find in aπbigger public library or university library that would be helpfulπalso.ππ Here are a few minor HP-PCL5 commands that will give you someπcapabilities to tie you over (They refer to this as Raster GraphicπMode):ππ I will give these codes in hex, if you need another Format let me know )ππ Start Raster Graphicsπ At leftmost position 1B 2A 72 30 41π At current cursor position 1B 2A 72 31 41ππ end Raster Graphics 1B 2A 72 62 43ππ Select Resolutionπ 75 D.P.I. 1B 2A 74 37 35 52π 100 D.P.I. 1B 2A 74 31 30 30 52π 150 D.P.I. 1B 2A 74 31 35 30 52π 300 D.P.I. 1B 2A 74 33 30 30 52ππ Transfer Raster Graphicsπ Number of Bytes 1B 2A 62 #of Bytes to send# 57 #data#ππ Raster Graphics can be thought of as being a one pin dot matrixπPrinter to an extent... think of it as drawing a horizontal line inπbinary:π 11111111 +------+π 10000001 -> | |π 11111111 +------+ππwould be:π 1B 2A 72 30 41π 1B 2A 74 31 30 30 52π 1B 2A 62 01 57 FFπ 1B 2A 62 01 57 81π 1B 2A 62 01 57 FFπ 1B 2A 72 62 43ππat 100 DPI For example.ππ My apologies to the moderator if this is off topic, I understand theπfrustration resulting from buying a $500 (or $2500 in the Case of theπLaserJet) Printer and not being able to do squat With it Until you canπfind the inFormation they should have put in the user's manual in theπfirst place! (8->) Daveππ 5 05-28-9313:55ALL GREG VIGNEAULT Printing from CmdLine IMPORT 33 ε╡gI { The following Program, LPRINT, illustrates how to do control a }π{ Printer directly without using the BIOS (Printers connected to }π{ the parallel port, not serial Printers connected to an RS-232 }π{ port). }π{ LPRINT checks to see if you want to print a line from the command }π{ prompt, as in: }π{ LPRINT Hello, World! }π{ If there's no command input, LPRINT checks For Characters at the }π{ "standard input," so you can print Files or directories using }π{ redirection or piping: LPRINT < myFile.pas }π{ DIR | LPRINT }π{ LPT1 is used. You can modify LPRINT to use another, or be able to }π{ specify which Printer via the command line (eg. /2 For LPT2,etc.) }π{ This source code is a bit cramped, to fit into one message. }π{ }ππProgram LPRINT;πUsesπ Dos;πConstπ BusyB =$80; { status port 'busy' bit }π AckB =$40; { status port 'ack' bit }πVarπ DataP,π Strobe,π Status, { assigned lpt i/o ports }π MaxWait : Word; { seconds before timing out }π Done : Boolean; { sanity clause }π Reg : Registers; { For Dos i/o }π txtptr : Byte; { counter Byte }ππProcedure VerifyPrinter( Var Printer, Status, Strobe : Word );π{ check For presence of specified Printer - returning ports }πbeginπ if Printer in [1..3] then { must be known }π beginπ DEC( Printer ); { For 0..2 }π Printer := MemW[$40 : (Printer + 8 + Printer * 2)];π if ((Port[Printer + 1] and AckB) = 0) thenπ Printer := 0 { to say it's not there }π elseπ beginπ Status := Printer + 1;π Strobe := Printer + 2;π endπ endπend; {VerifyPrinter}ππProcedure Print( DataP : Word; chout : Byte; Var Done : Boolean);π{ send Character to Printer port, With busy timeout and feedback }πVarπ WaitTime : LongInt;π Timer : LongInt Absolute 0:$046c;π BusyWait : Word;πbeginπ BusyWait := 0;π WaitTime := Timer;π While ((Port[Status] and BusyB) = 0) and (BusyWait < MaxWait * 19) doπ { wait up to MaxWait seconds For non-busy state }π BusyWait := Word( Timer - WaitTime );π if BusyWait >= (MaxWait * 19) then { Printer "busy" For too long? }π Done := False { failed }π elseπ beginπ Port[DataP] := chout; { send the Char data}π Port[Strobe] := $0c; { strobe it in }π Port[Strobe] := $0d; { reset strobe }π Done := True; { success }π end {else}πend; {Print}ππbegin {LPRINT}π WriteLn(#10, 'LPRINT v1.0 G.S.Vigneault', #10);π DataP := 1; { LPT1 }π VerifyPrinter( DataP, Status, Strobe );π { DataP will be 0 now if requested Printer didn't respond }π if DataP = 0 thenπ beginπ WriteLn('Printer not detected!',#10,#7);π Halt(1);π end;π MaxWait := 10; { max wait 10sec before timing out lpt }π if ParamCount = 0 then { no command-line input? }π { handle redirected and piped }π Repeatπ Reg.AH := $b; { to see if a Char is available }π MsDos( Reg );π if Reg.AL <> 0 thenπ beginπ Reg.AH := 8; { get the Char }π MsDos( Reg ); { via Dos }π Print( DataP, Reg.AL, Done );{ lprint it }π end; {if}π Until (Reg.AL = 0) or not Doneπ else { print the command line Text }π beginπ txtptr := $82;π Repeatπ Print( DataP, Mem[PrefixSeg:txtptr], Done );π INC( txtptr );π Until (Mem[PrefixSeg:txtptr] = 13) or not Done;π if Done thenπ Print( DataP, 10, Done); { lf }π end;πend {LPRINT}.π(********************************************************************)π 6 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER.PAS IMPORT 53 ε╡)U {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π{Allow overlays}π{$F+,O-,X+,A-}π{$ENDIF}ππ{$DEFINE AssignLstDevice}ππUNIT Printer;ππINTERFACEππCONSTππ fmClosed = $D7B0; { magic numbers for Turbo }π fmInput = $D7B1;π fmOutput = $D782;π fmInOut = $D7B3;ππ IO_Invalid = $FC; { invalid operation eg. attempt to write }π { to a file opened in fmInput mode }ππ LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');ππ LPTPort : BYTE = 0;ππVARπ Lst : TEXT; { for source compatability with TP3 }ππFUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;π { status of LPTNo via ROM BIOS int 17h func 2h }π INLINE (π $5A / { pop DX ; get printer number}π $B4 / $02 / { mov AH,02 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππFUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;π { send a character to LPTNo via ROM BIOS int 17h func 0h }π INLINE (π $5A / { pop DX ; get printer number}π $58 / { pop AX ; get char}π $B4 / $00 / { mov AH,00 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππPROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππPROCEDURE OutputToFile (FName : STRING);π {redirect printer output to file }ππFUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;ππFUNCTION Printer_OK : BOOLEAN;ππPROCEDURE SelectPrinter (LPTNum : BYTE);ππPROCEDURE ResetPrinter; { only resets printer 0 }ππIMPLEMENTATIONππTYPEπ TextBuffer = ARRAY [0..127] OF CHAR;ππ TextRec = RECORDπ Handle : WORD;π Mode : WORD;π BufSize : WORD;π Private : WORD;π BufPos : WORD;π BufEnd : WORD;π BufPtr : ^TextBuffer;π OpenFunc : POINTER;π InOutFunc : POINTER;π FlushFunc : POINTER;π CloseFunc : POINTER;π { 16 byte user data area, I use 4 bytes }π PrintMode : WORD; { not currently used}π LPTNo : WORD; { LPT number in [0..2] }π UserData : ARRAY [1..12] OF CHAR;π Name : ARRAY [0..79] OF CHAR;π Buffer : TextBuffer;π END;πCONSTπ LPTFileopen : BOOLEAN = FALSE;ππVARπ LPTExitSave : POINTER;ππ PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);π { call macro to send char to LPTNo. If bit 4, the Printer Selected bit }π { is not set upon return, it is assumed that an error has occurred. }ππ BEGINπ ErrorCode := DoInt17 (Ch, LPTNo);π IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }π ErrorCode := 0 { no error }π { if bit 4 is not set, error is passed untouched and placed in IOResult }π END;ππ FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;π { A do nothing, no error routine }π BEGINπ LstIgnore := 0 { return 0 for IOResult }π END;ππ FUNCTION LstOutput (VAR F : TextRec) : INTEGER;π { Send whatever has accumulated in the Buffer to int 17h }π { If error occurs, return in IOResult. See Inside Turbo }π { Pascal chapter of TP4 manual for more info on TFDD }π VARπ I : WORD;π ErrorCode : INTEGER;ππ BEGINπ LstOutput := 0;π WITH F DO BEGINπ FOR I := 0 TO PRED (BufPos) DO BEGINπ Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }π IF ErrorCode <> 0 THEN BEGIN { if error }π LstOutput := ErrorCode; { return errorcode in IOResult }π EXIT { return from function }π ENDπ END;π BufPos := 0π END;π END;ππ PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππ BEGINπ WITH TextRec (F) DOπ BEGINπ Mode := fmClosed;π BufSize := SIZEOF (Buffer);π BufPtr := @Buffer;π OpenFunc := @LstIgnore; { you don't open the BIOS printer functions }π CloseFunc := @LstIgnore; { nor do you close them }π InOutFunc := @LstOutput; { but you can Write to them }π FlushFunc := @LstOutput; { and you can WriteLn to them }π LPTNo := LPTNumber; { user selected printer num (in [0..2]) }π MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }π BufPos := 0; { reset BufPos }π END;π END;ππ PROCEDURE OutputToFile (FName : STRING);π BEGINπ ASSIGN (Lst, FName);π REWRITE (Lst);π LPTFileopen := TRUE;π END;ππ FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;π VARπ Status : BYTE;π BEGINπ Status := GetROMPrinterStatus (LPTNum);π IF (Status AND $B8) = $90 THENπ PrinterStatus := 0 {all's well}π ELSE IF (Status AND $20) = $20 THENπ PrinterStatus := 1 {no Paper}π ELSE IF (Status AND $10) = $00 THENπ PrinterStatus := 2 {off line}π ELSE IF (Status AND $80) = $00 THENπ PrinterStatus := 3 {busy}π ELSE IF (Status AND $08) = $08 THENπ PrinterStatus := 4; {undetermined error}π END;ππ FUNCTION Printer_OK : BOOLEAN;π VARπ Retry : BYTE;π BEGINπ Retry := 0;π WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);π Printer_OK := (PrinterStatus (LPTPort) = 0);π END; {PrinterReady}ππ PROCEDURE SelectPrinter (LPTNum : BYTE);π BEGINπ IF (LPTNum >= 0) AND (LPTNum <= 3) THENπ LPTPort := LPTNum;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);π END;ππ PROCEDURE ResetPrinter;π VARπ address : INTEGER ABSOLUTE $0040 : $0008;π portno, DELAY : INTEGER;π BEGINπ portno := address + 2;π Port [portno] := 232;π FOR DELAY := 1 TO 2000 DO {nothing} ;π Port [portno] := 236;π END; {ResetPrinter}ππ PROCEDURE LptExitHandler; FAR;π BEGINπ IF LPTFileopen THEN CLOSE (Lst);π ExitProc := LPTExitSave;π END;ππBEGINππ LPTExitSave := ExitProc;π ExitProc := @LptExitHandler;ππ {$IFDEF AssignLstDevice}ππ LPTPort := 0;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);ππ {$ENDIF}ππEND.π 7 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER1.PAS IMPORT 18 ε╡v {πI am writing a Program that Uses the Printer to (whatelse?) printπout a report. Now, the problem that I am having is that the PrinterπFunction in TP 6.0 (ie Writeln (lst,'BLA BLA BLA');) Dosn'tπcheck For errors (if the Printer is not on, or is not online)πbasicaly I need something that weill check and give out theπfamous line ('Printer not Ready (A)bort (R)etry')πππYour're in luck, I just got a new Printer and started writing routines toπcontrol it (TFDD etc..). These are probably the most important ones:ππππ{ note: This routines are not throughly tested on Various Printers.}π{ Thus it may of may not work on your Type of Printer. }π{ But, as a rule, experiment With it and have fun............}ππUsesπ Dos;ππFunctio PrinterOutofPaper( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $02;π Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs); { Print Service Please }π PrinterOutofPaper := (Regs.AH and $20 = $20)πend;ππFunction PrinterReady( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $02;π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs)π PrinterReady := (AH and $80 = $80) and { Printer Busy? }π (AH and $10 = $10) and { Printer Online? }π (AH and $08 = $00) { Printer Error? }π end;πend;ππProcedure PrintChar(Port: Byte; Ch: Char);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AL := ord(Ch); { Char to print }π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π AH := $00; { Print Char Service }π Intr($17, Regs); { Call Bios }π endπend;ππProcedure BootPrinter( Port: Byte);π { Initializes IBM- or EPSON- Compatible Printer }π { Other Printers may not understand this command }π { and may produce unwanted results }πVarπ Regs : Registers;πbeginπ Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Regs.AH := $01;π Intr($17, Regs)πend;π 8 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER2.PAS IMPORT 17 ε╡â {πI am looking For something like in BASIC where you could ON ERRO GOSUBπand anytime there was an error the Program re-routed..ππIt Sounds like you're after two things; a method of checking your Printerπand a means of trapping runtime errors.π}πFunction PrinterReport:Byte;π{ This Function requires the Dos Unit. Returned values mean the following -π 0 = Printer is okayπ 1 = Printer is out of paperπ 2 = Printer is offlineπ 3 = Printer is busyπ 4 = God knows what's wrong With the Printer but I'd get an engineer out.}πVarπ Regs : Registers;πbeginπ With Regs doπ beginπ Ah := 2;π Dx := LPTport;π intr($17,Regs);π if (Ah and $B8) = $90 then PrinterReport := 0π else if (Ah and $20) = $20 then PrinterReport := 1π else if (Ah and $10) = $00 then PrinterReport := 2π else if (Ah and $80) = $00 then PrinterReport := 3π else if (Ah and $08) = $08 then PrinterReport := 4;π end;πend; { of Function }ππ{πAs For trapping runtime errors, all you have to do is replace theπstandard Exit Procedure With your own. For example...π}ππProgram JohnMajorGoosedTheCook;πVarπ SavedExitPoint : Pointer; { This holds the old Exit proc value }π Number : Integer;ππ{$F+}πProcedure MyExitProc;π{$F-}πbeginπ if errorAddr <> NIL then { if you got a runtime error... }π beginπ Writeln ('The Programmer got it wrong again. There has been an');π Writeln ('error at ',seg(errorAddr^), ':', ofs(errorAddr^));π Writeln ('with an Exit code of ',exitCode);π Writeln ('Please call him on 123-4567 and give him dogs abuse.');π errorAddr := NIL; { which cancels the runtime error address...}π ExitCode := 0; { which cancels the runtime error code }π end;π Exitproc := SavedExitPoint; { restore the old Exit Procedure...}πend; { of Procedure }ππbeginπ SavedExitPoint := ExitProc; { Save the old Exit Procedure... }π ExitProc := @MyExitProc; { ...and replace it With your own }π Number := 0; { Uh oh... }π Writeln (4 div Number); { Oh dear...}πend. { of PROGRAM }π 9 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER3.PAS IMPORT 19 ε╡╘Ω Unit Myprint;π{$D-,I-,S-}πInterfaceππUses Dos;ππVarπ Prt : Array[1..2] of Text;π Lst : Text Absolute Prt;ππFunction PrinterStatus(p: Byte): Byte;πFunction PrinterReady(Var b : Byte; p: Byte): Boolean;ππImplementationππProcedure RawMode(Var L); { make sure that device is in raw mode }π Varπ regs : Registers;π beginπ With regs do beginπ bx := TextRec(L).Handle; { place the File handle in bx }π ax := $4400; { setup For Function $44 sub-Function 0 }π MSDos(regs); { execute Dos Function }π dl := dl or $20; { bit 5 = raw mode }π dh := 0; { set dh to zero }π ax := $4401; { setup For Function $44 sub-Function 1 }π MSDos(regs) { execute Dos Function }π end; { With }π end; { RawMode }ππFunction PrinterStatus(p: Byte): Byte;π { Returns the Printer status. LPT1=p=1, LPT2=p=2 }π Var regs : Registers; { from the Dos Unit }π beginπ With regs do beginπ dx := p - 1; { The Printer number }π ax := $0200; { The Function code For service wanted }π intr($17,regs); { $17= ROM bios int to return Printer status}π PrinterStatus := ah;{ Bit 0 set = timed out }π end; { 1 = unused }π end; { 2 = unused }π { 3 = I/O error }π { 4 = Printer selected }π { 5 = out of paper }π { 6 = acknowledge }π { 7 = Printer not busy }ππFunction PrinterReady(Var b : Byte; p: Byte): Boolean;π beginπ b := PrinterStatus(p);π PrinterReady := (b = $90) { This may Vary between Printers }π end;ππbeginπ assign(Prt[1],'LPT1');π reWrite(Prt[1]);π RawMode(Prt[1]);π assign(Prt[2],'LPT2');π reWrite(Prt[2]);π RawMode(Prt[2]);πend.ππ 10 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER4.PAS IMPORT 38 ε╡J (*πI am trying to figure out how to trap errors as they occur in myπProgram and send messages to the user.. The most common error would be aπfailed attempt to print but I don't know how to not stop the Programπwhen an error occurrs. You see, I don't want to have an {$I-},{$I+}πafter every time the Printer prints..πππnot having any details of what you are doing, I'll take a stab in the dark.πHave an output routine and pass it a String. The output routine would takeπthe String and sent it to the Printer. ( Since you mentioned Printer, Iπassume this is where you wish to send all output.) Now have an output routineπFor the screen. Ah heck, here's an example. <g> This is some code I wrote toπoutput Various things to the Printer. No doubt some will claim to have betterπsolutions. That's fine, but here's mine. There is a routine you will seeπcalled OUTCON(s : String; CH : Char); It is a routine to send output to theπscreen and inForm the user that there is a problem. of course that's aπdifferent topic then sending output to the Printer. Hope this helps.π*)ππConstπ TimedOut = $01; { Used to determine the Type of Printer error }π IOError = $08;π OutofPaper = $20;π notBusy = $80;π TestAll = TimedOut+IOError+OutofPaper;π NoUL = False;π UL = True;ππVarπ PrnStatus : Byte;ππFunction PrinterReady : Boolean;π{ checks the status of the Printer and returns True if ready to recieve a Charaπ{ This Function will return the status of your Printer. Status }π{ should be interpreted as follows: (x'90' (d'144') is "Ready"): }π{ $01 = Printer Time-out $02 = not Used }π{ $04 = not Used $08 = I/O Error }π{ $10 = Printer Selected $20 = Out of Paper }π{ $40 = Acknowledge $80 = not Busy }πVarπ Regs : Registers;π TempStatus : Byte;πbeginπ With Regs Doπ beginπ DX := 0;π AX := $0200;π Intr($17,Regs);π PrnStatus := Hi(AX);π TempStatus := PrnStatus;π if TempStatus and TestAll = $00 then PrinterReady := Trueπ else PrinterReady := False;π end;πend; { Function PrinterReady }ππProcedure GetPrnError(Var ESC : Boolean);π{ gets the error that occured With the Printer and gives the user a chance to }π{ correct the problem and continue. }πVarπ CH : Char;πbeginπ Repeatπ PrnStatus := PrnStatus and TestAll;π Case PRnStatus ofπ TimedOut : OutCon('Printer timed out. Retry??? (Y/N)',CH);π IOError : OutCon('An IOError has occured. Retry??? (Y/N)',CH);π OutofPaper : OutCon('Printer out of paper. Retry??? (Y/N)',CH);π else OutCon('A Print Device Error has occured. Retry??? (Y/N)',CH);π end;π if CH = 'N' then esc := True;π Until ESC or PrinterReady;πend;ππFunction EscapePushed : Boolean;π{ Checks the keyboard buffer For a Character and test to see if it was the }π{ Esc key. if it was it returns True else it returns False. }πVarπ CH : Char;πbeginπ if KeyPressed then { Check the keyboard buffer For a Character }π beginπ CH := ReadKey; { if Character then check it }π CH := UpCase(CH);π if Ch = Chr(27) then EscapePushed := Trueπ else EscapePushed := False;π endπ else EscapePushed := False;πend; { EscapePushed }ππProcedure ConfirmQuit(Var ESC : Boolean);π{ confirms that the user wants to quit printing }πVarπ CH : Char;πbeginπ OutCon('Cancel all print jobs? (Y/N)',Ch);π if CH = 'Y' then ESC := Trueπ else ESC := False;πend;ππProcedure FFeed;π{ sends a Form feed command to the Printer }πbeginπ Write(LST,#12);πend;ππProcedure PrintCh(CH : Char;π Underline : Boolean;π Var OK : Boolean);π{ Writes a Single Character to the Printer }πbeginπ if UnderLine then {$I-} Write(LST, #27#45#1, CH, #27#45#0) {$I+}π else {$I-} Write(lst,CH); {$I+}π if Ioresult <> 0 then OK := Falseπ else OK := True;πend;ππProcedure WriteStr(TheStr : String;π Return, UnderLine : Boolean;π Var ESC : Boolean);πVarπ PrnReady : Boolean;π OK : Boolean;π I : Byte;πbeginπ Repeatπ PrnReady := PrinterReadyπ if not PrnReady then GetPrnError(ESC);π Until PrnReady or ESC;π I := 1;π While PrnReady and not Esc and (I <> Length(theStr)+1) doπ beginπ PrnReady := PrinterReadyπ if not PrnReady then GetPrnError(ESC);π if not ESC then PrintCh(theStr[I],UnderLine,OK);π if not esc then if EscapePushed then confirmQuit(Esc);π if OK then Inc(I);π end;π if PrnReady and not ESC and RETURN then {$I-} Writeln(LST); {$I+}πend;π 11 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER5.PAS IMPORT 8 ε╡φü {π EPSON Printer. I'm using TP7.0. Everythings works fine except oneπ situation that occured when a Character 26 (Ctrl-Z which is Eof) is inππThis may be the easy way out, but why not just use BIOS interrupt $17?πIt's probably slower, but it'll work.π}ππType PGraphics : ^Graphics;π Graphics : Array [1..65535] of Byte;ππFunction InitPort (PortNum : Byte) : Byte; {returns status}πVar Regs : Registers;πbeginπ Regs.DX := PortNum;π Intr ($17, Regs);π InitPort := Regs.AL;π end;ππProcedure OutStreamofStuff (PortNum : Byte; Where : PGraphics; Len : Word);πVar Count : Word; Regs : Registers;πbeginπ Regs.DX := NumPort;π For Count := 1 to Len doπ beginπ Regs.AL := ^Where[Count];π end;π end;ππInitPort returnsπ 144 Printer OKπ 24 Printer not OKπ 184 Printer is offπ 12 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER6.PAS IMPORT 12 ε╡v {πI am writing a Program that Uses the Printer to (whatelse?) printπout a report. Now, the problem that I am having is that the PrinterπFunction in TP 6.0 (ie Writeln (lst,'BLA BLA BLA');) Dosn'tπcheck For errors (if the Printer is not on, or is not online)ππ You can determine the Various states of the Printer With Intr 17H -π Function 02H. The value returned in AH will be:ππ bit if setπ 0 - Printer timed outπ 1 - unusedπ 2 - unusedπ 3 - i/o errorπ 4 - Printer selectedπ 5 - out of paperπ 6 - Printer acknowledgeπ 7 - Printer not busyππ For example:π}πFunction PrinterReady : Boolean;πVarπ reg : Registers;π Status : Byte;ππbeginπ reg.AH := $02;π reg.DX := $00; {..0=LPT1, 1=LPT2, etc }π intr($17,reg);ππ Status := reg.AH and $41; {..isolate bits 0,3,5 }π if Status <> 0 thenπ PrinterReady := Falseπ elseπ PrinterReady := True;πend;ππ{πbasicaly I need something that weill check and give out theπNB>famous line ('Printer not Ready (A)bort (R)etry')ππThe way I've handled this in the past is to check PrinterReady beForeπeach Write/WriteLn statement (not very eloquant). A better way to doπthis might be to hook it to an interrupt, checking the status every fewπseconds.π} 13 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER7.PAS IMPORT 15 ε╡┤▒ {Your're in luck, I just got a new Printer and started writing routines toπcontrol it (TFDD etc..). These are probably the most important ones:ππππ note: This routines are not throughly tested on Various Printers.π Thus it may of may not work on your Type of Printer.π But, as a rule, experiment With it and have fun............}ππUsesπ Dos;ππFunctio PrinterOutofPaper( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $02;π Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs); { Print Service Please }π PrinterOutofPaper := (Regs.AH and $20 = $20)πend;ππFunction PrinterReady( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $02;π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs)π PrinterReady := (AH and $80 = $80) and { Printer Busy? }π (AH and $10 = $10) and { Printer Online? }π (AH and $08 = $00) { Printer Error? }π endπend;ππProcedure PrintChar(Port: Byte; Ch: Char);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AL := ord(Ch); { Char to print }π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π AH := $00; { Print Char Service }π Intr($17, Regs); { Call Bios }π endπend;ππProcedure BootPrinter( Port: Byte);π { Initializes IBM- or EPSON- Compatible Printer }π { Other Printers may not understand this command }π { and may produce unwanted results }πVarπ Regs : Registers;πbeginπ Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Regs.AH := $01;π Intr($17, Regs)πend;π 14 06-22-9309:11ALL SWAG SUPPORT TEAM Write to CON and PRN IMPORT 37 ε╡≈V UNIT ConPrnIO;π{ UNIT TO WRITE TO SCREEN AND PRINTER AT THE SAME TIME }ππINTERFACEππ USES DOS;π VARπ ConPrn : Text;ππ PROCEDURE SetLptNbr(PrinterPort: Byte);ππIMPLEMENTATIONππ VARπ IOBuffer : ARRAY[0..255] OF Char;π OldExitProc : Pointer;ππ{$F+}π PROCEDURE ExitConPrn;π BEGINπ ExitProc := OldExitProc;π Close(ConPrn)π END;ππ{------------------------------}ππ PROCEDURE SetLptNbr;ππ FUNCTION NbrLpts: Integer;π VARπ Regs : Registers;π BEGINπ Intr($11,Regs);π NbrLpts := Regs.AH SHR 6π END;πππ BEGINπ IF NbrLpts = 0 THENπ BEGINπ WriteLn('No printer port installed');π Halt(1)π END;ππ WITH TextRec(ConPrn) DOπ BEGINπ IF PrinterPort <= NbrLpts THENπ UserData[1] := PrinterPort - 1π ELSEπ UserData[1] := 0 {Default to LPT1}π ENDπ END;ππ{------------------------------}ππ FUNCTION OutPrn(VAR F: TextRec; ch : Char):π Integer;π FUNCTION GetPrnStatus(PrnPort: Byte): Boolean;ππ VARπ Regs : Registers;π NbrPasses : Byte;π CONSTπ Retries : Byte = 100;ππ BEGINππ NbrPasses := 0;π GetPrnStatus := TRUE;ππ WITH Regs DOπ BEGINπ REPEATπ AH := $02;π DX := F.UserData[1];π Intr($17,Regs);π AH := AH AND $90;π IF (AH <> $90) ANDπ (NbrPasses < Retries) THENπ Inc(NbrPasses)π UNTIL (NbrPasses > Retries) ORπ (AH = $90);π IF AH <> $90 THENπ GetPrnStatus := FALSE;π ENDπ END;πππ VARπ Regs : Registers;π ChByte : Byte;ππ BEGINπ ChByte := Ord(ch);π WITH Regs DOπ BEGINπ IF GetPrnStatus(F.UserData[1]) THENπ BEGINπ AH := $00;π AL := ChByte;π DX := F.UserData[1];π Intr($17,Regs);π OutPrn := 0;π ENDπ ELSEπ OutPrn := 160π ENDπ END;ππ{------------------------------}ππ FUNCTION InOutConPrn(VAR F: TextRec): Integer;πππ PROCEDURE OutCon(ch : Char; DspPage : Byte);π VARπ Regs : Registers;π BEGINπ Regs.AH := $0E; {Write TTY character}π Regs.AL := Byte(ch);π Regs.BH := DspPage;π Intr($10,Regs)π END;πππ VARπ OutputPos, DspPage : Byte;π Regs : Registers;π Status : Integer;ππ BEGINπ WITH F DOπ BEGINπ Regs.AH := $0F; {Get Current Display Page}π Intr($10,Regs);π DspPage := Regs.BH;π OutputPos := 0;π Status := 0;π InOutConPrn := 0;π WHILE (OutputPos < BufPos) ANDπ (Status = 0) DOπ BEGINπ OutCon(BufPtr^[OutputPos],DspPage);π Status := OutPrn(F,BufPtr^[OutputPos]);π Inc(OutputPos);π IF Status <> 0 THENπ InOutConPrn := 160;π END;π BufPos := 0;π ENDπ END;ππ{------------------------------}ππ FUNCTION FlushConPrn(VAR F: TextRec): Integer;π BEGINπ WITH F DOπ BEGINπ IF BufPos <> 0 THENπ FlushConPrn := InOutConPrn(F)π ELSEπ FlushConPrn := 0π ENDπ END;ππ{------------------------------}ππ FUNCTION CloseConPrn(VAR F: TextRec): Integer;π {print a ff on printer when closing device}π BEGINπ IF F.UserData[1] < 3 THENπ CloseConPrn := OutPrn(F,Chr(12))π END;ππ{------------------------------}ππ FUNCTION OpenConPrn(VAR F: TextRec): Integer;π BEGINπ WITH F DOπ BEGINπ IF Mode = fmOutput THENπ BEGINπ InOutFunc := @InOutConPrn;π FlushFunc := @FlushConPrn;π CloseFunc := @CloseConPrn;π FillChar(IOBuffer,SizeOf(IOBuffer),#0);π OpenConPrn := 0π ENDπ ELSEπ OpenConPrn := 104 {file not openπ for input or Append}π ENDπ END;ππ{$F-}ππ{------------------------------}πππ PROCEDURE AssignConPrn(VAR F : Text);ππ BEGINπ WITH TextRec(F) DOπ BEGINπ Mode := fmClosed;π BufSize := SizeOf(IOBuffer);π BufPtr := @IOBuffer;π OpenFunc := @OpenConPrn;π Name[0] := #0π ENDπ END;ππ{-------- UNIT INITIALIZATION SECTION ---------}πππBEGINπ AssignConPrn(ConPrn);π Rewrite(ConPrn);ππ OldExitProc := ExitProc;π ExitProc := @ExitConPrn;ππ SetLptNbr(1); {default to LPT1}πEND.ππ{ ------------------ TEST PROGRAM ------------------------}ππPROGRAM TestConPrn;πππUSES DOS,CRT,Printer,ConPrnIO;πππBEGINπ ClrScr;π WriteLn('Written to screen');π WriteLn(ConPrn,'Written to both');π WriteLn('Written to screen');π WriteLn(Lst,'Written to printer only')πEND.ππ 15 06-22-9309:21ALL SWAG SUPPORT TEAM Check for Printer Ready IMPORT 12 ε╡Qc ===========================================================================π BBS: The Beta ConnectionπDate: 06-08-93 (20:02) Number: 819πFrom: JEFF PALEN Refer#: 777π To: DAN SABIN Recvd: YES πSubj: PRINTER CRASHING Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πDS>Does anyone know how you can check from Turbo Pascal that theπDS>printer is turned on so that you won't get a device error thatπDS>will crash a program? I can't find anything about this.ππProgram Printer_Status;πUses Dos;πFunction PrinterOnLine : Boolean;π Constπ PrnStatusInt : Byte = $17; (* Dos interrupt *)π StatusRequest : Byte = $02; (* Interrupt Function Call *)ππ PrinterNum : Word = 0; { 0 for LPT1, 1 for LPT2, etc. }π Varπ Regs : Registers ; { Type is defined in Dos Unit }ππ Begin (* PrinterOnLine*)π Regs.AH := StatusRequest;π Regs.DX := PrinterNum;π Intr(PrnStatusInt, Regs);π PrinterOnLine := (Regs.AH and $80) = $80;π End;ππBegin (* Main Program *)π If PrinterOnLine Thenπ Writeln('Ready To Print')π Elseπ Writeln('Please check the printer!');πEnd.ππ---π ■ RM 1.0 ■ Eval Day 4 ■ Programmer's do it with bytes and nybbles....π * Channel 1(R) * 617-354-7077 * Cambridge MA * 85 linesπ * PostLink(tm) v1.06 CHANNEL1 (#15) : RelayNet(tm)π 16 07-16-9306:12ALL CHRIS PRIEDE Printer Ready Function IMPORT 12 ε╡Qc ===========================================================================π BBS: The Beta ConnectionπDate: 07-06-93 (15:28) Number: 1525πFrom: CHRIS PRIEDE Refer#: 1378π To: PETER KIRKWOOD Recvd: NO πSubj: Printer Ready? Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πPK> Any suggestions as to how I can check if a printer is onlineπPK>and/or ready would be appreciated.ππ Interrupt 17h service 02h returns printer status flags. We areπinterested in three:ππ bit 7 = 1 Readyπ bit 5 = 1 Out of paperπ bit 3 = 1 I/O errorπππ Bit 7 should be 1 and bits 5, 3 -- 0. You can use the followingπBASM routine to check it:ππconstπ pnLPT1 = 0;π pnLPT2 = 1;π pnLPT3 = 2;ππfunction PrinterReady(PN: word): boolean; assembler;πasmπ mov dx, PN {printer number goes in DX}π mov ah, 02hπ int 17h {int. 17h service 02h}π xor al, al {assume false}π and ah, 10101000b {clear all other bits}π cmp ah, 10000000b {ready & not out of paper or error?}π jne @Done {no -- leave result false}π inc ax {yes -- change to true}π@Done:πend;π---π * D.W.'s TOOLBOX, Atlanta GA, 404-471-6636π * PostLink(tm) v1.06 DWTOOLBOX (#1035) : RelayNet(tm)π 17 07-16-9306:12ALL GUY MCLOUGHLIN GREAT Printer Unit IMPORT 74 ε╡|¿ π (* Insert a '.' before the statment '$DEFINE' to *)π (* compile without debugging information. *)π{.$DEFINE DebugMode}ππ{$IFDEF DebugMode}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,R+,S+,V+,X-}π{$ELSE}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,R-,S-,V-,X-}π{$ENDIF}ππ(**********************************************************************)π(* PRINTIT.PAS - Public-domain TP printer unit by Guy McLoughlin. *)π(* version 1.10 (July, 1993) *)π(* Min TP version: 4+ *)π(**********************************************************************)ππunit PrintIt;ππ(* BIT-MAP OF THE PRINTER "STATUS-BYTE" *)π(* ------------------------------------ *)π(* *)π(* BIT NUMBER 7 6 5 4 3 2 1 0 *)π(* | | | | | | | +-- Printer "timed-out" *)π(* | | | | | +--+----- These bits are NOT used *)π(* | | | | +----------- Printer I/O error *)π(* | | | +-------------- Printer "selected" *)π(* | | +----------------- Printer is out of paper *)π(* | +-------------------- Acknowlegment from printer *)π(* +----------------------- Printer NOT busy *)ππinterfaceππtypeπ st_8 = string[8];πππ (***** Initialize printer port. *)π (* *)π function InitPrinterPort({ input} wo_PrinterNum : word) : {output} byte;πππ (***** Check the status of the printer. *)π (* *)π function CheckPrinter({ input} wo_PrinterNum : word) : {output} byte;πππ (***** Initialize PrintIt variables, and check printer status. *)π (* *)π function InitPrintIt({ input} st_PrinterID : st_8;π by_PrinterNum : byte;π bo_InitPort : boolean;π {update} var fi_Printer : text;π var by_Status : byte)π {output} : boolean;πππ (***** Position printer "head" to X columns across, Y rows down. *)π (* *)π procedure P2xy({ input} var fi_Printer : text;π by_Xaxis,π by_Yaxis : byte);πππ (***** Print string at position X columns across, Y rows down. *)π (* *)π procedure Pwrite({ input} var fi_Printer : text;π st_Data : string;π by_Xaxis,π by_Yaxis : byte);πππimplementationππconst (* Line-feed, Carriage-return, Space character constant *)π co_Lf = #10;π co_Cr = #13;π co_Space = #32;ππvar (* "space" character, and line-feed string variables. *)π st_Spaces,π st_LineFeeds : string;πππ (***** Initialize printer port. *)π (* *)π function InitPrinterPort({ input} wo_PrinterNum : word) :π {output} byte; assembler;π asmπ mov ax, 0100hπ mov dx, wo_PrinterNumπ int 17hπ mov al, ahπ end; (* InitPrinterPort. *)πππ (***** Check the staus of the printer. *)π (* *)π function CheckPrinter({ input} wo_PrinterNum : word) :π {output} byte; assembler;π asmπ mov ax, 0200hπ mov dx, wo_PrinterNumπ int 17hπ mov al, ahπ end; (* CheckPrinter. *)πππ (***** Initialize PrintIt variables, and check printer status. *)π (* *)π function InitPrintIt({ input} st_PrinterID : st_8;π by_PrinterNum : byte;π bo_InitPort : boolean;π {update} var fi_Printer : text;π var by_Status : byte)π {output} : boolean;π beginπ (* Initialize "PrintIt" variables. *)π fillchar(st_Spaces, sizeof(st_Spaces), co_Space);π fillchar(st_LineFeeds, sizeof(st_LineFeeds), co_Lf);ππ (* Try to open text-device printer variable. *)π assign(fi_Printer, st_PrinterID);π {$I-}π rewrite(fi_Printer);π {$I+}π if (ioresult <> 0) thenπ beginπ by_Status := $FF;π InitPrintIt := falseπ endπ elseπ beginπ (* Initialize printer-port if required. *)π if bo_InitPort thenπ by_Status := InitPrinterPort(by_PrinterNum)π elseπ (* Else, check the status of the printer. *)π by_Status := CheckPrinter(by_PrinterNum);ππ (* Check for error-flags in the printer status byte. *)π if ((by_Status AND $29) = 0) thenπ InitPrintIt := trueπ elseπ InitPrintIt := falseπ endπ end; (* InitPrinter. *)πππ (***** Position printer "head" to X columns across, Y rows down. *)π (* *)π procedure P2xy({ input} var fi_Printer : text;π by_Xaxis,π by_Yaxis : byte);π beginπ if (by_Yaxis > 0) thenπ beginπ st_LineFeeds[0] := chr(by_Yaxis);π write(fi_Printer, st_LineFeeds)π end;π if (by_Xaxis > 0) thenπ beginπ st_Spaces[0] := chr(pred(by_Xaxis));π write(fi_Printer, co_Cr + st_Spaces)π endπ end; (* P2xy. *)πππ (***** Print string at position X columns across, Y rows down. *)π (* *)π procedure Pwrite({ input} var fi_Printer : text;π st_Data : string;π by_Xaxis,π by_Yaxis : byte);π beginπ P2xy(fi_Printer, by_Xaxis, by_Yaxis);π write(fi_Printer, st_Data)π end; (* Pwrite. *)ππEND.ππ{-------------------------------- CUT HERE -----------------------------}π(* Program to demo "PrintIt" unit. *)ππprogram DemoPrintIt;πusesπ PrintIt;ππconst (* Form-feed character. *)π co_FF = #12;ππvar (* Printer "status" byte. Check "bit-map" in PrintIt *)π (* unit for table of bit-flags. *)π by_PrinterStatus : byte;ππ (* Our text-device interface variable. *)π fi_Printer : text;ππ (* Main program block. *)πBEGINπ (* Initialize "PrintIt" variables, and check the *)π (* status of the printer. *)π if NOT InitPrintIt('PRN', 0, false, fi_Printer, by_PrinterStatus) thenππ (* InitPrintIt failed. Inform user of this, and halt. *)π beginπ writeln('Error accessing printer!');π writeln('Printer error = ', by_PrinterStatus);π haltπ end;π (* Print "SECRET" meaning of life symbol!!! <g> *)π (* Position printer head to column 45, 5 rows down. *)π P2xy(fi_Printer, 45, 5);ππ (* Write some text to the printer. *)π write(fi_Printer, '_)');ππ P2xy(fi_Printer, 43, 0);π write(fi_Printer, '(_');π P2xy(fi_Printer, 45, 1);π write(fi_Printer, '@)');π P2xy(fi_Printer, 43, 0);π write(fi_Printer, '(@');π P2xy(fi_Printer, 41, 1);π write(fi_Printer, '---\/');π P2xy(fi_Printer, 36, 0);π write(fi_Printer, '/----');π P2xy(fi_Printer, 35, 1);π write(fi_Printer, '/ | ||');π P2xy(fi_Printer, 40, 1);π write(fi_Printer, '---||');π P2xy(fi_Printer, 34, 0);π write(fi_Printer, '* ||-');π P2xy(fi_Printer, 37, 1);π write(fi_Printer, '^^ ^^');ππ (* Print "SECRET" number code, using "Pwrite" routine.*)π Pwrite(fi_Printer, '10', 45, 5);π Pwrite(fi_Printer, '2', 37, 0);π Pwrite(fi_Printer, '8', 43, 0);π Pwrite(fi_Printer, '7', 42, 0);π Pwrite(fi_Printer, '1', 36, 0);π Pwrite(fi_Printer, '6', 41, 0);π Pwrite(fi_Printer, '3', 38, 0);π Pwrite(fi_Printer, '9', 44, 0);π Pwrite(fi_Printer, '5', 40, 0);π Pwrite(fi_Printer, '0', 35, 0);π Pwrite(fi_Printer, '4', 39, 0);ππ (* Say good-bye, Guy. *)π Pwrite(fi_Printer, '...Thats All Folks!!!', 30, 2);ππ (* Send form-feed to printer. *)π write(fi_Printer, co_FF)πEND.ππ 18 07-16-9306:14ALL SWAG SUPPORT TEAM Print Spooler Interface IMPORT 12 ε╡█æ Program SPOOLIT;ππ{ Example program to demonstrate the PRINT spooler interface }ππ{ Define the data structure we need for spooling files }ππUses DOS;ππTypeππ SpoolRecType = Recordπ Priority : Byte;π Filename : Pointer;π end;ππVarππ SpoolFile : PathStr;π SpoolBuffer : Array[1..70] of char;π SpoolRec : SpoolRecType;π Regs : Registers;π SpooledOk : Boolean;ππBeginππ With Regs do beginπ AX := $100;π Intr($2F,Regs);π If AL = 0 then Beginπ WriteLn('PRINT is not loaded.');π Haltπ endπ end;ππ { Query user for the name of a file to spool }ππ Write('Enter the filename to print: ');π ReadLn(SpoolFile);ππ If Length(SpoolFile) = 0 then Halt; {Nothing to do, so quit}ππ FillChar(SpoolBuffer,SizeOf(SpoolBuffer),0);ππ Move(SpoolFile[1],SpoolBuffer,Length(SpoolFile));ππ SpoolRec.Priority := 0;π SpoolRec.Filename := Addr(SpoolBuffer);ππ { Send the file on its way }ππ With Regs do Beginπ AX := $101;π DS := DSeg;π DX := Ofs(SpoolRec);π Intr($2F,Regs);ππ { Isolate the status fo the spool operation }ππ SpooledOK := Not ((Flags and 1) = 1);ππ If SpooledOk thenπ WriteLn('Your file has been placed in the queue.')π elseπ WriteLn('Could not spool your file, error code is ',AL)π endππEnd. 19 08-17-9308:40ALL SWAG SUPPORT TEAM Checking For Printer IMPORT 13 ε╡Γ program chkprinter;ππuses dos,crt;ππvarπ lprn: integer;π st : string;πππfunction printerok(lprn : integer) : boolean;ππvar ok : boolean;π regs : registers;π st : string;π code : byte;ππbegin {printerok}π ok := false;π dec(lprn);π if ((lprn >= 0) and (lprn <= 2)) thenπ repeatπ regs.ah := 2;π regs.dx := lprn;π intr($17, regs);π code := regs.ah;π if code <> $90π thenπ beginπ case code ofπ $02, $4A : st := ' Printer is not connected ';π $00, $10,π $18, $58 : st := ' Printer is offline ';π $28, $38 : st := ' Printer is out of paper ';π $88, $C8 : st := ' Printer is turned off ';π else st := ' Output device is not ready ';π end; {case}π GoToXY(1,1);π WriteLn(st);π WriteLn(' ');π WriteLn('Please correct the error');π WriteLn('or press a key to continue')π endπ elseπ ok := true;π until ok or keypressed;π if ok then printerok := okπend; {printerok}π{**********************************************************************}ππ beginππ ClrScr;ππ if paramcount <> 0π then beginπ st := copy(paramstr(1), 1, 1);π lprn := ord(st[1]) - 48π endπ else lprn := 1;ππ if printerok(lprn) thenπ writeln('Printer OK')π elseπ writeln('Printer not ok')πend.π 20 08-17-9308:48ALL SWAG SUPPORT TEAM Printer Check Routines IMPORT 13 ε╡Cz PROGRAM PRINTCHK;ππuses crt,dos,printer;πconstπ lpt1=0;π lpt2=1;π lpt3=2;ππ PrnReady = $90;π OffLine = $00;π OffLine2 = $10; {NEW LINE}π PaperOut = $20;π PaperOut2 = $30; {NEW LINE}π HookedButOff = $80; {NEW LINE}π NoConnect = $B0; {MODIFIED LINE}ππ {NOCONNECT = $30 FOR SOME COMPUTERS BY STU}ππ Function ChkPrinter(Printer:Word) :Word;π Var Regs:Registers;ππ Beginπ Regs.AH:=2;π Regs.DX:=Printer;π Intr($17,regs);π ChkPrinter:=Regs.AHπ end;ππ Procedure PrinterError(ErrorCode:BYTE); ;NEWπππ VARπ C : BYTE;ππππ Beginπ ErrorCode := ErrorCode and $B0; {NEW LINE}ππ C := ERRORCODE SHL 6 {ALWAYS MEANS NOTHING CONNECTED}ππ IF C > 0 THEN ERRORCODE = $B0; {ELEMINATES NO LPT3 AND NOTHING CONNECTED}πππ Case ErrorCode ofπ NoConnect : WriteLn('Printer not connected');π Offline,OffLine2 : WriteLn('Printer off line'); {Modified}π PaperOut,PaperOut2 : WriteLn('Printer out of paper'); {Modified}π HookedButOff : WriteLn('Printer connected but turned off'); {New}π elseπ WriteLn('Printer error code: ',ErrorCode);π endπ end;ππ procedure TryPrinter;π Beginπ {$I-}π WriteLn(Lst,'Check Printer'+#12);π {$I+}π WriteLn(IOResult)π End;ππ Beginπ ClrScr;π {TryPrinter;}π If ChkPrinter(LPT1) = PrnReady thenπ Writeln('Printer is Ready')π elseπ PrinterError(ChkPrinter(LPT1))π end. 21 08-18-9312:28ALL JOSE ALMEIDA Base address - parallel IMPORT 9 ε╡J; { Base address for four parallel ports.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Base_Addr(LPT_Port : byte) : word;π{ DESCRIPTION:π Base address for four parallel ports.π SAMPLE CALL:π NW := Parallel_Base_Addr(1);π RETURNS:π The base address for the specified parallel port.π NOTES:π If the port is not used, then the returned value will be 0 (zero).π The aceptable values for LPT_Port are: 1,2,3 and 4. }ππBEGIN { Parallel_Base_Addr }π Parallel_Base_Addr := MemW[$0000:$0408 + Pred(LPT_Port) * 2];πEND; { Parallel_Base_Addr }π 22 08-18-9312:28ALL JOSE ALMEIDA Number of parallel ports IMPORT 7 ε╡τ { Number of parallel ports installed in the system.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Ports : byte;π{ DESCRIPTION:π Number of parallel ports installed in the system.π SAMPLE CALL:π NB := Parallel_Ports; }ππBEGIN { Parallel_Ports }π Parallel_Ports := MemW[$0000:$0410] shr 14;πEND; { Parallel_Ports }π 23 08-18-9312:29ALL JOSE ALMEIDA Time-Out values IMPORT 7 ε╡╕ { Time-Out values for parallel printers.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Time_Out(LPT : byte) : byte;π{ DESCRIPTION:π Time-Out values for parallel printers.π SAMPLE CALL:π NB := Parallel_Time_Out(1);π NOTES:π The allowed values for LPT are: 1,2,3 or 4. }ππBEGIN { Parallel_Time_Out }π Parallel_Time_Out := Mem[$0000:$0478 + Pred(LPT)];πEND; { Parallel_Time_Out }π 24 08-27-9321:46ALL JACK WILSON Object printer IMPORT 26 ε╡Éφ {πJack WilsonππThe Objective is to intercept when the Printer is off-line, and give theπuser a reminder to turn the Printer on-line, and press any key to resumeπprinting.ππI Realize this is most certainly an FAQ, and I have found some sourceπcode on Timo's site For TP 5.5 that I have modified (see below), butπthere is not much talk anymore about TP 3.0.ππAnyway, to avoid making a lot of changes to my source code, I thought Iπwould reWrite the LstOut Procedure (which according to the manual, isπcalled by routines accessing the LST: device) as shown at the end ofπthe following listing. This is inefficient, since it is being calledπfor each Character that is output to the Printer. Does anybody have aπbetter suggestion? I might add the way it is now, if an off-lineπsignal is detected, the LstOut will only print the first Characterπ('t') in the Write(lst,'test') in the main Program, With the 'est'πgoing to the screen. if I remove the statements in the While loop ofπLstOut, then all of 'test' goes to the Printer, but it defeats myπpurpose of giving the user a message.π}ππ{by David R. Conrad, For Turbo Pascal 5.5ππ This code is not copyrighted, you may use it freely.π There are no guarantees, either expressed or implied,π as to either merchantability or fitness For a particularπ purpose. The author's liability is limited to the amountπ you paid For it.π David R. Conrad, 17 Nov 92π David_Conrad@mts.cc.wayne.eduπ dave@michigan.comπ}ππConstπ { For use With the Printer Functions }π PrnNotBusy = $80;π PrnAck = $40;π PrnNoPaper = $20;π PrnSelect = $10;π PrnIOError = $08;π PrnTimeout = $01;ππTypeπ Word = Integer;π AnyStr = String[255];ππVarπ PrinterNumber : Byte;ππ{ all routines are documented in the Implementation section }ππProcedure InitRegisters(Var Reg : Registers);π{ initialize Variable of Type Registers: slightly anal-retentive }πbeginπ fillChar (Reg, sizeof(Reg), 0);π Reg.DS := DSeg;π Reg.ES := DSeg;πend;ππFunction PrnOnline(Printernumber : Byte) : Boolean;π{ Is LPT(Printernumber) online? }πVarπ Reg : Registers;πbeginπ InitRegisters(Reg);π Reg.AH := 2;π Reg.DX := Pred(Printernumber);π Intr($17, Reg);π PrnOnline := (Reg.AH and PrnSelect) = PrnSelect;πend;ππProcedure pause;πVarπ c : Char;ππbeginπ c := #127;π Repeatπ if KeyPressed thenπ c := ReadKey;π Until c in [#0..#126];πend;πππ{**************************************************************************}π{THIS IS THE ROUTINE in QUESTION}ππProcedure LstOut(ch : Char);ππVarπ Reg : Registers;ππbeginπ While not (PrnOnline(PrinterNumber)) doπ beginπ {if I TAKE OUT THESE NEXT THREE LINES, then OUTPUT PaUses Until Printerπ IS ON-LINE, and then ALL CharS PRINT to Printer}π GotoXY(1, 23);π ClrEol;π Write('Please check Printer, and press any key when ready...');π pause;π end;π initRegisters(Reg);π Reg.AH := 0;π Reg.DX := Pred(PrinterNumber);π Reg.AL := Byte(ch);π Intr($17, Reg);ππend;ππ{**************************************************************************}ππbeginπ PrinterNumber := 1;π LstOutPtr := ofs(LstOut);π Writeln(lst, 'test');πend.ππ 25 11-02-9305:47ALL JAN BARENDREGT Graphics Dump to Laser IMPORT 22 ε╡ä« {π> I wrote a computer Program that produces 8 bit 480 x 640 hi res images,π> and I would like to know if anyone is familiar With a routine that canπ> print these images out on a Printer.π> The preferable Printer For the task is a HP LaserJet II.π>π> I would like to be able to tell the LaserJet exactly which pixel dotsπ> to print, and I don't mind if I have to give bit information to theπ> Printer line-by-line.π>ππBelow is some (old) code to make a screendump in Graphics mode, forπboth HP laser II and Epson. I haven't tested this For SVGA, but ifπyou give MaxX and MaxY the right values, I can't see where it wouldπgo wrong.ππJan Barendregtπ}πUsesπ Graph,π Dos,π Printer;ππConstπ d = 'l';ππVarπ MaxX, MaxY : Integer;ππProcedure dump;πVarπ ymax,π bbyt,π b2 : Byte;π psf : File of Byte;π regs : Registers;ππ Procedure out(ch : Char);π beginπ regs.ax := ord(ch);π regs.dx := 0;π intr($17, regs);π end;ππ Procedure hplaser;π Varπ b,π reg,π kol : Word;π beginπ assign(psf, 'lpt1');π reWrite(psf);π Write(lst, chr(27), 'E');π Write(lst, chr(27), '*t100R', chr(27), '*r0A');π For reg := 0 to maxx doπ beginπ Write(lst, chr(27), '*b', (maxy + 1) div 8, 'W');π For kol := ((maxy + 1) div 8) - 1 downto 0 doπ beginπ bbyt := 0;π For b := 0 to 7 doπ beginπ if getpixel(reg, kol * 8 + b) = 0 thenπ b2 := 0π elseπ b2 := 1;π bbyt := bbyt or (b2 shl b);π end;π out(chr(bbyt));π end;π end;π Write(lst, chr(27), '*rB');π Write(lst, chr(12));π Write(lst, chr(27), 'E');π close(psf);π end;ππ Procedure epson;π Varπ k, j, i : Byte;ππ Function xget(x, y : Integer) : Byte;π beginπ regs.ah := $0D;π regs.cx := x;π regs.dx := y;π intr(16, regs);π xget := regs.al;π end;ππ beginπ out(chr($1B));π out(chr($33));π out(chr($18));π out(chr($0D));π out(chr($0A));π For j := 0 to (maxy shr 3) doπ beginπ out(chr($1B));π out(chr($4C));π out(chr((maxx + 1) mod 256));π out(chr((maxx + 1) div 256));π For i := 0 to maxx doπ beginπ bbyt := 0;π For k := 0 to 7 doπ if (xget(i, (j shl 3) + k) <> 0) thenπ bbyt := bbyt or (128 shr k);π out(chr(bbyt));π end;π out(chr(13));π out(chr(10));π end;π end;ππbeginπ MaxX := GetMaxX;π MaxY := GetMaxY;ππ if d = 'l' thenπ hplaserπ elseπ epson;πend;πππVarπ Gd, Gm,π Radius : Integer;ππbeginπ Gd := Detect;π InitGraph(Gd, Gm, 'e:\bp\bgi');π For Radius := 1 to 5 doπ Circle(100, 100, Radius * 10);π Readln;π Dump;π CloseGraph;πend.π 26 11-02-9310:33ALL RANDALL WOODMAN PRINTER Handler IMPORT 39 ε╡H {πRANDALL WOODMANππNOTE: There is a call to a Procedure called YNWin. It is defined as:π YNWin(s : String; Var ch : Char; Color : ColorSet);πColor set comes from the ObjectProfessional package from TurboPower software.πYNWin is derived from one of their Objects. Basically it pops up a Window,πdisplays the String, s, in the colors specified, and waits For a Y or N Charπfrom the user. It returns that result in CH.π I did not include YNWin in this post. However, you can easily Writeπa Procedure to take it's place. I only left the calls in place to show youπwhat I do when I do need interaction from the user.π The Printer codes used are specific to an Epson compatible Printer.πCheck your user manual For other Printer support.π}ππUnit IThinkClintonsDefecetReductionPackageSucks;ππUsesπ Dos;ππConstπ TimedOut = $01; { Used to determine the Type of Printer error }π IOError = $08;π OutOfPaper = $20;π NotBusy = $80;π TestAll = TimedOut+IOError+OutOfPaper;ππVarπ PrnStatus : Byte;ππFunction PrinterReady : Boolean;π{ checks the status of the Printer and returns True if ready }π{ to recieve a Character }π{ This Function will return the status of your Printer. Status }π{ should be interpreted as follows: (x'90' (d'144') is "Ready"): }π{ $01 = Printer Time-out $02 = Not Used }π{ $04 = Not Used $08 = I/O Error }π{ $10 = Printer Selected $20 = Out Of Paper }π{ $40 = Acknowledge $80 = Not Busy }ππVarπ Regs : Registers;π TempStatus : Byte;πbeginπ With Regs Doπ beginπ DX := 0;π AX := $0200;π Intr($17,Regs);π PrnStatus := Hi(AX);π TempStatus := PrnStatus;π PrinterReady := (TempStatus and TestAll = $00);π end;πend;ππProcedure GetPrnError(Var ESC : Boolean);π{ gets the error that occured With the Printer and gives the user a chance to }π{ correct the problem and continue. }πVarπ CH : Char;πbeginπ Repeatπ PrnStatus := PrnStatus and TestAll;π Case PRnStatus OFπ TimedOut : YNWin('Printer timed out. Retry??? (Y/N)',Ch,Mycolor);π IOError : YNWin('An IOError has occured. Retry??? (Y/N)',CH,Mycolor);π OutOfPaper : YNWin('Printer out of paper. Retry??? (Y/N)',CH,Mycolor);π elseπ YNWin('A Print Device Error has occured. Retry??? (Y/N)',CH,Mycolor);π end; { Case }π if CH = 'N' thenπ esc := True;π Until ESC or PrinterReady;πend;ππFunction EscapePushed : Boolean;π{ Checks the keyboard buffer For a Character and test to see if it was the }π{ Esc key. if it was it returns True else it returns False. }πVarπ CH : Char;πbeginπ if KeyPressed then { Check the keyboard buffer For a Character }π beginπ CH := ReadKey; { if Character then check it }π CH := UpCase(CH);π EscapePushed := (Ch = Chr(27));π endπ elseπ EscapePushed := False;πend;ππProcedure ConfirmQuit(Var ESC : Boolean);π{ confirms that the user wants to quit printing }πVarπ CH : Char;πbeginπ YNWin('Cancel all print jobs? (Y/N)',Ch,Mycolor);π ESC := (CH = 'Y');πend;ππProcedure PrintCh(CH : Char; Underline : Boolean; Var OK : Boolean);π{ Writes a single Character to the Printer }πbeginπ if UnderLine thenπ {$I-} Write(LST, #27#45#1, CH, #27#45#0) {$I+}π elseπ {$I-} Write(lst,CH); {$I+}π OK := (IOResult = 0);πend;ππProcedure MakeLine(Start, Stop : Integer; Return : Boolean; Var ESC : Boolean);π{ Draws a line on the paper starting at Start and ending at Stop. }πVarπ PrnReady,π Ok : Boolean;πbeginπ PrnReady := True;π Repeatπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π Until PrnReady or ESC;ππ PrnReady := True;π While prnReady and not Esc and (Start <> Stop + 1) DOπ beginπ prnReady := PrinterReady; { do three test to be sure }π if not PRnReady thenπ GetPrnError(ESC);π if not ESC thenπ PrintCH('_',False,OK);π if not ESC thenπ if EscapePushed thenπ ConfirmQuit(ESC);π if OK thenπ Inc(Start);π end;π if not Esc and PrnReady and RETURN thenπ {$I-} Writeln(LST); {$I+}πend;ππProcedure WriteStr(TheStr : String; Return, UnderLine : Boolean;π Var ESC : Boolean);πVarπ PrnReady,π OK : Boolean;π I : Byte;πbeginπ Repeatπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π Until PrnReady or ESC;π I := 1;ππ While PrnReady and not Esc and (I <> Length(theStr)+1) DOπ beginπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π if not ESC thenπ PrintCh(theStr[I], UnderLine, OK);π if not esc thenπ if EscapePushed thenπ confirmQuit(Esc);π if OK thenπ Inc(I);π end;π if PrnReady and Not ESC And RETURN thenπ {$I-} Writeln(LST); {$I+}πend;π 27 11-21-9309:45ALL PHIL NICKELL Printusing in PASCAL IMPORT 16 ε╡ε {πFrom: PHIL NICKELLπSubj: Basic PrintUsing in PASπDoes anyone know of any shareware or freeware routines in Turbo Pascalπ5.5, that will allow me to format numbers or strings like the PRINTUSINGπstatement in BASIC???π}ππ PROCEDURE printusing (mask: string; value:real);π { Calling syntax = PRINTUSING(mask, number)π mask can be a string label or a literalπ Example printusing('#,###,###',45.63);π printusing('######.###,value); }π constπ comma : char = ',';π point : char = '.';π minussign : char = '-';π varπ fieldwidth, integerlength, i, j, places, pointposition: integer;π usingcommas, decimal, negative : boolean;π outstring, integerstring : string;ππ beginπ negative := ( value < 0 );π value := abs( value );π places := 0;π fieldwidth := length( mask );π usingcommas := ( pos ( comma, mask ) > 0 );π decimal := ( pos (point,mask) > 0 );π if decimal thenπ beginπ pointposition := pos(point, mask);π places := fieldwidth - pointposition;π END;π str ( value:0:places, outstring );π if usingcommas thenπ beginπ J := 0;π integerstring :=π copy (outstring, 1, length(outstring)-places);π integerlength := length(integerstring);π if decimal thenπ integerlength := pred(integerlength);π for i := integerlength downto 2 doπ beginπ inc(j);π if j mod 3 = 0 thenπ insert (comma,outstring,i);π end;π end;π if negative thenπ outstring := minussign + outstring;π write( outstring:fieldwidth);π END; {PRINTUSING}ππBEGINπPrintUsing('##,###,###.##',123456.78);πEND. 28 11-26-9317:38ALL SWAG SUPPORT GROUP PRINTER Unit Replacement IMPORT 58 ε╡ù] { Can be used as a TOTAL replacement for the PRINTER UNIT }π{ You'll need to replace the PRINTER unit in the TURBO.TPL to use this }π{$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π{$F+,O-,X+,A-}π{$ENDIF}ππ{$DEFINE AssignLstDevice}π{$DEFINE DoErrorChecking} { undefine this to eliminate error checking }ππUNIT Printer;ππINTERFACEππ{$IFDEF DoErrorChecking}πUSES CRT;π{$ENDIF}ππCONSTππ fmClosed = $D7B0; { magic numbers for Turbo }π fmInput = $D7B1;π fmOutput = $D782;π fmInOut = $D7B3;ππ IO_Invalid = $FC; { invalid operation eg. attempt to write }π { to a file opened in fmInput mode }ππ LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');ππ LPTPort : BYTE = 0;ππVARπ Lst : TEXT; { for source compatability with TP3 }ππFUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;π { status of LPTNo via ROM BIOS int 17h func 2h }π INLINE (π $5A / { pop DX ; get printer number}π $B4 / $02 / { mov AH,02 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππFUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;π { send a character to LPTNo via ROM BIOS int 17h func 0h }π INLINE (π $5A / { pop DX ; get printer number}π $58 / { pop AX ; get char}π $B4 / $00 / { mov AH,00 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππPROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππPROCEDURE OutputToFile (FName : STRING);π {redirect printer output to file }ππFUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;ππFUNCTION Printer_OK : BOOLEAN;ππPROCEDURE SelectPrinter (LPTNum : BYTE);ππPROCEDURE ResetPrinter; { only resets printer 0 }ππIMPLEMENTATIONππTYPEπ TextBuffer = ARRAY [0..127] OF CHAR;ππ TextRec = RECORDπ Handle : WORD;π Mode : WORD;π BufSize : WORD;π Private : WORD;π BufPos : WORD;π BufEnd : WORD;π BufPtr : ^TextBuffer;π OpenFunc : POINTER;π InOutFunc : POINTER;π FlushFunc : POINTER;π CloseFunc : POINTER;π { 16 byte user data area, I use 4 bytes }π PrintMode : WORD; { not currently used}π LPTNo : WORD; { LPT number in [0..2] }π UserData : ARRAY [1..12] OF CHAR;π Name : ARRAY [0..79] OF CHAR;π Buffer : TextBuffer;π END;πCONSTπ LPTFileopen : BOOLEAN = FALSE;ππVARπ LPTExitSave : POINTER;ππ PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);π { call macro to send char to LPTNo. If bit 4, the Printer Selected bit }π { is not set upon return, it is assumed that an error has occurred. }ππ BEGINπ ErrorCode := DoInt17 (Ch, LPTNo);π IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }π ErrorCode := 0 { no error }π { if bit 4 is not set, error is passed untouched and placed in IOResult }π END;ππ FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;π { A do nothing, no error routine }π BEGINπ LstIgnore := 0 { return 0 for IOResult }π END;ππ FUNCTION LstOutput (VAR F : TextRec) : INTEGER;π { Send whatever has accumulated in the Buffer to int 17h }π { If error occurs, return in IOResult. See Inside Turbo }π { Pascal chapter of TP4 manual for more info on TFDD }π VARπ I : WORD;π ErrorCode : INTEGER;ππ BEGINπ LstOutput := 0;ππ {$IFDEF DOERRORCHECKING}π WHILE NOT Printer_OK DOπ BEGINπ GotoXY(1,23);ClrEol;π Write('Please check Printer, and press any key when ready...');π Readkey;π END;π {$ENDIF}ππ WITH F DO BEGINπ FOR I := 0 TO PRED (BufPos) DOπ BEGINπ Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }π IF ErrorCode <> 0 THEN BEGIN { if error }π LstOutput := ErrorCode; { return errorcode in IOResult }π EXIT { return from function }π ENDπ END;π BufPos := 0π END;π END;ππ PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππ BEGINπ WITH TextRec (F) DOπ BEGINπ Mode := fmClosed;π BufSize := SIZEOF (Buffer);π BufPtr := @Buffer;π OpenFunc := @LstIgnore; { you don't open the BIOS printer functions }π CloseFunc := @LstIgnore; { nor do you close them }π InOutFunc := @LstOutput; { but you can Write to them }π FlushFunc := @LstOutput; { and you can WriteLn to them }π LPTNo := LPTNumber; { user selected printer num (in [0..2]) }π MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }π BufPos := 0; { reset BufPos }π END;π END;ππ PROCEDURE OutputToFile (FName : STRING);π BEGINπ ASSIGN (Lst, FName);π REWRITE (Lst);π LPTFileopen := TRUE;π END;ππ FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;π VARπ Status : BYTE;π BEGINπ Status := GetROMPrinterStatus (LPTNum);π IF (Status AND $B8) = $90 THENπ PrinterStatus := 0 {all's well}π ELSE IF (Status AND $20) = $20 THENπ PrinterStatus := 1 {no Paper}π ELSE IF (Status AND $10) = $00 THENπ PrinterStatus := 2 {off line}π ELSE IF (Status AND $80) = $00 THENπ PrinterStatus := 3 {busy}π ELSE IF (Status AND $08) = $08 THENπ PrinterStatus := 4; {undetermined error}π END;ππ FUNCTION Printer_OK : BOOLEAN;π VARπ Retry : BYTE;π BEGINπ Retry := 0;π WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);π Printer_OK := (PrinterStatus (LPTPort) = 0);π END; {PrinterReady}ππ PROCEDURE SelectPrinter (LPTNum : BYTE);π BEGINπ IF (LPTNum >= 0) AND (LPTNum <= 3) THENπ LPTPort := LPTNum;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);π END;ππ PROCEDURE ResetPrinter;π VARπ address : INTEGER ABSOLUTE $0040 : $0008;π portno, DELAY : INTEGER;π BEGINπ portno := address + 2;π Port [portno] := 232;π FOR DELAY := 1 TO 2000 DO {nothing} ;π Port [portno] := 236;π END; {ResetPrinter}ππ PROCEDURE LptExitHandler; FAR;π BEGINπ IF LPTFileopen THEN CLOSE (Lst);π ExitProc := LPTExitSave;π END;ππBEGINππ LPTExitSave := ExitProc;π ExitProc := @LptExitHandler;ππ {$IFDEF AssignLstDevice}ππ LPTPort := 0;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);ππ {$ENDIF}ππ {$IFDEF DOERRORCHECKING}π WHILE NOT Printer_OK DOπ BEGINπ GotoXY(1,23);ClrEol;π Write('Please check Printer, and press any key when ready...');π Readkey;π END;π {$ENDIF}ππEND.π 29 01-27-9412:19ALL DAVID HOWORTH Print Screen IMPORT 10 ε╡åë {π> I find myself in need of a keyboard handler that traps and hidesπ> the Print Screen key. If this key is hit while in graphics modeπ> on a LaserJet it causes a line of garbage to print on a thousandπ> sheets of paper.... <more or less>. I'd like to catch it and maybeπ> even point it to my own print procedure if possible. If you canπ> dig something up, I'd be most grateful. (TP6 if possible)ππThis is the traditional quick and dirty way to thwart PrintScreen:ππmem[$0050:0000] := 1;ππ$0050:0000 is the PrintScreen status byte. It is set to 1 whileπPrintScreen is in operation. If the PrintScreen button is hitπwhile the screen is already being printed, the print screen routineπdoes nothing. By setting the status byte to 1 yourself, you foolπthe PrintScreen routine into thinking the screen is already beingπprinted and it will terminate without doing anything until youπjiggle the status byte back to the "correct" setting.ππSet the status byte back to 0 (mem[$0050:0000] := 0) at the end ofπyour program so your users will be able to use PrintScreen afterπyour program has terminated.π 30 01-27-9412:22ALL VARIOUS - SEE BELOW Control DOS Print SpoolerIMPORT 57 ε╡7á {πHere a nice unit to control the DOS Printer spooler (PRINT.COM/EXE).πIt's a extended/modified/debugged version of some program I foundπelsewere. By controlling the DEFINE the source changes from PROGRAMπto UNIT. Just load good PRINT, Compile the demo and try to print some.πWatch your paper supply !!ππ{---------------------------------------------------------}π{ Original by Brian Ebarb Power Software Company - }π{ Houston, TX (713)781-9784 }π{ }π{ Modified by G.W. van der Vegt }π{---------------------------------------------------------}ππ{ DEFINE UNIT}π{$IFDEF UNIT}ππUNIT Spooler;ππINTERFACEππ{$ELSE}ππUSESπ crt,π dos;ππ{$ENDIF}ππCONSTπ queue_max = 10;π queue_namlen = 64;ππTYPEπ{----Queue types}π queue_action = 1..5;π queue_printer = 1..4;π queue_name = STRING[queue_namlen-1];π queue_type = ARRAY[1..queue_max] OF queue_name;ππCONSTπ{----Queue actions}π queue_submit = 1;π queue_kill = 2;π queue_purge = 3;π queue_hold = 4;π queue_continue = 5;ππ{----Queue results}π queue_ok = $00;π queue_invfie = $01;π queue_nofile = $02;π queue_nopath = $03;π queue_nohandles = $04;π queue_noaccess = $05;π queue_full = $08;π queue_busy = $09;π queue_missing = $0a; {----self defined returncode,π returned IF called AND NOTπ installed.}π queue_longname = $0c;π queue_nowprinting = $9e;ππVARπ queue : queue_type;ππ{$IFDEF UNIT}ππFUNCTION Spool(filestring : queue_name;π theprinter : queue_printer;π action : queue_action) : WORD;ππ{---------------------------------------------------------}ππIMPLEMENTATIONππUSESπ crt,π dos;ππ{---------------------------------------------------------}ππ{$ENDIF}ππFUNCTION Spool(filestring : queue_name;π theprinter : queue_printer;π action : queue_action) : WORD;ππCONSTπ{----MPX interrupt const}π queue_int = $2f;π queue_mpx = $01;π queue_check = $00;π queue_installed = $ff;ππTYPEπ fnames = ARRAY[1..queue_namlen] OF CHAR;π res = ARRAY[1..32768 DIV Sizeof(fnames)] OF fnames;ππVARπ p : ^res;π regs : registers;π fname : fnames;π thefile : RECORDπ prn : BYTE;π loc : ARRAY[1..2] OF WORD;π END;π i,j : INTEGER;ππBEGINπ Fillchar(fname, Sizeof(fname), #0);π Move(filestring[1],fname[1],Length(filestring));ππ thefile.prn := theprinter - 1;π thefile.loc[2] := Seg(fname);π thefile.loc[1] := Ofs(fname);ππ{----Check installation}π regs.ah := queue_mpx;π regs.al := queue_check;ππ Intr(queue_int, regs);π IF (regs.al<>queue_installed)π {----on return, 10 = "not installed" }π THEN Spool:=queue_missingπ ELSEπ CASE action OFπ {----Spool a FILE, return error ORπ 00 IF no errorπ 01 IF added TO queue ORπ 9e IF printing }π queue_submit : BEGINπ regs.ah:=queue_mpx;π regs.al:=queue_submit;π regs.ds:=Seg(thefile);π regs.dx:=Ofs(thefile);ππ Intr(queue_int, regs);ππ IF ((regs.flags AND fcarry) = fcarry)π THEN Spool:=regs.axπ ELSE Spool:=regs.al;π END;π {----Dequeue a file, Returns Error or ok }π queue_kill : BEGINπ regs.ah:=queue_mpx;π regs.al:=queue_kill;π regs.ds:=thefile.loc[2];π regs.dx:=thefile.loc[1];ππ Intr(queue_int, regs);ππ IF ((regs.flags AND fcarry) = fcarry)π THEN Spool := regs.axπ ELSE Spool := queue_ok;π END;ππ {----Deque ALL files, Returns Error or ok }π queue_purge : BEGINπ regs.ah := queue_mpx;π regs.al := queue_purge;ππ Intr(queue_int, regs);ππ IF ((regs.flags AND fcarry) = fcarry)π THEN Spool := regs.axπ ELSE Spool := queue_ok;π END;ππ {----Hold queue, returns error ORπ no. OF errors since last hold (dx) ?π (seems TO be no. OF looks at Printer port) &π queue RECORD WITH first queue_max filenames}π queue_hold : BEGINπ regs.ah:=queue_mpx;π regs.al:=queue_hold;ππ Intr(queue_int, regs);ππ IF ((regs.flags AND fcarry) = fcarry)π THEN Spool := regs.axπ ELSEπ {----Fill & return the queue record}π BEGINπ Spool:=queue_ok; {Regs.dx}π p:=Ptr(regs.ds,regs.si);ππ FOR i:=1 TO queue_max DO queue[i]:='';π i:=1;π WHILE (p^[i,1]<>#00) AND (i<=queue_max) DOπ BEGINπ j:=1;π WHILE (p^[i,j]<>#00) DOπ BEGINπ queue[i]:=queue[i]+p^[i,j];π Inc(j);π END;π Inc(i);π END;π END;π END;ππ {----Restart queue after function 4, Returns error or ok }πqueue_continue : BEGINπ regs.ah:=queue_mpx;π regs.al:=queue_continue;ππ Intr(queue_int, regs);ππ IF ((regs.flags AND fcarry) = fcarry)π THEN Spool := regs.axπ ELSE Spool := queue_ok;π END;π END;ππEND; {of Spool}ππ{$IFNDEF UNIT}ππ{---------------------------------------------------------}π{----MAIN PROGRAM }π{---------------------------------------------------------}ππVARπ i : INTEGER;ππBEGINπ FOR i:=1 TO queue_max DO queue[i]:='';ππ REPEATπ Writeln('Type cmd : 1 = submit, 2 = kill, 3 = purge, 4 = hold, 5 = continueππ CASE Readkey OFπ #27 : Halt;π '1' : Writeln('Function 1, result = ',Spool('\AUTOEXEC.BAT',1,queue_submiπ '2' : Writeln('Function 2, result = ',Spool('\AUTOEXEC.BAT',1,queue_killπ '3' : Writeln('Function 3, result = ',Spool('',1,queue_purge ));π '4' : BEGINπ Writeln('Function 4, result = ',Spool('',1,queue_hold ));π Writeln('Queue : ');π FOR i:=1 TO queue_max DOπ IF (queue[i]<>'')π THEN Writeln(i:2,' ',queue[i]);π END;π '5' : Writeln('Function 5, result = ',Spool('',1,queue_continue));π END;π UNTIL true=false;ππ{$ENDIF}ππEND.π 31 01-27-9417:30ALL MAYNARD PHILBROOK Bar Code Matrix Printers IMPORT 36 ε╡══ {πFrom: MAYNARD PHILBROOKπSubj: Re: bar codesπ---------------------------------------------------------------------------π HB> I'm in need of bar code type code. I want to print custom bar codesπ HB> and be able to scan them into an application. I also want to be ableπ HB> to do this directly from my application, not via a third party or a tsrπ HB> program.π}ππ{$F-,D-,S-,R-,V-,I-}π{ Prints 3 Of 9 Bar Codes other wise known as Code 39 }π{ May only work on EPSON or IBM Dot Matrix Printer !! }πUses Printer;π{$V-}πConst { Set up Defalt Settings }π Resolution:Byte = 2; { Vertical Grid Width per Line }π Hight :Byte = 3; { Number of rows to Print }π Passes :Byte = 2; { Number for Passing for Darkness }π Density :Byte = 1; { Printer Graphic Mode L or Z }π Graphic_Mode:Array[1..2] of String[1] = ('L','Z');π grid :array[0..43] of string[12] =π ('110100101011', {1}π '101100101011', {2}π '110110010101', {3}π '101001101011', {4}π '110100110101', {5}π '101100110101', {6}π '101001011011', {7}π '110100101101', {8}π '101100101101', {9}π '101001101101', {0}π '110101001011', {A}π '101101001011', {B}π '110110100101', {C}π '101011001011', {D}π '110101100101', {E}π '101101100101', {F}π '101010011011', {G}π '110101001101', {H}π '101101001101', {I}π '101011001101', {J}π '110101010011', {K}π '101101010011', {L}π '110110101001', {M}π '101011010011', {N}π '110101101001', {O}π '101101101001', {P}π '101010110011', {Q}π '110101011001', {R}π '101101011001', {S}π '101011011001', {T}π '110010101011', {U}π '100110101011', {V}π '110011010101', {W}π '100101101011', {X}π '110010110101', {Y}π '100110110101', {Z}π '100101011011', {-}π '110010101101', {.}π '100110101101', { }π '100101101101', {*}π '100100100101', {'$'}π '100100101001', {/}π '100101001001', {+}π '101001001001'); {%}πFunction Get_Grid(Yup:Char):String; { Translations Function }πVarπPT :Word;πBeginπ Get_Grid := '';π Case Yup Ofπ '1'..'9':Get_Grid := Grid[ Ord( Yup) -$31];π '0' :Get_Grid := Grid[9];π 'A'..'Z':Get_Grid := Grid[10+Ord(Yup)-65];π '-' :Get_Grid := Grid[36];π '.' :Get_grid := Grid[37];π ' ' :Get_Grid := Grid[38];π '*' :Get_Grid := Grid[39];π '$' :Get_Grid := Grid[40];π '/' :Get_Grid := Grid[41];π '+' :Get_Grid := Grid[42];π '%' :Get_Grid := Grid[43];π End;πEnd;πProcedure Send_Char(Yup :Char);πVarπHold :String;πL, G :Word;πOut_Bar :Byte;πBeginππ Hold := Get_Grid(Upcase(Yup));π If Hold <> '' Thenπ Beginπ Write(Lst,#27,Graphic_Mode[ Density ]); { Printer in Graph Mode }π Write(Lst,Char((Resolution * 12)+Resolution),#0); { How many Bytes ?}π For L := 1 To 12 Do { All 12 Chars }π Beginπ If Hold[L] ='1' Then Out_bar := 255 Else Out_bar := 0;π For G := 1 To Resolution Do Write(Lst, Char(Out_Bar));π End;π For L := 1 To Resolution Do Write(Lst, #0); { Charactor Separator }π End;πEnd;ππVarπ Number_IN :String[15];π L,LC, DS :Word;π T :Byte;πBeginπ Val(ParamStr(1), T, DS ); { Adjust Parameters if Needed }π If DS = 0 Then Resolution := T; { Width Ratio }π Val(ParamStr(2), T, DS );π If DS = 0 Then Hight := T; { Vertical Size of Label }π Val(ParamStr(3), T, DS );π If DS = 0 THen Passes := T; { For Darkness adjust }π Val(ParamStr(4), T, DS );π If (DS = 0)and( T in [1..2]) Then Density := T; { Printer Mode }π Repeatπ ReadLn(Number_IN);π If Number_IN <> '' Thenπ Beginπ Write(Lst,#27+'1'); { Set 7/72 Line Spacing }π For LC := 1 to Hight Do {Hight Loop }π Beginπ For DS := 1 To Passes Do { Double Strike }π Beginπ Send_Char('*'); { Must Create a '*' @ start & end }π For L := 1 To Byte(Number_IN[0]) Do Send_Char(Number_IN [ L ]);π Send_Char('*');π Write(Lst,#13);π End;π If Lc < Hight Then WriteLn(Lst) else WriteLn(Lst,#27,'2');π End;π { Print Number underneath Bars in center or close to it any ways }π WriteLn(Lst,' ':Resolution,Number_IN:((Byte(Number_IN[0])*(Resolution Div (Byte(Number_In[0])) div 2))));π End;πUntil Number_In = '';πEnd.π 32 01-27-9417:45ALL SWAG SUPPORT TEAM HP Laser Jet Functions IMPORT 57 ε╡└] UNIT HPUnit;π{ Handles all aspects of HP LASER JET PRINTERS}ππINTERFACEππUSESπ Crt,π Dos;ππCONSTπ Esc = #27;π HPReset = #27'E';ππ(* Page sizes... *)π Executive = #27'&l1A';π Letter = #27'&l2A';π Legal = #27'&l3A';π A4 = #27'&l26A';π Monarch = #27'&l80A';π Commercial10 = #27'&l81A';π InternationalDL = #27'&l90A';π InternationalCS = #27'&l91A';ππ (* orintation *)ππ Portrait = #27'&l0O';π Landscape = #27'&l1O';ππ (* symbol set... *)ππ HpRoman8 = #27'(8U';π PC8 = #27'(10U';ππ (* spacQcing... *)ππ Fixed = #27'(s0P';π Proportional = #27'(s1P';ππ (* style... *)ππ Upright = #27'(s0S';π Italic = #27'(s1S';ππ (* stroke... *)ππ Medium = #27'(s0B';π Bold = #27'(s1B';ππ (* typeface... *)ππ Lineprinter = #27'(s0T';π Courier = #27'(s3T';π Helv = #27'(s4T';π TmsRoman = #27'(s5T';π LetterGothic = #27'(s6T';π Prestige = #27'(s8T';π Presentations = #27'(s11T';π Optima = #27'(s17T';π TCGaramond = #27'(s18T';π CooperBlack = #27'(s19T';π CooperBold = #27'(s20T';π Broadway = #27'(s21T';π BauerBodoniBlackCondensed = #27'(s22T';π CenturySchoolBook = #27'(s23T';π UniversityRoman = #27'(s24T';ππ StartUnderLine = #27'&d0D';π StopUnderLine = #27'&d@';ππ(* functions and procedures ... *)ππFUNCTION Copies (CopyCount : INTEGER) : STRING;πFUNCTION LinesPerPage (LineCount : INTEGER) : STRING;πFUNCTION LinesPerInch (LineCount : INTEGER) : STRING;πFUNCTION PrimaryPitch (Pitch : INTEGER) : STRING;πFUNCTION PointSize (Points : REAL) : STRING;πFUNCTION PitchSize (Pitch : REAL) : STRING;πFUNCTION AbsHorizPos (Inches : REAL) : STRING;πFUNCTION AbsVertPos (Inches : REAL) : STRING;πPROCEDURE PlotXY (VAR PrnFile : TEXT;X, Y : REAL);πPROCEDURE PlotX (VAR PrnFile : TEXT; X : REAL);πPROCEDURE PlotY (VAR PrnFile : TEXT;Y : REAL);πFUNCTION FontId (Id : INTEGER) : STRING;πFUNCTION FontStatus (ID : INTEGER; Status : CHAR) : STRING;πFUNCTION FontPrimORSec (ID : INTEGER; Status : CHAR) : STRING;πPROCEDURE DownloadFont (FontFileName : STRING; Id : INTEGER; Status : CHAR;π StatusX, StatusY, StatusFore, StatusBack : INTEGER);πPROCEDURE EjectPage (VAR PrnFile : TEXT);ππIMPLEMENTATIONππCONSTπ BlockSize = 4096;ππTYPEπ BufferType = ARRAY [0..BlockSize - 1] OF BYTE;ππVARπ St : STRING;ππPROCEDURE WriteAT (x, y, f, b : BYTE; s : STRING);ππVARπ cnter : WORD;π vidPtr : ^WORD;π attrib : WORD;ππBEGINπ attrib := SWAP ( (b SHL 4) + f);π vidptr := PTR ($B800, 2 * (80 * PRED (y) + PRED (x) ) );π IF lastmode = 7 THENπ DEC (LONGINT (vidptr), $08000000); { MONO ?? }π FOR cnter := 1 TO LENGTH (s) DOπ BEGINπ vidptr^ := attrib OR BYTE (s [cnter]);π INC (vidptr);π END;πEND;πππFUNCTION Realstr (Num : REAL; D : BYTE) : STRING;π{ Return a string value (width 'w')for the input real ('n') }π VARπ Stg : STRING;π BEGINπ STR (Num : 10 : D, Stg);π WHILE Stg [1] = #32 DO DELETE (Stg, 1, 1);π Realstr := Stg;π END;ππFUNCTION IntStr (Num : LONGINT) : STRING;π VARπ Stg : STRING;π BEGINπ STR (Num : 10, Stg);π WHILE Stg [1] = #32 DO DELETE (Stg, 1, 1);π IntStr := Stg;π END;πππPROCEDURE Dta2Prn (BufferAddr : POINTER;π BufferSize : LONGINT); EXTERNAL;ππ{$L Dta2Prn.OBJ}ππFUNCTION Copies;ππ(* Get the string for the copycount... *)ππBEGINπ STR (CopyCount, St);π Copies := Esc + '&l' + St + 'X';πEND;ππFUNCTION LinesPerPage;ππBEGINπ STR (LineCount, St);π LinesPerPage := Esc + '&l' + St + 'F';πEND;ππFUNCTION LinesPerInch;ππBEGINπ STR (LineCount, St);π LinesPerInch := Esc + '&l' + St + 'D';πEND;ππFUNCTION PrimaryPitch;ππBEGINπ STR (Pitch, St);π PrimaryPitch := Esc + '(s' + St + 'H';πEND;ππFUNCTION PointSize;ππBEGINπ St := RealStr (Points, 2);π PointSize := Esc + '(s' + St + 'V';πEND;ππFUNCTION PitchSize;ππBEGINπ St := RealStr (Pitch, 2);π PitchSize := Esc + '(s' + St + 'H'πEND;ππFUNCTION AbsHorizPos;ππVARπ Dots : REAL;π DotSt : STRING;ππBEGINπ Dots := Inches * 300;π STR (ROUND (Dots), DotSt);π AbsHorizPos := Esc + '*p' + DotSt + 'X';πEND;ππFUNCTION AbsVertPos;ππVARπ Dots : REAL;π DotSt : STRING;ππBEGINπ Dots := Inches * 300;π STR (ROUND (Dots), DotSt);π AbsVertPos := Esc + '*p' + DotSt + 'Y';πEND;ππPROCEDURE PlotXY (VAR PrnFile : TEXT; X, Y : REAL);ππBEGINπ WRITE (PrnFile, AbsHorizPos (X) );π WRITE (PrnFile, AbsVertPos (Y) );πEND;ππPROCEDURE PlotX (VAR PrnFile : TEXT; X : REAL);ππBEGINπ WRITE (PrnFile, AbsHorizPos (X) );πEND;ππPROCEDURE PlotY (VAR PrnFile : TEXT; Y : REAL);ππBEGINπ WRITE (PrnFile, AbsVertPos (Y) );πEND;ππFUNCTION FontID;ππVARπ IdSt : STRING;ππBEGINπ STR (Id, IdSt);π FontID := Esc + '*c' + IdSt + 'D';πEND;ππFUNCTION FontPrimORSec;ππ(* Is the font you're about to send primary or secondary? Send *)π(* the function 'P' or 'S' *)ππVARπ IdSt : STRING;ππBEGINπ Status := UPCASE (Status);π STR (Id, IdSt);π CASE Status OFπ 'P' : FontPrimORSec := Esc + '(' + IdSt + 'X';π 'S' : FontPrimORSec := Esc + ')' + IdSt + 'X'π ELSE FontPrimORSec := '';π END; (* Case *)πEND;ππFUNCTION FontStatus;ππVARπ IdSt : STRING;ππBEGINπ Status := UPCASE (Status);π STR (Id, IdSt);π CASE Status OFπ 'P' : FontStatus := Esc + '*c5' + 'F'; (* Permanent *)π 'T' : FontStatus := Esc + '*c4' + 'F'; (* Temp *)π ELSE FontStatus := '';π END; (* Case *)πEND;ππPROCEDURE DownloadFont;ππVARπ ListFile : TEXT;π PrnFile,π FontFile : FILE;π Buffer : BufferType;π RecsRead : INTEGER;ππBEGINπ ASSIGN (FontFile, FontFileName);π RESET (FontFile, 1);π ASSIGN (PrnFile, 'PRN');π REWRITE (PrnFile, 1);π ASSIGN (ListFile, 'PRN');π REWRITE (ListFile);π WRITE (ListFile, HPReset);π WRITE (ListFile, FontID (Id) );π WHILE NOT (EOF (FontFile) ) DOπ BEGINπ BLOCKREAD (FontFile, Buffer, SIZEOF (Buffer), RecsRead);π IF (StatusX <> 0) OR (StatusY <> 0) THENπ WriteAt (StatusX, StatusY, StatusFore, StatusBack,π IntStr (ROUND (FILEPOS (FontFile) / FILESIZE (FontFile) * 100) ) +π ' % downloaded...');π Dta2Prn (@Buffer, RecsRead);π END;π CLOSE (FontFile);π WRITE (ListFile, FontStatus (Id, Status) );π WRITE (ListFile, FontPrimORSec (Id, 'P') );π CLOSE (PrnFile);π CLOSE (ListFile);πEND;ππPROCEDURE EjectPage (VAR PrnFile : TEXT);ππBEGINπ WRITE (PrnFile, Esc + '&l0H');πEND;ππEND. (* unit *)ππ{ππCUT THIS OUT TO A SEPARATE FILE .. DTA2PRN.XX, and execute XX34 D filenameπto create the OBJ file needed for this unitππ*XX3402-000499-170789--72--85-40996-----DTA2PRN.OBJ--1-OF--1πU-Q+3IAuL3FEL2x0GZl2J22mI37C9Y3HHHe65k+++3FpQa7j623nQqJhMalZQW+UJaJmQqZjπPW+l9X0uW-o+ECYgHisG3IAuL3FEL2x0GZl2J22mI37C9Y3HHMa6+k-+uImK+U++O7M4++F1πHoF3FNU5+0UP++6-+FeE1U+++ER2J22mI37C++++LsU3+21V4E+tW+E+E86-YMU3+21e-+-3πW+U+ECAM++M+8UK60E-+slY++++Y++y60E-+slc++++Y+Eq6M+-+sY++++++++JDH2F0I+d+π+U+++++5IYJIEIF2IUd+-++++++6EZJ4FYJGIpc8E+M+++++0I7JFYN3IZB3Fkd+0++++++7πEZJ4FYJGHoNH0Y+8++++U+R3HYFBEJ7903O62E-+slg5HotHJ231Gkg+6+++t6US+21c+-J1πCZlII3lDEYdQF3F-AZ-GHWt-IoogHisGWNEr+++-4U+++-g++E+d++A+8U+3+0o+0++i++g+πA++B+16+1k+n+-2+B++H+1Q+3E+s+-Q+CE+M+2061E-+tURDHZBIEIB94kQ7W-2+ECM5F3F-πAZ-GHVY+++2++0K61U-+tUFCFJVI4E+++Eo+qe+T++2++3K9v1D7Wos2WrM6Ax6qf19YnFTWπy6jZLQ64+288+U++R+++π***** END OF BLOCK 1 *****ππ 33 02-15-9408:03ALL RICHARD GRIFFIN Printout with error checkIMPORT 31 ε╡ {$I-}ππunit Printout;ππ{ This unit replaces the Printer unit for output via the write(lst). Errorπ checking is done and a message is printed asking for operator intervention.π Printing can be terminated by pressing the Escape key. A flag, Esc_Lst isπ set true if Escape is pressed, and can be used by the program to test forπ that condition. The program must reset Esc_Lst to false (Esc_Lst := false)π before trying to print anything else, or the write command will be ignored.ππ Richard F. Griffin, Omaha, NE 14 Jan 1988π CIS 75206.231π }ππinterfaceππuses Crt, Dos;ππvarπ Esc_Lst : boolean;π Lst: Text;ππimplementationππvarπ Inch, Fnch : char;π SecNum : boolean;π KeyNum : integer;ππfunction GetKey : boolean;πbeginπ Esc_Lst := false;π if KeyPressed then beginπ GetKey := true;π Inch := ReadKey;π KeyNum := ord(Inch);π Secnum := KeyNum = 0;π if Secnum thenπ beginπ Fnch := ReadKey;π Keynum := ord(Fnch);π endπ else if ord(Inch) <= 27 then Secnum := true else Secnum := false;π endπ else beginπ Getkey := false;π secnum := false;π end;πend;ππprocedure Lst_Err;πvarπ AsczStr : string[84];πbeginπ gotoxy(2,14);π AsczStr := concat (#7,'Please Check Printer! ',π ' Use [ESC] to Exit, ',π 'Any Other Key to Continue.');π write(AsczStr);π repeat until GetKey;π if (Secnum) and (Keynum = 27) then Esc_Lst := true;π gotoxy(2,14);π write('':length(AsczStr));πend;ππprocedure WriteLst (TheStr : char);πLabel Skip;πVARπ rgstr : Registers;π goodio : boolean;π i : integer;πbeginπ goodio := false;π i := 0;π repeatπ If Esc_Lst then goto Skip;π with rgstr doπ beginπ dx := $0000;π ax := $0200;π intr($17,rgstr);π while (ax and $8000) = 0 doπ beginπ dx := $0000;π ax := $0200;π intr($17,rgstr);π i := i + 1;π if i = 20000 thenπ beginπ Lst_Err;π If Esc_Lst then goto Skip;π i := 0;π end;π if GetKey thenπ if (Secnum) and (Keynum = 27) then Esc_Lst := true;π If Esc_Lst then goto Skip;π end;π dx := $0000;π ax := ord(TheStr);π intr($17,rgstr);π if (ax and $2900) <> 0 then Lst_Errπ else goodio := true;π If Esc_Lst then goto Skip;π if GetKey thenπ if (Secnum) and (Keynum = 27) then Esc_Lst := true;π end;π until goodio or Esc_Lst;πSkip:πend;ππ{$F+}ππfunction LstInOut(var F : TextRec) : integer;πvar i : word;πbeginπ with F doπ beginπ i := 0;π while i < BufPos doπ beginπ WriteLst(BufPtr^[i]);π inc(i);π end;π BufPos := 0;π end;π LstInOut := 0;πend;ππfunction LstClose(var F : TextRec) : integer;πvar i : word;πbeginπ with F doπ beginπ i := 0;π while i < BufPos doπ beginπ WriteLst(BufPtr^[i]);π inc(i);π end;π WriteLst(#10);π WriteLst(#13);π BufPos := 0;π end;π LstClose := 0;πend;πππfunction LstOpen(var F : TextRec) : integer;πbeginπ with F doπ beginπ Mode := fmOutPut;π InOutFunc := @LstInOut;π FlushFunc := @LstInOut;π CloseFunc := @LstClose;π BufPos := 0;π LstOpen := 0;π end;π Esc_Lst := false;πend;ππ{$F-}ππbeginπ with TextRec(Lst) doπ beginπ Handle := $FFFF;π Mode := fmClosed;π BufSize := Sizeof(Buffer);π BufPtr := @Buffer;π OpenFunc := @LstOpen;π Name[0] := #0;π Rewrite(Lst);π end;πend.π 34 02-15-9408:05ALL SWAG SUPPORT TEAM PrintScreen for Text ModeIMPORT 8 ε╡ Unit PrntScrn; (* PrintScreen Unit for regular text modes *)ππ(*--*) Interface (*--*)ππProcedure PrintScreen;ππ(*--*) Implementation (*--*)ππUses Dos,Crt,Printer;ππProcedure PrintScreen;πVarπ line : string[80];π x,y : integer;π Ms : Registers;ππBeginπ Ms.Ax := $10 shl 8 + $1a; (* Read the current Page state *)π Intr($10,Ms);π For y := 1 to 25 do Begin (* Do lines 1 to 25 *)π Line := '';π For x := 1 to 80 do Begin (* and columns 1 to 80 *)π Gotoxy(x,y); (* Move cursor *)π Ms.Ax := $8 shl 8; (* Read character at cursor *)π Intr($10,Ms);π Line := Line + Chr(Lo(Ms.Ax)); (* Add to total line *)π End;π Writeln(lst,Line); (* Write to printer *)π End;πEnd;ππEnd. (* PrntScrn UNIT *) 35 08-24-9413:52ALL MIKE COPELAND Is Printer Online ?? SWAG9408 c4╞ƒ 6 ε╡ {π>> I'm using TP6 and plan to use to the PRINTER.TPU unit theπ>> write to the printer. How do you detect whether the printerπ>> is on or not without ending up a dos error and the programπ>> halting.ππ You need to check the status of the printer port. Something likeπthis:π}ππfunction TESTONLINE : Byte; { Tests for Printer On Line }πvar REGS : Registers;πbeginπ with REGS doπ beginπ AH := 2; DX := 0;π Intr($17, Dos.Registers(REGS));π TESTONLINE := AHπ endπend; { TESTONLINE }ππ if TESTONLINE = 144 then okay_to_printπ else printer_not_readyππ 36 08-25-9409:06ALL RANDALL ELTON DING Printing Graphics SWAG9408 ├╜q╔ 44 ε╡ {πFrom: randyd@alpha2.csd.uwm.edu (Randall Elton Ding)ππAll those c/pascal flames are becoming nauseating.πMy kill file leaves me with about 10 articles per day now.πFor people like me ignoring this B.S., here is somethingπfor fun.ππThis very elegantly plots a cycloid in 3d with hidden lines.πRemember that a cycloid is what you get when you trace a singleπpoint of a circle in rolling motion.ππEmail me if you would like the normal cartesian plotter.ππ------------------------------------------------------------------ππ(* Three Dimensional Plotter (modified for this parametric equ.)π written by Randy Dingπ randyd@alpha2.csd.uwm.eduπ original December 1983 (UCSD pascal)π update April 13,1991 (turbo pascal) *)π}π{$N+}πprogram plotter;ππuses graph;πππconstπ bgipath = 'e:\bp\bgi'; { !set this to your bgi directory }πππconstπ displaysizex= 9.75; { inches, for width/height ratios }π displaysizey= 7; { inches }π maxrightscreen= 999; { !make this bigger if you have incredible graphics }ππtypeπ realtype= single;π scrnarry= array [0..maxrightscreen] of integer; { for hidden line data }ππvarπ toplim,botlim,previousx,botscreen,rightscreen: integer;π colr: word;π top,bot: scrnarry;π alpha,beta,scale,centerx,centery,posx,negx,posy,negy,stepx,stepy: realtype;πππprocedure hideline (x,y,x2,y2: integer);π var slope,yr: realtype;ππ procedure vline (ytop,ybot: integer); { at x with colr }π var temp: integer;ππ beginπ if (x>=0) and (x<=rightscreen) then beginπ if ytop > ybot then beginπ temp:= ytop; ytop:= ybot; ybot:= temp;π end;π if x <> previousx then beginπ toplim:= top [x];π botlim:= bot [x];π end;π if ytop < top [x] then top [x]:= ytop;π if ybot > bot [x] then bot [x]:= ybot;π while ytop <= ybot do beginπ if (ytop < toplim) or (ytop > botlim) then putpixel (x,ytop,colr);π ytop:= ytop+1;π end;π end;π previousx:= x;π end;ππ beginπ yr:= y;π if x <> x2 then beginπ slope:= (y2-y)/(x2-x);π while x <> x2 do beginπ yr:= yr+slope;π vline (y,trunc(yr));π y:= trunc(yr);π if x < x2 then inc(x) else dec(x);π end;π end;π vline (y,y2);π end;πππprocedure initline;π var x:integer;ππ beginπ for x:= 0 to rightscreen do beginπ top [x]:= botscreen+1;π bot [x]:= -1;π end;π end;πππ{ The regular cartesian plot routine has been modified to plot thisπ parametric equation and a slope counter has been added to make theπ plotting slow down near the points, helping to make them crisp.π The cycloid parametric function: x=u-sin(u), y=cos(u) }ππprocedure plot;π varπ correction,sa,ca,sb,cb,x,y,z,rho,lou,hiu,du,u,dy,oldz: realtype;π oldx,oldy,screenx,screeny,slopecounter: integer;π newline: boolean;π ch: char;ππ beginπ correction:= scale*(displaysizey/(botscreen+1))π /(displaysizex/(rightscreen+1));π sa:= sin(alpha*pi/180);π ca:= cos(alpha*pi/180);π sb:= sin(beta*pi/180);π cb:= cos(beta*pi/180);π previousx:= -1;π x:= posx;π while x >= negx do beginπ newline:= true;π y:= negy;π while y <= posy do beginπ rho:= sqrt(sqr(x)+sqr(y));π lou:= rho-1;π hiu:= rho+1;π repeat { solve the parametric equation by iteration }π u:= (lou+hiu)/2;π du:= rho-(u-sin(u)); { u-sin(u) is an increasing function }π if du>0 then lou:= u else hiu:= u;π until abs(du) < 0.001;π z:= 3*cos(u); { user parametric function x=u-sin(u), y=cos(u) }π screenx:= trunc ((y*ca-x*sa)*correction+centerx);π screeny:= trunc (centery-((y*sa+x*ca)*sb+z*cb)*scale);π if newline then beginπ slopecounter:= 0;π dy:= stepy; { make dy normal for long straight runs }π endπ else if (z-oldz)/dy > 1.5 then beginπ slopecounter:= 5;π dy:= stepy/10; { make dy small close to the peaks }π endπ else if slopecounter=0 then dy:= stepy else dec(slopecounter);π y:= y + dy;π oldz:= z;π if not newline then hideline(oldx,oldy,screenx,screeny)π else newline:= false;π oldx:= screenx;π oldy:= screeny;π end;π x:= x - stepx;π end;π end;πππprocedure setdefault;π { with no rotation, x axis is out of the screen, y axis is to the rightπ and z axis is up; alpha and beta make the figure rotateπ (pos is clockwise) within the fixed coordinate axisπ draw figure from screen front to back for hidden lines to work properly }ππ beginπ alpha:= 30; { rotates figure clockwise about z axis }π beta:= -40; { rotates figure clockwise about y axis }π scale:= 10;π centerx:= (rightscreen+1)/2;π centery:= (botscreen+1)/2;π posx:= 20; { currently set up for functions z of x,y }π negx:= -posx; { change user function z above in plot procedure }π posy:= 20;π negy:= -posy;π stepx:= 0.5;π stepy:= 0.1;π colr:= white;π end;πππprocedure initbgi;π var errcode,grmode,grdriver: integer;π beginπ grdriver:= detect;π grmode:= 0;π initgraph (grdriver,grmode,bgipath);π errcode:= graphresult;π if errcode <> grok then beginπ writeln ('Graphics error: ',grapherrormsg (errcode));π halt (1);π end;π end;πππbeginπ initbgi;π botscreen:= getmaxy;π rightscreen:= getmaxx;π initline;π setdefault;π plot;π readln;π closegraph;πend.ππ 37 08-25-9409:09ALL MARTIN PREISHUBER Postscript File ManipulatSWAG9408 e7` 63 ε╡ {ππDate: 07-03-94 (04:34) Number: 131410 of 132082 (Refer# NONE)π To: KERRY SOKALSKYπFrom: MARTIN_P@EFN.EFN.ORGπSubj: Re: SWAGπRead: 07-04-94 (01:01) Status: RECEIVER ONLYπConf: Internet_Mail (104) Read Type: READING ALL (+)ππFrom: Martin Preishuber <martin_p@efn.efn.org>ππpostscrp.pas unit, to create postscript files.. it includes theπ common commands like line, outtext and so onπpsdemo.pas demo program for postscrp.pas. i made it to show, howπ to use the PSSetViewPort and PSOpen-commands.ππ}ππPROGRAM PSDemo;ππUSES Postscrp;ππBEGINπ PSSetViewPort(0, 0, 21, 29.7);π PSOpen('test.ps', 0, 479, 639, 479);π PSTextSettings('Times-Roman', 40);π PSOutTextXY(100, 100, 'Test');π PSClose;πEND.πππUNIT PostScrp;ππINTERFACEππUSES Dos, Graph;ππTYPE Viereck = ARRAY[1..4] OF PointType;π Polygon = ARRAY[1..100] OF PointType;ππPROCEDURE PSSetViewPort(x1, y1, x2, y2 : REAL);πPROCEDURE PSSetGray(intensity : REAL);πPROCEDURE PSSetCmykColor(cyan, magenta, yellow, black : REAL);πPROCEDURE PSSetRGBColor(rot, gruen, blau : REAL);πPROCEDURE PSSetHsbColor(hue, saturation, brightness : REAL);πPROCEDURE PSTextSettings(font : STRING; groesse : WORD);πPROCEDURE PSTextAngle(angle : REAL);πPROCEDURE PSOuttextxy(x, y : REAL; s : STRING);πPROCEDURE PSWriteNum(x, y, num : REAL);πPROCEDURE PSCircle(x, y, radius : REAL);πPROCEDURE PSLineWidth(x : REAL);πPROCEDURE PSLine(x1, y1, x2, y2 : REAL);πPROCEDURE PSRectangle(x1, y1, x2, y2 : REAL);πPROCEDURE PSMoveTo(x, y : REAL);πPROCEDURE PSLineTo(x, y : REAL);πPROCEDURE PSBar(x1, y1, x2, y2 : REAL);πPROCEDURE PsFillViereck(VAR points : Viereck);πPROCEDURE PSFillPoly(anzahl : BYTE; VAR PolyPoints : Polygon);πPROCEDURE PSOpen(filename : STRING; ursprx, urspry, maxx, maxy : WORD);πPROCEDURE PSClose;πFUNCTION PSError : BOOLEAN;πFUNCTION PixelToZoll(x : REAL) : WORD;ππIMPLEMENTATIONππCONST einheit = 2.54/72;π faktor = 3/140;ππVAR psfile : Text;π error : BOOLEAN;π dx, dy,π ux1, uy1,π xdim, ydim,π diffx, diffy : REAL;π newviewport : BOOLEAN;ππFUNCTION PSError : BOOLEAN;πBEGINπ PSError := error;πEND;ππPROCEDURE PSSetViewPort(x1, y1, x2, y2 : REAL);πVAR breite,hoehe : REAL;πBEGINπ breite := x2 - x1;π IF breite <= 0 THEN breite := 15;π hoehe := y2 - y1;π IF hoehe <= 0 THEN hoehe := 15;π ux1 := x1 / einheit;π uy1 := y1 / einheit;π xdim := breite / einheit;π ydim := hoehe / einheit;π newviewport := TRUE;πEND;ππPROCEDURE PSSetGray(intensity : REAL);πBEGINπ WriteLn(psfile, intensity:4:2, ' sg');πEND;ππPROCEDURE PSSetRGBColor(rot, gruen, blau : REAL);πBEGINπ WriteLn(psfile, rot:4:2, ' ', gruen:4:2, ' ', blau:4:2, ' sr');πEND;ππPROCEDURE PSSetCmykColor(cyan, magenta, yellow, black : REAL);πBEGINπ WriteLn(psfile,cyan:4:2, ' ', magenta:4:2, ' ', yellow:4:2, ' ', black:4:2,'πsc');πEND;ππPROCEDURE PSSetHsbColor(hue, saturation, brightness : REAL);πBEGINπ WriteLn(psfile, hue:4:2, ' ', saturation:4:2, ' ', brightness:4:2, ' sh');πEND;ππFUNCTION PixelToZoll(x : REAL) : WORD;πBEGINπ PixelToZoll := Round(x * dx);πEND;ππPROCEDURE PSTextSettings(font : STRING; groesse : WORD);πBEGINπ WriteLn(psfile, '/', font, ' findfont ',groesse,' scalefont setfont');πEND;ππPROCEDURE PSTextAngle(angle : REAL);πBEGINπ WriteLn(psfile, angle:4:2,' rotate');πEND;ππPROCEDURE PSOuttextxy(x,y : REAL; s : STRING);πBEGINπ x := x - diffx;π y := diffy - y;π WriteLn(psfile, x * dx:4:2, ' ', y * dy:4:2, ' m');π WriteLn(psfile, '(',s,')', ' show');πEND;ππPROCEDURE PSWriteNum(x, y, num : REAL);πVAR help : STRING;πBEGINπ x := x - diffx;π y := diffy - y;π Str(num:4:2, help);π WriteLn(psfile, x * dx:4:2, ' ', y * dy:4:2, ' m');π WriteLn(psfile, '(',help,')', ' show');πEND;ππPROCEDURE PSCircle(x, y, radius : REAL);πBEGINπ x := x - diffx;π y := diffy - y;π WriteLn(psfile, x * dx:4:2, ' ', y * dy:4:2, ' ', radius:4:2, ' 0 360 arcπs');πEND;ππPROCEDURE PSLineWidth(x : REAL);πBEGINπ WriteLn(psfile, x:4:2, ' setlinewidth');πEND;ππPROCEDURE PSLine(x1, y1, x2, y2 : REAL);πBEGINπ x1 := x1 - diffx;π y1 := diffy - y1;π x2 := x2 - diffx;π y2 := diffy - y2;π WriteLn(psfile, x1 * dx:4:2, ' ', y1 * dy:4:2, ' m');π WriteLn(psfile, x2 * dx:4:2, ' ', y2 * dy:4:2, ' l s');πEND;ππPROCEDURE PSRectangle(x1, y1, x2, y2 : REAL);πVAR xn1, xn2, yn1, yn2 : REAL;πBEGINπ x1 := x1 - diffx;π y1 := diffy - y1;π x2 := x2 - diffx;π y2 := diffy - y2;π xn1 := x1 * dx;π yn1 := y1 * dy;π xn2 := x2 * dx;π yn2 := y2 * dy;π WriteLn(psfile, 'n');π WriteLn(psfile, xn1:4:2, ' ', yn1:4:2, ' m');π WriteLn(psfile, xn2:4:2, ' ', yn1:4:2, ' l');π WriteLn(psfile, xn2:4:2, ' ', yn2:4:2, ' l');π WriteLn(psfile, xn1:4:2, ' ', yn2:4:2, ' l');π WriteLn(psfile, 'c s');πEND;ππPROCEDURE PSMoveTo(x, y : REAL);πBEGINπ x := x - diffx;π y := diffy - y;π WriteLn(psfile, x * dx:4:2, ' ', y * dy:4:2, ' m');πEND;ππPROCEDURE PSLineTo(x, y : REAL);πBEGINπ x := x - diffx;π y := diffy - y;π WriteLn(psfile, x * dx:4:2, ' ', y * dy:4:2, ' l');πEND;ππPROCEDURE PSBar(x1, y1, x2, y2 : REAL);πVAR xn1, xn2, yn1, yn2 : REAL;πBEGINπ x1 := x1 - diffx;π y1 := diffy - y1;π x2 := x2 - diffx;π y2 := diffy - y2;π xn1 := x1 * dx;π yn1 := y1 * dy;π xn2 := x2 * dx;π yn2 := y2 * dy;π WriteLn(psfile, 'n');π WriteLn(psfile, xn1:4:2, ' ', yn1:4:2, ' m');π WriteLn(psfile, xn2:4:2, ' ', yn1:4:2, ' l');π WriteLn(psfile, xn2:4:2, ' ', yn2:4:2, ' l');π WriteLn(psfile, xn1:4:2, ' ', yn2:4:2, ' l');π WriteLn(psfile, 'c');π WriteLn(psfile, 'f');πEND;ππPROCEDURE PsFillViereck(VAR points : Viereck);πBEGINπ WriteLn(psfile, 'n');π WriteLn(psfile, (points[1].x - diffx) * dx:4:2, ' ', (diffy - points[1].y) *πdy:4:2, ' m');π WriteLn(psfile, (points[2].x - diffx) * dx:4:2, ' ', (diffy - points[2].y) *πdy:4:2, ' l');π WriteLn(psfile, (points[3].x - diffx) * dx:4:2, ' ', (diffy - points[3].y) *πdy:4:2, ' l');π WriteLn(psfile, (points[4].x - diffx) * dx:4:2, ' ', (diffy - points[4].y) *πdy:4:2, ' l');π WriteLn(psfile, 'c');π WriteLn(psfile, 'f');πEND;ππPROCEDURE PSFillPoly(anzahl : BYTE; VAR PolyPoints : Polygon);πVAR i : BYTE;πBEGINπ IF anzahl = 1 THENπ ELSEπ IF anzahl=2 THENπ PSLine(PolyPoints[1].x, PolyPoints[1].y, PolyPoints[2].x,πPolyPoints[2].y)π ELSEπ BEGINπ WriteLn(psfile, 'n');π WriteLn(psfile, (PolyPoints[1].x - diffx) * dx:4:2, ' ', (diffy -πPolyPoints[1].y) * dy:4:2, ' m');π FOR i := 2 TO anzahl DOπ WriteLn(psfile, (PolyPoints[i].x - diffx) * dx:4:2, ' ', (diffy -πPolyPoints[i].y) * dy:4:2, ' l');π WriteLn(psfile, 'c');π WriteLn(psfile, 'f');π END;πEND;ππPROCEDURE PSOpen(filename : STRING; ursprx, urspry, maxx, maxy : WORD);πBEGINπ error:=FALSE;π Assign(psfile,filename);π {$I-}π Rewrite(psfile);π {$I+}π IF IOResult<>0 THENπ error:=FALSEπ ELSEπ BEGINπ diffx:=ursprx;π diffy:=urspry;π IF newviewport THENπ BEGINπ WriteLn(psfile,'%!PS-Adobe-2.0');π WriteLn(psfile,'/l',' ','{ lineto } def');π WriteLn(psfile,'/li',' ','{ line } def');π WriteLn(psfile,'/m',' ','{ moveto } def');π WriteLn(psfile,'/f',' ','{ fill } def');π WriteLn(psfile,'/n',' ','{ newpath } def');π WriteLn(psfile,'/c',' ','{ closepath } def');π WriteLn(psfile,'/s',' ','{ stroke } def');π WriteLn(psfile,'/sr',' ','{ setrgbcolor } def');π WriteLn(psfile,'/sh',' ','{ sethsbcolor } def');π WriteLn(psfile,'/sc',' ','{ setcmykcolor } def');π WriteLn(psfile,'/sg',' ','{ setgray } def');π WriteLn(psfile,ux1:4:2,' ',uy1:4:2,' ','translate');π dx:=xdim/maxx;π dy:=ydim/maxy;π ENDπ ELSEπ BEGINπ dx:=800/maxx;π dy:=750/maxy;π END;π WriteLn(psfile,'n');π END;πEND;ππPROCEDURE PSClose;πBEGINπ WriteLn(psfile,'showpage');π {$I-}π Close(psfile);π {$I+}π IF IOResult<>0 THEN error:=TRUE;πEND;ππBEGINπ newviewport:=FALSE;πEND.ππ 38 08-25-9409:10ALL RANDALL ELTON DING Printing Graphics SWAG9408 -╝∞╝ 36 ε╡ {πFrom: randyd@alpha2.csd.uwm.edu (Randall Elton Ding)ππ>How do you get an Epson-compatible 24-pin printer to print graphics?π>Printing text is simple... just open the appropriate LPT port andπ>redirect text into it.π>π>I suppose if I had a manual for the printer I could find out what any ofπ>the escape codes are.ππHere is a routine I wrote years agoπfor my old Epson MX-100 (made in early 80's)πYou should get some ideas from this program, it may even be capableπof being modified to work with your printer.πI don't know if the escape codes are the same, you'll have toπlook them up. BTW, this printer is a 9 pin and only 8 are used.πThats convenient because each print head pass generates 8 pixils highπper character sent. I don't know how your 24 pin works.π}ππprogram develop; { developed for Epson MX-100 and EGA screen }ππuses graph;ππconstπ rotate90= true;π widepaper= false;π bgipath: string = 'e:\bp\bgi';πππprocedure initbgi;π varπ errcode,grdriver,grmode: integer;ππ beginπ grdriver := Detect;π initgraph(grdriver,grmode,bgipath);π errcode:= graphresult;π if errcode <> grok then beginπ writeln('Graphics error: ',grapherrormsg (errcode));π halt(1);π end;π end;ππππprocedure developgraph(rotate: boolean);π { if passed parameter is true, the graphicsπ image will be rotated 90 degrees to fit onπ a narrow sheet of printer paper, if falseπ the image will completely fill the wideπ paper erect and double height }ππ const maxprinter = 816; { maximum width of printer }ππ varπ graphwidth,graphheight,printerwidth,printerheight: integer;π n1,n2,sx,sy,x,y,y2,pixcolr: integer;π widthratio,heightratio: real;π blank: boolean;π bitloc,bits: byte;π bytes: array [1..maxprinter] of byte;π lst: text;ππ beginπ assign(lst,'lpt1');π rewrite(lst);π case rotate ofπ widepaper: begin { develop erect on wide paper }π graphwidth:= getmaxx+1;π graphheight:= getmaxy+1;π printerwidth:= maxprinter; { scale 1.275 x 2 }π printerheight:= graphheight*2;π end;π rotate90: begin { if rotate then reverse x and y }π graphwidth:= getmaxy+1;π graphheight:= getmaxx+1;π printerwidth:= graphwidth; { scale 1 x 1 }π printerheight:= graphheight;π end;π end;π n2:= printerwidth div 256;π n1:= printerwidth mod 256;π write(lst,chr(27),'A',chr(8)); { set line spacing to 8 }π widthratio:= printerwidth/graphwidth;π heightratio:= printerheight/graphheight;π y:= 0;π while y < printerheight do beginπ blank:= true; { remains true if entire printer pass is blank }π for x:= 1 to printerwidth do beginπ sx:= trunc((x-1)/widthratio); { screen x coorid }π bits:= 0;π bitloc:= $80;π for y2:= y to y+7 do beginπ sy:= trunc(y2/heightratio); { screen y coorid }π if sy < graphheight then begin { last printer pass is incomplete }π case rotate ofπ widepaper: pixcolr:= getpixel(sx,sy);π rotate90: pixcolr:= getpixel(sy,sx); { x and y swaped }π end;π if pixcolr > 0 then bits:= bits or bitloc;π end;π bitloc:= bitloc shr 1;π end;π case rotate ofπ widepaper: bytes[x]:= bits;π rotate90: bytes[printerwidth-x+1]:= bits; { reverse image }π end;π if bits > 0 then blank:= false; { have something to print this pass }π end;π if not blank then begin { line feed if nothing to print this pass }π write (lst,chr(27),'K',chr(n1),chr(n2)); { set printer graph mode }π for x:= 1 to printerwidth do write (lst,chr(bytes[x]));π end;π writeln(lst); { output 8 printer pixels high per pass }π y:= y+8;π end;π write(lst,chr(12)); { top of form }π write(lst,chr(27),'@'); { re-initalize printer }π close(lst);π end;πππbeginπ initbgi;ππ { your graphics code here }π Line(100,100,200,100);π Line(200,100,200,100);π Line(100,200,200,100);π Line(100,100,200,200);π SetColor(Blue);π Circle(300,200,50);ππ developgraph(rotate90); { or use (widepaper) }πend.ππ