SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00034 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?ãã--------------
------------ã}ãã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 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. 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!!! *)ã (* 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ã [email protected]ã [email protected]ã}ãã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.... . 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 *)
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/