advertisement moved to bottom of page to improve page loading time
10  Interesting Q&A from various newsgroups
unsorted, uncommented, simply copied from NG - mails (without written permission of the authors)
Please mail me if you do not agree - want to have removed your mail here.


last updated: Apr-09 1999    Index 1QA go to 1QA index page


    Subject: Re: Unterschied: as <-> normaler Downcast
       Date: Sat, 27 Feb 1999 16:41:19 GMT
       From: tgl@gmx.de (Thomas G. Liesner)
   Reply-To:feedback@tgl.westfalen.de
Organization: TGL-Soft
 Newsgroups: de.comp.lang.pascal.delphi

Marc Thorstens schrieb:
>Nun ja, wie gesagt, auch der andere Pointer-Typecast wirft im Fehlerfall
>eine Exception.

Nein. Es _kann_ eine Exception geben, es kann aber auch ein
spektakulärer Windows-Crash folgen. Eigentlich ist prinzipiell alles
möglich, je nachdem welchen Typ man in welchen Typ castet und welche
Eigenschaft man nutzen will - eine Methode aufzurufen dürfte z.B. sehr
heftige Wirkungen haben können.

Bei einem "as" gibt es entweder eine definierte Exception oder es
funktioniert _garantiert_ ohne weitere mögliche
Seiteneffekte/Folgeschäden.

>Wenn man mal parallelen zieht, so entspricht die as-Umwandlung etwa dem Cast
>in Java? Aufgrund der Typprüfung ist dieser eben ziemlich lahm.

Klingt so.

>Die harte Konvertierung, wie sie etwa in C geschieht (?), ist daher eben auch sehr
>viel schneller, da einfach nur Bitmuster neu interpretiert werden.

Ack.

>Aber, ist das überhaupt so?  Ist der TControl(O)-Cast mit der
>C-Konvertierung, der (O as TControl) mit der Java-Konvertierung
>gleichzusetzen?

IMHO ja.

>Denn dann müßte TControl(O) ja wirklich sehr viel schneller
>sein. Wenn man in einem Fall sowieso vom Erfolg der Konvertierung ausgeht,
>könnte man ja die harte Umwandlung nehmen und gewinnt Rechenzeit.

Yup. Alternativ kann man auch so vorgehen:

   If xyz is TAbc then With TAbc(xyz) do begin
     ...
   end else Showmessage('#Interner Fehler# ...')

>Ist das so, oder wird eh immer geprüft? Weshalb dann aber die
>unterschiedlichen Exceptions?

Weil das zweite ein Zufallsergebnis ist und keine explizite
"Casting-failed"-Exception.

>Oder wird nur bei as geprüft?  Wieso dann aber eine Exception bei
>TControl(O) und keine Schutzverletzung?

Letzteres passiert häufiger.

So long,
Thomas G. Liesner



    Subject: Re: Töne   sound frequencies
       Date: 2 Mar 1999 16:57:29 +0100
      From: Gernot Zander <hifi@gmx.de>
 Organization: Scorpio, Berlin-Altglienicke
 Newsgroups: de.comp.lang.pascal.misc

Hi,

in de.comp.lang.pascal.misc Arved <ArvedK@t-online.de> wrote:
> > >hat jemand die Frequenzhöhen von Musiknoten im Violin oder Bass
> > >Schlüssel? Oder weiss, wie man diese berechnen kann? Wenn ja, wäre ich
> > >euch sehr dankbar wenn ihr sie mir zukommen lasst.
> > Das steht in JEDEM Tafelwerk. Hat man so ab der 7. Klasse, dieses
> > Büchlein ;)

> "Das is falsch, das is ja sowas von falsch, also da kann ich dir gar nich sagen, wo der
Fehler liegt!" ;-> [Anlehnung an C.P.-K.]
> Aber, es steht garantiert nicht in jedem Tafelwerk drin, und zumindest bei uns gab es das
Tafelwerk erst ab Klasse 8.
 

Berechnung: Man geht von A aus (440 Hz), und multipliziert die
mit der 12. Wurzel aus 2 (denn nach 12 Schritten ist man beim
A' mit 880 Hz). Bzw. Dividiert, wenn man die andere Richtung
ausrechnet. Bitte dabei nicht runden, die Rundungsfehler addieren
sich sonst ggf., also erst vor dem Spielen oder Eintippen
oder Aufschreiben runden, im Rechner aber immer mit Komma
rechnen.
12. Wurzel aus 2 ist rund 1,05946.
Ergebnis ist die "wohltemperierte Stimmung" (bei der, und nur
bei der ist dann auch cis=des, dis=es, fis=ges, gis=as und ais=b).
Die Japaner und Amerikaner nennen unser h b, und unser b nennen sie
bb (muß man wissen, wenn man Zeug von da tippen will).
Auf Wunsch die Tabelle auch hier:

       Ton  c  cis  d  dis  e   f  fis  g  gis  a  ais  h
Oktave
  1        131 139 147 156 165 175 185 196 208 220 233 247
  2        262 277 294 311 330 349 370 392 415 440 466 494
  3        523 554 587 622 659 698 740 784 831 880 932 988
  4       1047 usw....
                                                o
Noten im Violinschlüssel:                  -o- ---
                                         o
   -----------------------------------o---------------------------------
                                   o             ganze      \    achtel
   -----------------------------o-------------------_--------\----------
                            o                     '-'  _   /     o_/
   -----------------------o----------------------------'-'--\-------|---
                       o                             halbe   \      /
   -----------------o---------------------------------------C-----------
                 o                                       viertel
   -----------o---------------------------------------------------------
           o                                        Pausen
   --- -o-
    o

    H   c  d  e  f  g  a  h  c' d' e' f' g' a'  h'

Bassschlüssel (mit 3 s):
    D1  E1 F1 G1 A1 H1 C  D  E  F  G  A  H  c   d

Ein # macht 1/2 Ton höher, wenn am Anfang der Noten, dann für das ganze
Stück, sonst nur für einen Takt.
Ein b macht 1/2 Ton tiefer (siehe #).                _|
Ein Auflösungszeichen gilt auch nur für einen Takt. |_|
                                                    |

Notenlängen: hohl                       = 1/1 Note, z.B. 0,5 s
             hohl mit Hals              = 1/2 Note, z.B. 0,25 s
             ausgemalt mit Hals         = 1/4 Note, z.B. 0,125 s
             ein Fähnchen oder 1 Balken = 1/8           usw.
             zwei "       "    2 "      = 1/16 usw.
Ein Punkt hinter der Note verlängert um die Hälfte auf 150%.

Die Pausen siehe oben. Auch für Pausen gilt die Punktierung.

Das Ganze sieht übrigens nicht nur mathematisch aus, es ist
es auch! Nur hat das vor Bach keiner gewußt...

mfg.
Ger - heute ist der Name mal Prgramm - not

--
<hifi@gmx.de> (Gernot Zander)
Irren ist menschlich, aber für das totale Chaos braucht man den Computer.
(MATZE@tmb.in-berlin.de)



    Subject: Re: Runtime error 200  (slow down CPU)
       Date: Mon, 08 Mar 1999 17:07:19 +0100
       From: Christian Palmes <CPalmes@warburg.netsurf.de>
 Newsgroups: de.comp.lang.pascal.misc
 

Tobias Kröber schrieb:
>
> > > Ich habe den wunderbaren Klassiker Oil Imperium ausgegraben (richtig schön
> > > mit EGA-Grafik)
> > > naja... bei 99% aller Starts bekomme ich einen Runtime-Error 200...
> > >
> > > Liegt das evtl. auch an einem Fehler in den durch die Programmierer
> > > benutzten Units??
> >
> > Wenn das Spiel seinerzeit auf TP7 programmiert wurde, dann liegt das an der
> > crt-Unit.
> > Lösungen, damit Dein schönes Spiel trotzdem läuft gibt es:
> > 1. Es gibt EXE-Patcher, die diese Datei patchen könnten
> > 2. Du nimmst ein Utility wie z.B. SlowDown
> >
> > Beides könnte ich Dir zur Not mailen.
>
> Oder du lädst dir´s selbst aus´m Netz runter:
>
>  http://geo.meg-glaser.at/tpzip/tp7crtpt.zip (EXE-Patcher &
> korrigierte Crt-Unit)

Probiers mal mit diesem kleinen Programm:

Gruß Christian

.286
code            segment          ;Nur 672 Bytes im Low-Memory-Block !
                org 100h
                assume cs:code

start:          jmp begin

new_int         proc far

                pushf
                sub ax,1234h   ;für uns..
                jnz weiter
                mov ax,0ffffh
                mov dx,ofs
                mov bx,segm
                push cs
                pop cx
                call dword ptr cs:[old1c]
                iret

weiter:         popf
                pusha
                mov bp,fak
ober:           mov cx,0ffffh
sleep:          loop sleep
                dec bp
                jnz ober
                popa
                pushf
                call dword ptr cs:[old1c]
                iret
old1c           label dword
ofs             dw 0000h
segm            dw 0000h
fak             dw ?
new_int         endp
 

begin:          mov ax,1234h
                int 1ch
                cmp ax,0ffffh
                jne m2

                pusha

                push cs
                pop ds
                lea dx,text2
                mov ah,09h
                int 21h

                mov ah,06h
                mov dl,0ffh
zeichen:        int 21h
                jz zeichen

                mov ah,02h
                mov dl,al
                int 21h

                cmp al,'j'
                je deinst
                cmp al,'J'
                je deinst

                add sp,2

                mov ax,4c00h
                int 21h

deinst:         popa

                mov ax,251ch     ;Interrupt zurücksetzen
                mov ds,bx
                int 21h

                mov es,cx                 ;segment
                mov ah,49h
                int 21h

                mov es,es:2ch             ;environement
                mov ah,49h
                int 21h

                mov ax,cs
                mov ds,ax
                mov ah,09h
                lea dx,text3
                int 21h

                mov ax,4c00h
                int 21h

m2:             push cs
                pop ds
                mov si,80h
                lodsw
                or al,al        ;Wenn nichts eingegeben ende   if no parameter: end
                jz ende
                sub al,2        ;Zahl zwischen 10-99 number between 10..99
                jz ende
                lodsw
                xchg al,ah
                cmp al,30h
                jb ende
                cmp ah,30h      ;Nur echte Zahlen  check for ciphers
                jb ende
                cmp al,39h
                ja ende
                cmp ah,39h
                ja ende
                sub ax,3030h
                xor dx,dx
                mov dl,ah
                imul dx,10
m1:             add al,dl
                mov ah,0
print:          mov fak,ax

                mov ax,351ch            ;Int 1c bestimmen  find int 1C vector
                int 21h
                mov ofs,bx
                mov segm,es

                mov ax,251ch            ;Neuen int setzen  set new intr vector
                mov dx,offset new_int
                int 21h

                mov ah,09h
                lea dx,lizens
                int 21h

                lea dx,begin
                shr dx,4               ;Resident bleiben  stay
                inc dx
                mov ax,3100h
                int 21h
ende:           mov ah,09h
                lea dx,text
                int 21h
                mov ax,4c01h
                int 21h
lizens          db 'Slow Installed..      -by C.Palmes- $'
text:           db 'Falsche Eingabe !, Aufruf:  slow [10..99]$'   ;illegal parameter
text2:          db 'Hey, schon installiert! Remove [n/j] : $'     ;already installed
text3:          db 10,13,'Removed.. $'
code            ends
                end start

PATCHES PAGE



    Subject: Re: BP7 Heap Manager patch?
       Date: 8 Mar 1999 21:34:59 +0200
      From: ronkanen@cc.helsinki.fi (Osmo Ronkanen)
 Organization: University of Helsinki
 Newsgroups: comp.lang.pascal.borland

In article <7bvbf0$vs5$1@nnrp1.dejanews.com>,  <netnews@altavista.net> wrote:
>
>BP7 protected mode.
>
>Appended below is a small code which illustrates the
>problem.  The Heap Manager runs out of pointers before
>all the memory is allocated. (I have 64Meg).
>OTOH, If you set mem=32*1024,
>it allocates all the memory (requires less pointers).

Could you please indent the code next time you post.

>var
>p: pointer;
>l: longint;
>
>const
>mem=1024;
>
>begin
>l:=0;
>repeat
>write(#13,l,' ',l*mem,' ',memavail,'  ');
>GetMem(p,mem); inc(l);
>until p=nil;
>
>end.

This has to do how the PM heap manager works. If the allocation is large
it allocates a new segment. However, if the allocation is small,
it allocates (if necessary) a large block and then suballocates
the request from that block. The threshold between the large and small
block is controlled by variable HeapLimit and the size of the large
block that is allocated by variable HeapBlock. Now the default for
HeapBlock is 8192 and the default value for HeapLimit is, surprise,
surprise, 1024.

So add the following lines at the beginning:

  heaplimit:=4096;
  heapblock:=32768+12;

The 12 comes from the observation that the first suballocation has
offset 12, so there will be no waste when the allocations are exactly
1024 bytes. If they are random length it does not matter.

Osmo



    Subject: Re: Allocating memory under protected mode (BP7)
       Date: Thu, 18 Mar 1999 03:19:44 -0500
      From: Scott Earnest <setech@_ix.netcom.com>
 Newsgroups: comp.lang.pascal.borland
 

Minoru Toda wrote:

> Scott Earnest wrote in message <36EE00C8.DFE7DF6B@_ix.netcom.com>...
> >On the contrary, *yes* you can.  DPMI allows you to allocate huge blocks,
> >using GlobalAlloc() or GlobalAllocPtr() in the WinAPI unit.  The chapter on
> >protected mode programming in the Language Guide has source which shows
> >exactly how to allocate and address the allocated memory by using
> >SelectorInc.  This satisfies the "pieced together" method requested.
>
> Thanks. Currently I have a unit which allocated memory in chunks of 64k each
> using GlobalAlloc, and then uses GlobalLock to obtain pointer to the memory,
> and then uses combination of seg(), ofs() and MEM[seg:oft] array to access
> the data. Is it possible, for example to allocate 128k block, and then
> obtain pointer to the 64k portion at the end? I'm asking this because I do
> not fully understand how the pointer and seg()/ofs() is related under
> protected mode. Thanks :)

Protected mode doesn't use segment/offset addressing.  While offsets are more
or less based on a similar principal, segment registers must contain selector
values, where a selector is a pointer to a table stored in memory, managed by
the protected mode system (generally, you'll probably never touch that table
directly).  You can't really rely on the segment/offset thinking any longer.

Suppose you perform an allocation such as:

  p := GlobalAllocPtr (gmem_Fixed,131072); {allocate 128KB}

Assuming p<>nil, you can use the function shown in the Language Guide to get a
second pointer to an absolute offset in that block:

function GetPtr (p : pointer; offset : longint) : pointer;

type
  long = record
    lo, hi : word;
  end;

begin
  GetPtr := ptr(long(p).hi+long(offset).hi*SelectorInc,
                long(p).lo+long(offset).lo);
end;

You can call this function whenever you want to get a valid address to some
area of the entire allocated block.

Does this help any further?

--
Scott Earnest            | SPAM protection in effect. Remove  |
setech@_ix.netcom.com    | "_" as needed for true addresses.  |
earnests@_homenet.lm.com |    UIN:1136443  EFnet:pale_blue    |
sinykal@_cyberspace.org  | URL: http://www.netcom.com/~setech |


    Subject: Re: Help with RT-200 fix
       Date: 27 Mar 1999 09:40:30 +0200
      From: ronkanen@cc.helsinki.fi (Osmo Ronkanen)
 Organization: University of Helsinki
 Newsgroups: comp.lang.pascal.borland

In article <36FC437F.39F9FFD9@nospam.com>, Mike  <somebody@nospam.com> wrote:
>I just bought a PII and applied Osmo's fix to CRT.ASM.  I assembled this
>and then compiled CRT.PAS.  I moved the TPU into TURBO.TPL and the fix
>works.  :-)  I also want to apply this fix for protected mode.  When I
>attempt to compile CRT.PAS in protected mode, I get an error message
>stating I'm missing file CRT.OBP.  How do I create this file?  Do I
>simply rename CRT.OBJ, or is there a TASM option to create this file?

What you should do is to use the make utility when you are in the BP\RTL
directory. That creates all needed files. That is you get the TPL files
directly into the BP\RTL\BIN directory.

Or you could use:

 tasm -e -d_DPMI_ -i..\inc crt,crt.obp

Osmo



    Subject: Re: Suche INT21-TSR  (.SYS driver!)
       Date: Sat, 27 Mar 1999 15:46:46 +0100
      From: Antivivisektion@t-online.de (Antivivisektion e.V.)
   Reply-To:Antivivisektion@tierversuchsgegner.org
 Organization: http://www.tierversuchsgegner.org
 Newsgroups: de.comp.lang.pascal.misc, fido.ger.pascal, z-netz.sprachen.pascal
 

"Ing. Franz Glaser" wrote:
>
> Andreas Killer wrote:
> >
> > Aber nun zum eigentlichen Anliegen: Da ich in der TSR-Programmierung nur
> > wenig Erfahrung habe und in der SYS-Driver-Programmierung (die Teile die
> > sich z.B. per "DEVICE=C:\L4DOS\LFN4DOS.SYS /E:8192" in der CONFIG.SYS
> > laden lassen) gar keine Erfahrung habe suche ich jemande(n) der mir
> > diese Arbeit abnimmt.
> >
> > Es sollte möglich sein dieses TSR/Treiber in der CONFIG.SYS (vor
> > COMMAND.COM) zu laden und dadurch eine INT21-Kernel-Erweiterung zu
> > installieren die die langen Dateinamen unter DOS ermöglicht.

Ich weiß nicht, ob das so geht, was Du vorhast...

> Vorsicht!
>
> Ein .SYS ist ganz was anderes als ein TSR. Einen .SYS kann man nicht
> mit TP programmieren. Er hat einen speziellen header und ganz andere
> innere Abläufe als ein TSR. Die .SYS sind jene, die mit DEVICE=
> installiert werden.

Geht doch, siehe unten. Das soll nicht heißen, daß ich soetwas empfehle...

> Ein .COM kann mit INSTALL= in CONFIG.SYS installiert werden,
> ein TSR (.COM oder .EXE) aber erst im Autoexec. Ein .COM kann normaler-
> weise mit beiden Methoden verwendet werden. Einen .EXE (also einen
> richtigen, der relocation etc. hat) habe ich noch nie mit INSTALL=
> zum Laufen gebracht. Es kann auch daran liegen, daß die ganze TP-
> Initialisierung Dinge voraussetzt, die erst mit MSDOS.SYS zur
> Verfügung stehen, noch nicht mit IO.SYS. Ich habe das nicht weiter
> erforscht.

Ein Pascal-EXE läßt sich m.W. problemlos mit INSTALL laden. Auch als TSR.

> Ich habe einen Treiber, allerdings nicht für MSDOS, sondern für ein
> anderes Betriebssystem, der ist als .EXE aufgebaut, installiert sich
> aber als .SYS wenn er mit DEVICE= im CONFIG aufgerufen wird. Das ist
> ein raffiniertes Ding, sowas könnte ich nicht schreiben.

Anbei »Creating a SYS file in PASCAL«
http://www.csd.net/~cgadd/knowbase/DOS0101.HTM

Herzliche Grüße,
Ihr und Euer A.E. Neumann
mailto:Neumann@tierversuchsgegner.org
http://www.tierversuchsgegner.org/ <-- Update 21.3.1999
--
  Wissenschaftliche und ethische Argumente gegen Tierversuche
  http://www.tierversuchsgegner.org/tierversuche/

Contributor: ARNE DE BRUIJN

{
 EH> I was wondering if there was some way that I could convert a Pascal
 EH> exe to some sys file that the computer loads/runs when booting.

You can use this, the only problem is that the units are not initialized (the
optional code before the last end. in a unit is not executed), and so system
(WriteLn/ReadLn) and crt (WriteLn/ReadLn) don't work.

===
{ DEVCLINE.PAS: Example of a device driver in TP, Arne de Bruijn, 19960302. }
{ Released to the Public Domain. }
{ This example shows the 'commandline' of the device driver }
{ (everything after DEVICE=), and removes itself from memory. }
type
 TReqHead=record                   { Structure passed to us by DOS }
  ReqLen:byte;
  SubUnit:byte;
  Cmd:byte;
  Status:word;
  Reserved:array[0..7] of byte;
  MediaDesc:byte;
  Address:pointer;
  case byte of
   0:(DevLine:pointer; DriveName:byte);
  255:
   (Count:word; Sector:word);
 end;

var
 DevStack:array[0..4094] of byte;  { Own stack, DOS's isn't that big }
 EndOfStack:byte;
 ReqHead:^TReqHead;

procedure DevStrat; far; forward;
procedure DevIntr; far; forward;

procedure Header; assembler;
{ The trick: put the device header as the very first procedure your source, }
{ so TP places it at the start of the .exe }
asm
 dd -1                 { Next device in chain (updated by MS-DOS) }
 dw 0                  { Device attribute, now block device }
 dw offset DevStrat    { Offset of strategy routine }
 dw offset DevIntr     { Offset of interrupt routine }
 db 0,0,0,0,0,0,0,0    { For block: 1 byte no of subunits, 7 bytes reserved }
end;

procedure DevStrat; assembler;
{ Strategy routine, save ES:BX for later use }
asm
 push ax
 push ds
 mov ax,seg @Data
 mov ds,ax
 mov word ptr [ReqHead],bx
 mov word ptr [ReqHead+2],es
 pop ds
 pop ax
end;

procedure WriteStr(S:string); assembler;
{ Units not initalized, can't use some System procs (WriteLn, etc.) }
asm
 cld
 mov bx,ds
 lds si,S
 lodsb
 mov cl,al
 xor ch,ch
 jcxz @NoStr
@PrtStr:
 lodsb
 mov ah,2
 mov dl,al
 int 21h
 loop @PrtStr
@NoStr:
 mov ds,bx
end;

procedure TPIntr;
{ Called by asm proc, ReqHead contains pointer to request header, }
{ Local stack in datasegment used (now 4k) }
type
 AByte=array[0..65534] of byte;
var
 S:string[50];
 I,IntNo:byte;
begin
 if ReqHead^.Cmd=0 then            { Initialization? }
  begin
   S[0]:=#50;                      { Max len of string }
   Move(ReqHead^.DevLine^,S[1],50);{ Copy from DOS buffer }
   I:=pos(#10,S);                  { Search for #10 }
   if I>0 then                     { Found? }
    begin
     byte(S[0]):=I-1;              { That's the len for now }
     I:=pos(#13,S);                { Also a #13? }
     if I>0 then byte(S[0]):=I-1;  { That must be the length }
    end;
   WriteStr('Cmdline:"'+S+'"'#13#10);  { Display 'command line' }
   { Remove device driver from memory }
   ReqHead^.MediaDesc:=0;          { Number of components }
   ReqHead^.Address:=ptr(cseg,0);  { First free address }
   ReqHead^.Status:=$100;          { Status OK }
  end
 else
  ReqHead^.Status:=$9003;          { Status unknown cmd }
end;

procedure DevIntr; assembler;
asm
 push ax
 push bx
 push cx
 push dx
 push si
 push di
 push ds
 push es
 mov ax,seg @Data
 mov ds,ax
 mov bx,ss
 mov cx,sp
 mov ss,ax                  { Set up local stack }
 mov sp,offset EndOfStack+1
 push bx
 push cx
 call TPIntr
 pop cx                     { Restore old stack pointer }
 pop bx
 mov ss,bx
 mov sp,cx
 pop es
 pop ds
 pop di
 pop si
 pop dx
 pop cx
 pop bx
 pop ax
end;

begin
 ReqHead:=@Header; {To include it in linking (smartlinker skips it otherwise)}
 { This is executed when run from the commandline }
 WriteStr('Must be loaded from CONFIG.SYS with DEVICE=DEVCLINE.EXE'#13#10);
end.



    Subject: Re: please help printing
       Date: Fri, 09 Apr 1999 15:28:23 GMT
      From: jweisgram@hotmail.com (Jim Weisgram)
 Newsgroups:comp.lang.pascal.borland

"Tamara Dumic" <Tamara.Dumic@public.srce.hr> wrote:

>Can someone please tell me how to print screen in 640x480x256 in Turbo
>Pascal 7.0? I've used svga256.bgi driver, and I'd like to print it on HP
>DeskJet printer.
>Please help me, I need this for my final paper (to be able to graduate).
>Thanks in advance,
>            Tamara

Here is a procedure I found years ago that will take from the screen and print
to an HP Laserjet

It also works on my old HP500C, and probably on other Deskjets as well:

Procedure HPHardCopy;
{ Produces hard copy of a graph on Hewlett-Packard Laserjet }
{ printer By Joseph J. Hansen 9-15-87                       }
{ Modified Extensively for compatibility with Version 4.0's }
{ Graph Unit By Gary Stoker                                 }
{                                                           }
{ Unlike Graphix Toolbox procedure HardCopy, this procedure }
{ has no parameters, though it could easily be rewritten to }
{ include  resolution in dots  per inch,  starting  column, }
{ inverse image, etc.                                       }
{                                                           }

Const DotsPerInch  = '100';
                    { 100 dots per inch  gives  full-screen }
                    { width of 7.2 inches for Hercules card }
                    { graphs, 6.4 inches for IBM color card }
                    { and 6.4  inches  for EGA card.  Other }
                    { allowable values are 75, 150, and 300.}
                    { 75  dots  per  inch  will  produce  a }
                    { larger full-screen graph which may be }
                    { too  large to  fit  on an  8 1/2 inch }
                    { page; 150 and 300  dots per inch will }
                    { produce smaller graphs                }

      CursorPosition = '5';
                    { Column position of left side of graph }
      Esc            = #27;
                    { Escape character                      }

Var LineHeader     : String[6];
                    { Line  Header used for each  line sent }
                    { to the LaserJet printer.              }
    LineLength     : String[2];
                    { Length  in  bytes of  the  line to be }
                    { sent to the LaserJet.                 }
    Y              : Integer;
                    { Temporary loop Varible.               }

Procedure DrawLine ( Y : Integer );
{ Draws a single line of dots.  No of Bytes sent to printer }
{ is Width + 1.  Argument of the procedure is the row no, Y }

Var GraphStr       : String[255]; { String  used for OutPut }
    Base           : Word;        { Starting   position  of }
                                  { output byte.            }
    BitNo,                        { Bit Number worked on    }
    ByteNo,                       { Byte number worked on   }
    DataByte       : Byte;        { Data Byte being built   }
    BColor         : word;

Begin
  BColor := 0;
  FillChar( GraphStr, SizeOf( GraphStr ), #0 );
  GraphStr := LineHeader;
  For ByteNo := 0 to Width  Do
  Begin
    DataByte := 0;
    Base := 8 * ByteNo;
    For BitNo := 0 to 7 Do
    Begin
      If (GetPixel( BitNo+Base, Y ) <> BColor)
         Then
           Begin
              DataByte := DataByte + 128 Shr BitNo;
           End;
    End;
    GraphStr := GraphStr + Chr (DataByte)
  End;

  Write (PrOut, GraphStr)

End; {Of Drawline}

Begin {Main procedure HPCopy}
  FillChar( LineLength, SizeOf( LineLength ), #0 );
  FillChar( LineHeader, SizeOf( LineHeader ), #0 );

  GetViewSettings( Vport );
  Width := ( Vport.X2 + 1 ) - Vport.X1;
  Width := ( ( Width - 7 ) Div 8 );
  Height := Vport.Y2 - Vport.Y1;

  Write (PrOut, Esc + 'E');                   { Reset Printer   }
  Write (PrOut, Esc+'*t'+DotsPerInch+'R');    { Set density in  }
                                              { dots per inch   }
  Write (PrOut, Esc+'&a'+CursorPosition+'C'); { Move cursor to }
                                              { starting col    }
  Write (PrOut, Esc + '*r1A');                { Begin raster graphics }

  Str (Width + 1, LineLength);
  LineHeader := Esc + '*b' + LineLength + 'W';
 

  For Y := 0 To Height + 1 Do
  Begin
    DrawLine ( Y );
    {DrawLine ( Y );}
  End;

  Write (PrOut, Esc + '*rB');           { End Raster graphics }
  Write (PrOut, Esc + 'E');             { Reset  printer  and }
                                        { eject page          }
End;
 

--
Jim Weisgram
Oregon Department of Transportation
email: jweisgram@hotmail.com
All opinions expressed are mine and not my employers (but they ought to be)


tpqa index tpqa_9 back  tpqa_11 forward tp_index faq_page
Get your own FREE HOMEPAGE