3  Interesting QA from various newsgroups
unsorted, uncommented, simply copied from NG - mails (without written permission of the authors)

last updated: Jul-05-1998   Index 1QA

   Subject:    Re: Seriennummer eines Laufwerks
      Date:    Fri, 03 Apr 1998 21:32:55 GMT
      From:    Willi.Marquart@regio.net (Willi Marquart)
 Organization: regio.net GmbH
 Newsgroups:   de.comp.lang.pascal.misc

ScholzB@t-online.de (Bastian Scholz) wrote:
>kennt jemand eine Möglichkeit
>die Seriennummer einer Diskette
Nicht nur lesen, sondern auch schreiben:


               infolevel:      word;
               SrNo:           longint;
               VolumeLabel:    Array[1..11] of char;
               Filesystemtype: Array[1..8] of char;

var  info:t_info;

Procedure setser(DriveNr:byte);Assembler;
    mov bl,drivenr
    lea dx,info
    mov bl,0
    mov ax,$6901
    int $21
Procedure getser(DriveNr:byte);Assembler;
    mov bl,drivenr
    lea dx,info
    mov bl,0
    mov ax,$6900
    int $21


Gruss Willi

   Subject:   Link: USING LONG FILENAMES
      Date:   7 Apr 1998 08:34:42 GMT
      From:   Antivivisektion@t-online.de (Antivivisektion e.V.)
 Newsgroups:  de.comp.lang.pascal.misc, comp.lang.pascal.borland

Das dürfte genau das sein, wonach Du suchst:

DOS70 version 1.3 - January 1998 ¦
DOS70 is a powerful, easy-to-use
Turbo Pascal unit, implementing
MS-DOS 7.x extensions and file

 - over 40 long filenames functions
      and procedures
 - over 10 functions and procedures
      implementing virtual machine
 - over 10 general MS-DOS functions
      and procedures
 - a complete, comprehensive manual
 - full source included.
 - works with Turbo/Borland Pascal
   6/7.0 for Dos/Windows.

Internet:  http://www.lego.soroscj.ro/~cristis
             (I'm working on it... I'm also creating my school's
              homepage - try http://www.lego.soroscj.ro/ )
E-Mail:    cristis@lego.soroscj.ro (or root@lego.soroscj.ro)
Address:   Cristi Streng
           str. Gen. Magheru nr. 11A ap.5
           3700 Oradea
Phone:     +40-59-417477

download DOS70P13.ZIP (111 kB) at
it's really great!

   Subject:   Re: PCX / BMP - Files with BP7
      Date:   Tue, 07 Apr 1998 11:43:23 +0200
      From:   Anders Grimsmo <agrimsm@online.no>
 Organization:SOL Internett
 Newsgroups:  comp.lang.pascal.borland

Christian Hochwarth wrote:
> Hallo!
> Kann somebody out there give my a hint, how to show PCX/BMP-Pictures with
> BP7?
> eMail: Chris.Hochwarth@T-Online.de
> Christian Hochwarth
> PS: You can write your answer in German.

Here is a procedure in Pascal and ASM, which loads a 64000 byte image, I
hope it helps

procedure loadpcx(fil:string;where:word);
{the name of the file, and where to write it (f.eks. 0a000h(VGA
                temp:pointer; {used to read out of file}
                f:file; {file name variable}
                minpal:array[0..255,1..3]of byte; {our pallette}
        assign(f,fil); {give the string name of the file to the file vairable
        reset(f,1); {open the file}
        seek(f,128); {seek 128 bits into the file, where the image itself
begins, first 128 bits contain  various info}
0  Manufacturer     10 = ZSoft .PCX file
1  Version
2  Encoding
3  Bits Per Pixel
4  XMin, Ymin, XMax, YMax  (2 bytes each)
12 Horizontal Resolution (2 bytes)
14 Verticle Resolution (2 bytes)
16 Color pallette setting (48 bytes)
64 Reserved
65 Number of color planes
66 Bytes per line (2 bytes)
68 1 = Color    2 = Grayscale  (2 bytes)
70 Blank (58 bytes)
        getmem(temp,filesize(f)-768-128);{get the memory for our
temporary variable, into which we read the      image first. We get the size
of the file - first 128 bits - 768 (pallette)}
        blockread(f,temp^,filesize(f)-768-128); {read form file f into
where temp points to so and so many     bytes.}
                push    ds {don't want to destroy the data segment for pascal, so e store it}
                lds     si,temp {ds= segment temp points to, si= the offset
                mov     ax,where {where to put the image}
                mov     es,ax {into segment variable es}
                xor     di,di {di=0, es:[di] points to beginning of segment}
                xor     ch,ch {don't want upper byte}
                lodsb   {al=ds:[si], inc si
                mov     bl,al
                and     bl,00c0h {and bl 1100 0000, bl=xx00 000}
                cmp     bl,00c0h {check if top bits is set, if bl=1100 0000 or 0000 0000}
                jne     @enpix {if not equal, jump}

                mov     cl,al {if top to bits are set, the six bottom bits are a
loop counter, which contains the number of times the nest byte is
                and     cl,003fh {and cl 0011 1111, cl= 00xx xxxx}
                lodsb {al=next byte}
                rep     stosb {mov es:[di],al ; inc di, cl times}
                jmp     @nok_naa
                cmp     di,63999
                jbe     @loopen
                pop ds
        setpal(minpal); {load pallette}

{modify the use of di to use other output sizes, read the values you
need from the first 128 bytes}

procedure setpal(var pally:array[0..255,1..3]of byte);
        for l1:=0 to 255 do

procedure pal(col,r,g,b:byte);assembler;
        mov     dx,3c8h
        mov     al,[col]
        out     dx,ax
        inc     dx
        mov     al,[r]
        out     dx,al
        mov     al,[g]
        out     dx,al
        mov     al,[b]
        out     dx,al

Nils Grimsmo

   Subject:   DBFSERV: pascal unit for easy xbase-access
      Date:   Fri, 10 Apr 1998 17:45:12 +0200
      From:   Antivivisektion@t-online.de (Antivivisektion e.V.)

Dear Remco de Korte (mailto:remcodek@xs4all.nl),
dear Roger E. Donais (mailto:rdonais@southeast.net),
dear Scott Earnest (mailto:setech@ix.netcom.com),
dear Ing. Franz Glaser (mailto:office@meg-glaser.biz),
dear Frank Heckenbach (mailto:heckenb@mi.uni-erlangen.de),
dear Constantine Knizhnik (mailto:konstantin.knizhnik@digital.com),
dear Horst Kraemer (mailto:horst.kraemer@berlin.snafu.de),
dear Dr. Abimbola Adeleke Olowofoyeku (mailto:laa12@cc.keele.ac.uk),
dear Frank Peelo (mailto:fpeelo@portablesolutions.com),
dear Osmo Ronkanen (mailto:ronkanen@cc.helsinki.fi),
dear Timo Salmi (mailto:ts@majakka.uwasa.fi),
dear Leonid Schavelev (mailto:leonid@polytech.ivanovo.su),
dear Pedt Scragg (mailto:newsmaster@pedt.demon.co.uk),
dear Dr John Stockton (mailto:jrs@merlyn.demon.co.uk),
dear Cristi Streng (mailto:cristis@lego.soroscj.ro),
dear Arsène von Wyss (mailto:avonwyss@gmx.net),

you don't know me and I don't know you
- the only connection between us is the TCP/IP.

But: I noticed you as pascal-freaks on the usenet.
Nice to meet you! =:-)

Now, yesterday I wrote an x-base-engine for fast and easy dbf-access.
It's called DBFSERV and has a totaly new approach!

  then a unit DBFNAME is being created and
  now you can access all fields by their name.



  Var Sum: Number;
  Begin {$IFDEF FIRST} CreateUnit('d:\','FAKT'); {$ENDIF}
    Sum := 0;
    For RECPTR := 1 To RECNO Do
      Sum := Sum + FIELD;

It's fast! It processes e.g. a 85 MB dbf-file in 40 s (on P160).

Would you please send me some tips, comments or suggestions on that?

I don't want to bother you with the source and documentation
via e-mail, so please take a look at it (http-download):

  [Complete zip'ed-archive]
  http://home.t-online.de/home/Antivivisektion/dbfserv.zip (7024 byte)


  [DBFSERV pascal source code]
  http://home.t-online.de/home/Antivivisektion/dbfserv.pas (9956 byte)

  [DBFSERV documentation]
  http://home.t-online.de/home/Antivivisektion/dbfserv.doc (6454 byte)

  [pascal source code of sample application]
  http://home.t-online.de/home/Antivivisektion/testserv.pas (639 byte)

  [sample DBF-file]
  http://home.t-online.de/home/Antivivisektion/testdata.dbf (272 byte)

  [pascal source code, created by DBFSERV from sample DBF-file]
  http://home.t-online.de/home/Antivivisektion/testdata.pas (1079 byte)

Greetings from Germany near Cologne,
Yours Oliver

http://Antivivisektion.base.org (no PASCAL, no ENGLISH at all - sorry!)

NOTE: this is already on the TP-links page: link

   Subject:  Re: Int 13h in DPMI ???    (BIOS disk access)
      Date:  Sun, 12 Apr 1998 05:10:45 -0400
      From:  Scott Earnest <setech@_ix.netcom.com>
        To:  gruberr@kapsch.net
 Newsgroups: comp.lang.pascal.borland

Roman Gruber wrote:

> Hi! I'm looking for a reliable way to use INT 13h in the BP 7.0
> DPMI-environment. Right now, I'm using the registers-type to do a call
> via
>         INTR($13,REGS)
> It seems to work on some systems, but crashes others. Obviously there
> is something wrong with the buffer-pointer when calling the RM handler
> from DPMI. Some DPMI-hosts will work, others won't.

It depends on whether the active DPMI server supports the interrupt

> [...]
> I'd also like to know, if there is a way of accessing the
> disk/harddisk in a Windows 95/98/NT DOS-box through INT 13.

There's an interrupt call for locking a drive.  But this can interfere with
the Win95 system, and you have to make sure you unlock it.  I wrote up a
little DOS application to duplicate a hard drive with a particular geometry
onto another hard drive with the identical geometry.  It ran okay without
error, but one drive might not be the same as the other due to the way Win95
may write just about any time.  And considering this, it's strongly advised
that you don't use int 13h under multitasking (quasitasking?) systems anyway.

> This might be a RTFM, in which case I'd like to know which FM.

The FM in this case would be the DPMI specification.  Though Ralf Brown's
Interrup List would be a a good reference too.  If you want code to be totally
reliable, use int 31h, ax=0300h.  But keep in mind that since the context is
real mode, you need to allocate memory below 1MB using globaldosalloc()
(WinAPI unit) and use the real mode segment as a reference in the interrupt

> So, I don't need (although it would be nice :) ready-to-go code, I
> REALY need a brief explanation which function calls to use...

I had written (modified) some code that does this for someone (for making
FOSSIL code work in DPMI), but it's sloppy and probably not terribly helpful.

> TIA, Roman
>         gruberr@kapsch.net
> P.S.: Please E-Mail me too, since I don't read newsgroups on a regular
> basis. Thanks again.

Well, I usually follow a "post here, expect replies here" policy, but I think
now and then lately some ISP's have been mass cancelling Netcom posts (odd,
there are probably far worse ISPs out there notorious for spamming), and I may
as well mail since it's got a bit better chance of surviving in e-mail.  Makes
me hope that I haven't typed all this out for nought.  :-)

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: DFM file format  (a Delphi question)
      Date:  Sun, 26 Apr 1998 15:47:24 GMT
      From:  yaminov@trendline.co.il (Yorai Aminov)
 Newsgroups: borland.public.delphi.graphics

On Sun, 26 Apr 1998 14:14:25 GMT, p.pisani@iol.it (Paolo) wrote:

>I'm looking for informations about the DFM file format, possibly in

Ray Lischner's "Secrets of Delphi 2" (Waite Group Press, 1996), has a
chapter on the binary structure of DFM files. You could easily get the
text version of a DFM by using ObjectResourceToText. The result could
be a lot easier to handle.

Yorai Aminov
El-On Software Systems, Ltd.
[No e-mail, please]

   Subject:    Re: .cda / .wav /.mp3
      Date:    Sun, 03 May 1998 17:44:01 GMT
      From:    tomten@mindless.com (Per Bolmstedt)
 Organization: koolex.net/tomten
 Newsgroups:   comp.lang.pascal.borland

bello-buero@t-online.de (Sahin Tepe) wrote:

>> Does anybody knows how to read a .wav file, a .mp3 file or a .cda file
>> (especially the header)
> For MP3 see following page: (its in german but you might read it well)
> [url snipped]

     Using the information on your page, run thru babelfish since my
German isn't all that good, here's a quick example without error

    mpegVersions: array[0..3] of byte = (25, 0, 2, 1);
    mpeg1BitRates: array[1..13] of word = (0, 0, 0, 56, 64,
        0, 96, 112, 128, 0, 192, 0, 256);
    mpeg2BitRates: array[1..8] of word = (0, 16, 24, 32, 0,
        0, 56, 64);
    mpeg25BitRates: array[1..2] of word = (8, 16);
    mpeg1SampleRates: array[0..2] of word = (44100, 48000, 32000);
    mpeg2SampleRates: array[0..2] of word = (22050, 24000, 16000);
    mpeg25SampleRates: array[0..2] of word = (11025, 0, 8000);

    bit(b: byte; n: byte):byte;
    var i, j: byte;
    n := 9 - n;
    j := 1;
    for i := 1 to n-1 do j := j * 2;
    if (b and j) > 0 then bit := 1 else bit := 0;
    end; {returns 1 if bit #n (from left) in byte b is set}

    f: file;
    h1, h2, h3, h4: byte;
    mpegVersion: byte; {mpeg version -- 1, 2 or 2.5}
    mpegLayer: byte; {mpeg audio layer -- 1, 2, 3 or 4}
    mpegUsesCRC: boolean; {mpeg uses crc -- yes or no}
    mpegBitRateIndex: byte;
    mpegBitRate: word;
    mpegSampleRateIndex: byte;
    mpegSampleRate: word;
    mpegPadding: boolean;
    mpegExtension: boolean;
    mpegChannelModeIndex: byte;
    mpegChannels: byte;
    mpegHasCopyright: boolean;
    mpegIsOriginal: boolean;

    if paramstr(1) = '' then halt;
    assign(f, paramstr(1));
    reset(f, 1); {open file}
    blockread(f, h1, 1); {read the four MP3 header bytes}
    blockread(f, h2, 1);
    blockread(f, h3, 1);
    blockread(f, h4, 1);
    mpegVersion := mpegVersions[2 * bit(h2, 4) + bit(h2, 5)];
    mpegLayer := 4 - (2 * bit(h2, 6) + bit(h2, 7));
    mpegUsesCRC := (bit(h2, 8) = 0);
    mpegBitRateIndex := 8 * bit(h3, 1) + 4 * bit(h3, 2) +
        2 * bit(h3, 3) + bit(h3, 4);
    case mpegVersion of
        1:  mpegBitRate := mpeg1BitRates[mpegBitRateIndex];
        2:  mpegBitRate := mpeg2BitRates[mpegBitRateIndex];
        25: mpegBitRate := mpeg25BitRates[mpegBitRateIndex];
    mpegSampleRateIndex := 2 * bit(h3, 5) + bit(h3, 6);
    case mpegVersion of
        1:  mpegSampleRate := mpeg1SampleRates[mpegSampleRateIndex];
        2:  mpegSampleRate := mpeg2SampleRates[mpegSampleRateIndex];
        25: mpegSampleRate := mpeg25SampleRates[mpegSampleRateIndex];
    mpegPadding := (bit(h3, 7) > 0);
    mpegExtension := (bit(h3, 8) > 0);
    mpegChannelModeIndex := 8 * bit(h4, 1) + 4 * bit(h4, 2) +
        2 * bit(h4, 3) + bit(h4, 4);
    case mpegChannelModeIndex of
        4: mpegChannels := 2;
        5: mpegChannels := 2;
        else mpegChannels := 1;
    mpegHasCopyright := (bit(h4, 5) > 0);
    mpegIsOriginal := (bit(h4, 6) > 0);
UL-Tomten (ircnet, #C-64) | icq 3167836

   Subject:   Openfile dialog in 32 bit with Call32NT solved
      Date:   4 May 1998 03:28:36 GMT
      From:   ldeboer@ibm.net
 Newsgroups:  comp.lang.pascal.borland   ???

Thanks to all of you who helped with this one here is the solution
for those of you who are interested.

There were two problems first the address's I was passing were
16 bit not 32 bits as required and I had to use GetVDMPointer32W
to change these and the record TOpenFileName is different under
the 32 bit system.

[Snip here is the code]

USES Strings, WinTypes, WinProcs, CommDlg, Call32NT;

   OFN_LONGNAMES = $00200000;

  W32TOpenFileName = packed record
    lStructSize:        LongInt;
    hwndOwner:          LongInt;
    hInstance:          LongInt;
    lpstrFilter:        PChar;
    lpstrCustomFilter:  PChar;
    nMaxCustFilter:     LongInt;
    nFilterIndex:       LongInt;
    lpstrFile:          PChar;
    nMaxFile:           LongInt;
    lpstrFileTitle:     PChar;
    nMaxFileTitle:      LongInt;
    lpstrInitialDir:    PChar;
    lpstrTitle:         PChar;
    Flags:              LongInt;
    nFileOffset:        Word;
    nFileExtension:     Word;
    lpstrDefExt:        PChar;
    lCustData:          LongInt;
    lpfnHook:           function(Wnd: LongInt; Msg: LongInt; WP: LongInt; LP: LongInt):
    lpTemplateName:     PChar;

   W32GetOpenFileName: Function (Var OpenFN: W32TOpenFileName; Id: LongInt): LongBool;

VAR CallRes: Boolean; id_W32GetOpenFileName: LongInt;
    FileName, DefExt, S, Ts: String;
    W32OpenFN: W32TOpenFileName; Filter: Array [0..100] Of Char;
  FillChar(Filter, SizeOf(Filter), #0);
  StrCopy(Filter, 'All files');
  StrCopy(@Filter[StrLen(Filter)+1], '*.*');
  DefExt := 'JOB'+#0;

   If (GetWinFlags AND $6000 <> 0) Then Begin         { Win NT/95 check }
     @W32GetOpenFileName := @Call32;                  { Init 32 bit call }
     id_W32GetOpenFileName := Declare32(
       'GetOpenFileNameA', 'comdlg32', 'p');          { Create reference }
     If NOT Call32NTError Then Begin                  { Check 32 bit error }
       FillChar(W32OpenFN, SizeOf(W32OpenFN), #0);
       With W32OpenFN Do Begin
         hInstance := 0;
         hwndOwner := 0;
         lpstrDefExt := Pointer(GetVDMPointer32W(
           @DefExt[1], SizeOf(DefExt)-1));
         lpstrFilter := Pointer(GetVDMPointer32W(
           @Filter, SizeOf(Filter)));
         lpstrFileTitle := Pointer(GetVDMPointer32W(
           @FileName[1], SizeOf(FileName)-1));
         flags := ofn_FileMustExist OR ofn_LongNames
           OR ofn_HideReadOnly;
         lStructSize := SizeOf(W32OpenFN);
         nFilterIndex := 1;
         nMaxFile := 255;
         lpstrTitle := Pointer(GetVDMPointer32W(
           @Ts[1], SizeOf(Ts)-1));
       CallRes := W32GetOpenFileName(W32OpenFN,


   Subject:  Re: Trapping wm_KeyDown Messages in Windows
      Date:  Mon, 04 May 1998 21:40:05 -0700
      From:  SoftStuf <softstuf@softstuf.com>
 Newsgroups: borland.public.turbopascal

techfacN wrote:
> Hello!
> I am Laine Berhane. Can any body help me in trapping keyboard messages
> in windows 3.1 or later versions before other active applications trap
> the message using Borland Pascal 7.0.
> Thank you all of you who are in the land of knowledge.
> L.B.


It is very easy to do. Ever TWindow object has a wmkeydown method.
In the twindow type add the method:

  procedure wmkeydown(var msg:tmessage); virtual wm_first+wm_keydown;

In the actual wmkeydown procedure use the following to trap keys pressed

procedure testwin.wmkeydown(var msg:tmessage);
  case msg.wparam of
    vk_shift:Shift key action;
    vk_control:Control key action;
    vk_end:End key action;
    vk_home:Home key action;
    vk_next:Page Down;
    vk_prior:Page Up;
    vk_space:Space Bar;

You can also do the same for Wmkeyup.


   Subject:   Re: VESA BankSwitching under DPMI
      Date:   6 May 1998 02:43:49 GMT
      From:   monsters@nmia.com (Mark Iuzzolino)
 Newsgroups:  comp.lang.pascal.borland

In article <354D2DAA.F02C412B@_ix.netcom.com>,
Scott Earnest  <setech@_ix.netcom.com> wrote:
>Christopher Skanda wrote:
>> Hi !
>> I had tried to program some VESA BankSwitching with the function $4F05 on
>> interrupt $10. Now it was me to slow and I coded it with the far call, whose
>> address I got from the function $4F01.
>> And it works. But under DPMI there is always a General protection fault. Of
>> course I got a Selector for the Segment.
>> Can anybody help me ?
>Yes, I recently posted to borland.public.turbopascal a full program which
>demonstrates how to do this.  To summarize, you can't call the interrupt
>directly, you have to call via the DPMI server (int 31h), and also allocate
>memory below 1MB.

Er, this isn't true.  You can set up a code segment at the
address of the direct bankswitching call.  The code goes something

uses winapi;
type dword=record LoWord, HiWord:word end;
var VesaSelector,CodeSelector:word;
{obviously ModeRec is the mode information returned by $4f01}

Switchbank is now the direct bankswitching call.  Note that this
doesn't work under SciTech's Display Doctor drivers because
they actually write the bank value to the code segment which
is a no-no in protected mode.  I have code that checks to see if their
driver is installed but isn't very useful to print here since it will
be out of context.  Email me if you want it.

>> Christopher.Skanda@gmx.net
>Scott Earnest

--Mark Iuzzolino
one of the monsters@monstersoft.com  |  "Who do you want to kill today?"

   Subject: Re: VESA BankSwitching under DPMI
      Date: Thu, 07 May 1998 01:19:16 -0400
      From: Scott Earnest <setech@_ix.netcom.com>
Newsgroups: comp.lang.pascal.borland

Mark Iuzzolino wrote:

> In article <354D2DAA.F02C412B@_ix.netcom.com>,
> Scott Earnest  <setech@_ix.netcom.com> wrote:
> >Christopher Skanda wrote:
> >
> >> Hi !
> >> [...]
> >> interrupt $10. Now it was me to slow and I coded it with the far call, whose
> >> address I got from the function $4F01.
> >Yes, I recently posted to borland.public.turbopascal a full program which
> >demonstrates how to do this.  To summarize, you can't call the interrupt
> >directly, you have to call via the DPMI server (int 31h), and also allocate
> >memory below 1MB.
> Er, this isn't true.  You can set up a code segment at the
> address of the direct bankswitching call.  The code goes something
> like:

As it turns out, I misread the question, and my code doesn't do quite what was
requested, namely using the far call for bank switching.

> uses winapi;
> type dword=record LoWord, HiWord:word end;
> var VesaSelector,CodeSelector:word;
>     SwitchBank:procedure;
> ...
> CodeSelector:=0;
> VesaSelector:=0;
> {obviously ModeRec is the mode information returned by $4f01}
> SetSelectorBase(VESASelector,longint(dword(ModeRec^.BankSwitch).HiWord)*16);
> SetSelectorLimit(VESASelector,65535);
> CodeSelector:=AllocDStoCSAlias(VesaSelector);
> @SwitchBank:=ptr(CodeSelector,Dword(ModeRec^.BankSwitch).LoWord);

True, but I'm left wondering something here.  What about context?  If the
processor is running in protected mode and suddenly jumps to BIOS code with
real mode context, wouldn't it GPF?  All BIOSes aren't smart enough to know
this, are they?  Is switching to real mode and back to protected mode needed?
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: Printing from DIBs  (Delphi)
      Date:   Wed, 6 May 1998 09:49:28 -0500
      From:   "Earl F. Glynn" <EarlGlynn@WorldNet.att.net>
 Organization:AT&T WorldNet Services
 Newsgroups:  borland.public.delphi.graphics


Michele Bersini wrote in message ...
>I need to print an image with StretchDIBits, but I have only a pointer to
>the DIB structure.
>How can I separate Bits from ImageInfo for passing them to the API ?

If I understand your question, you need to use GetDIB.

The following recommended way to print a TBitmap involves creating a DIB
and using StretchDIBits.  Does this help?

  // Based on posting to borland.public.delphi.winapi by Rodney E Geraghty,
  // Used to print bitmap on any Windows printer.}
  PROCEDURE PrintBitmap(Canvas:  TCanvas; DestRect:  TRect;  Bitmap:
      BitmapHeader:  pBitmapInfo;
      BitmapImage :  POINTER;
      HeaderSize  :  INTEGER;
      ImageSize   :  INTEGER;
    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
    GetMem(BitmapHeader, HeaderSize);
    GetMem(BitmapImage,  ImageSize);
      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
                    DestRect.Left, DestRect.Top,     {Destination Origin}
                    DestRect.Right  - DestRect.Left, {Destination Width}
                    DestRect.Bottom - DestRect.Top,  {Destination Height}
                    0, 0,                            {Source Origin}
                    Bitmap.Width, Bitmap.Height,     {Source Width & Height}
  END {PrintBitmap};

efg's Computer Lab:  http://infomaster.net/external/efg
Earl F. Glynn                 E-Mail:  EarlGlynn@att.net
MedTech Research Corporation, Lenexa, KS  USA

   Subject: Re: Printing from DIBs
      Date: Wed, 06 May 1998 13:30:14 -0500
      From: Wayne Herbert <wherbert@keymaps.com>
Newsgroups: borland.public.delphi.graphics

Earl F. Glynn wrote:

> If I understand your question, you need to use GetDIB.
> <SNIP>

Actually, Earl... this goes back to one thing I wish D4 would fix/enhance.  When
you load a bitmap as in Bmp.LoadFromFile, it is already in DIB format
(HandleType := bmDIB).  The problem is that even though it is a DIB, the
pointers to the header and image are not available.

While your routine works, and as of now is the only way I have seen to
sucessfully use a StretchDIBits, I think it has two shortcomings.  First, you
have the computational and memory expense of creating at least one and maybe two
new bitmaps (if I read the graphics.pas code right), an unnecessary task since
the LoadFromFile was aDIB in the first place.

Second, since the GetDIB Delphi  functionl requires a handle to a DDB and a
palette, the possibility exists that even if you were to load a 24 bit true
color bitmap, you could end up creaming it if your DDB handles refer to a DC
that is 256 colors.

Would you agree with this assessment?  Would it not be easier to do a
StretchDIBits directltly from the original LoadFromFile bitmap?

Caveat... this is for D3... I've no idea how D1 and D2 handle bitmaps.
Wayne Herbert
Manager, Computer Products
Key Maps, Inc.
1411 West Alabama Houston, TX  77006

Vox:  713.522.7949 Fax:  713.521.3202  Email:  wherbert@rice.edu

   Subject:   Re: Finding CD-ROM
      Date:   7 May 1998 11:06:12 +0300
      From:   ronkanen@cc.helsinki.fi (Osmo Ronkanen)
 Organization:University of Helsinki
 Newsgroups:  comp.lang.pascal.borland

In article <6ioh62$ruv$1@camel21.mindspring.com>,
Michael J. Gregg <mjgregg@mindspring.com> wrote:
>This is a multi-part message in MIME format.
>Content-Type: text/plain;
>       charset="iso-8859-1"
>Content-Transfer-Encoding: 7bit
>Does anyone know how to find the CD-Rom drive letter in Turbo Pascal 5.5?

Function CDRoms:String;
var rg:registers;
  if swap(dosversion)<5 then exit;
  if rg.bx=0 then exit;
  for i:=1 to rg.bx do cdr:=cdr+chr(rg.cx+i+64);


   Subject:  Re: BPW and Win NT 4
      Date:  Sat, 09 May 1998 04:45:15 +0100
      From:  Eric <ntuser@teleport.com>
        To:  Håkan Möller <hakan.moller@swipnet.se>
 Newsgroups: borland.public.turbopascal

Håkan Möller wrote:
> Is there any way to make BPW (and the debugger) to work under Windows NT 4
> for Workstations, without problems. As it is now, I can't run the debugger.
> And BPW frequently hangs. Does Borland have a patch/update or any general
> advice?
> Please send answers both by e-mail and to this NG. My ISP:s news-server
> doesn't behave well at all.
> Sincerely, Håkan Möller
TPW 1.5 works fine in NT 4.0, however, it performs a bit better when you
run it in it's own memoery space.  Start/Run/.../tpw.exe.  In the Run
Dialog Box, click the "Run in Seperate Memory Space" box.  This allows
it to have it's own memory to work in.  To run all your Win16
applications in seperate memoery spaces all the time, you can edit the
Registry so that your system defaults to using a seperate memory space
for each Win16 application. To enable this behavior, use a Registry
editor to set the Default-SeperateNDM value to yes in
HKEY_LOCAL_MACHINE   \SYSTEM\Current\ControlSet\Control\WOW.  Now, once
you end the application, the memory space is still allocated to the
NTVDM, weather or not you allocate memory to it automatically at start
up or not.  To free the memory, just open up the Task Manager and click
on the Processees Tab and then click on the NTVDM Process.  Tehn, click
"End Process" and a little Warning will pop up, just ignore the warning
and end the process.  That simple.  Let me know if you have any


   Subject:  Re: (disk) SERIAL NUMBER
      Date:  Sat, 9 May 1998 15:49:57 +0100
      From:  Pedt Scragg <newsmaster@pedt.demon.co.uk>
 Newsgroups: comp.lang.pascal.misc

In article <x@news.online.de>, Arnaud & Danièle Fietzke
<da.fietzke@online.de> writes
>Can anybody tell me how to get the serial number and name of a disk in a
>Pascal-program without calling COMMAND.COM VOL?
Assuming DOS V4 and above you can do it with:

type VSNstructure = record
                          InfoLevel : word;
                          SerNoLo   : word;
                          SerNoHi   : word;
                          VolLabel  : array[1..11] of char;
                          FileSys   : array[1..8] of char;

Var VSNs : VSNstructure;

Function Hex(Arg:byte): string;
  HexDigit: array[0..15] of char = '0123456789ABCDEF';
  Hex := HexDigit[Arg shr  4]+ HexDigit[Arg and 15];

Function  GetVSN(Drive:char;var VSNstr : string) : boolean;
var regs : registers;
   GetVSN := false;
   VSNstr := '';

   VSNs.infolevel := 0;
   with regs do
      bx := ord(upcase(drive))-64;
      if BX < 0 then exit;

      ax := $440D;
      ch := 8;
      cl := $66;
      dx := ofs(vsns.infolevel);
      ds := seg(vsns.infolevel);


      if (flags and 1) = 1 then exit;

      GetVSN := true;
      VSNstr := Hex(hi(vsns.sernohi))+Hex(lo(vsns.sernohi))+'-'+
Pedt Scragg                    <newsmaster@pedt.demon.co.uk>
Never curse the Crocodile's mother before crossing the river

Date: Sat, 9 May 1998 17:24:22 +0200
From: "Christian Klukas" <klukas@sunpool.cs.uni-magdeburg.de>
Organization: Boerde.DE Magdeburg
Newsgroups: comp.lang.pascal.borland

Arnaud & Danièle Fietzke schrieb in Nachricht
>Hi everybody!
>Can anybody tell me how to get the serial number and name of a disk in a
>Pascal-program without calling COMMAND.COM VOL?
Hello Arnaud!

Try this:
(From the German book "Borland Pascal 7.0 - Das Buch")

FUNCTION GetLabel(Drive: BYTE): STRING; (* Label des Laufwerks lesen *)
  sr         : SearchRec;
  SearchDrive: PathStr;
  DriveLabel : STRING[12];
  IF Drive = 0 THEN GetDir(0, SearchDrive)
               ELSE SearchDrive := Chr(Drive + 64);
  SearchDrive := SearchDrive[1];
  FindFirst(SearchDrive + ':\*.*', VolumeID, sr);
  IF DosError = 0 THEN          (* bei DosError 18 --> nicht gesetzt *)
    DriveLabel := sr.Name;                    (* aus SearchRec holen *)
    IF Pos('.', DriveLabel) > 0 THEN
      Delete(DriveLabel, Pos('.', DriveLabel), 1);  (* Punkt l”schen *)
    DriveLabel := '';                               (* nicht gesetzt *)
  GetLabel := DriveLabel;

FUNCTION SetLabel(Drive: BYTE; DriveLabel: STRING): INTEGER;
(* Setzen des Volume-Labels über die DOS FCB-Funktionen. Es werden   *)
(* die DOS-Konventionen berücksichtigt, also nur erlaubte Zeichen    *)
(* geschrieben. Für Drive: 0 = aktuell, 1 = A:, 2 = B:, 3 = C ...    *)
  FCB     : ARRAY[0..45] OF BYTE;  (* File-Control-Block vereinfacht *)
  Regs    : Registers;
  OldLabel: STRING[11];             (* ursprüngliches Diskettenlabel *)
  i       : INTEGER;
  IF Length(DriveLabel) > 11 THEN DriveLabel[0] := Chr(11);
  FCB[0] := $FF;                     (* Kennung erw. FCB setzen      *)
  FOR i := 1 TO 45 DO FCB[i] := $00; (* ... des Rest ausnullen       *)
  FCB[6] := VolumeID;                (* was bearbeitet werden soll   *)
  FCB[7] := Drive;                   (* Laufwerk an Position 7       *)
  OldLabel := GetLabel(drive);       (* das bleibt uns nicht erspart *)
  IF DosError = 18 THEN DosError := 0;(* No more files, kein Fehler *)
  IF DosError <> 0 THEN              (* DOS-Fehler aufgetaucht       *)
    SetLabel := DosError;            (* Funktionsergebnis = Fehler   *)
    Exit;                            (* ... und raus                 *)

  IF DriveLabel = '' THEN            (* --> Funktion Label löschen   *)
    IF OldLabel <> '' THEN           (* war eines da                 *)
      FOR i := Length(OldLabel) TO 11 DO
        OldLabel := OldLabel +  ' '; (* Ausnullen mit Leerzeichen    *)
      FOR i := 1 TO 11 DO FCB[i + 7] := Ord(OldLabel[i]);
      WITH Regs DO                   (* in FCB übertragen            *)
        AH := $13;                   (* Funktion 13h: Label löschen  *)
        DS := Seg(FCB);
        DX := Ofs(FCB);
        IF Regs.AH = $FF THEN SetLabel := GetExtendedError
                         ELSE SetLabel := 0;  (* Fehlerprüfung       *)
        Exit;                                 (* ... und raus        *)
    BEGIN             (* wo nichts ist, kannn nichts gelöscht werden *)
      SetLabel := 0;  (* Löschen was nicht war ist kein Fehler       *)
      Exit;           (* und raus aus der Funktion                   *)

  FOR i := Length(DriveLabel) TO 11 DO (* ... und jetzt Label setzen *)
    DriveLabel := DriveLabel +  ' ';
  FOR i := 1 TO 11 DO
  BEGIN                                  (* unerlaubtes Zeichen ???? *)
    IF DriveLabel[i] IN [Chr(0)..Chr(31), '.', '&', '?', '"', '*' ,
                         '+', '<', '>', Chr(166)..Chr(255)] THEN
      DriveLabel[i] := '_';            (* durch Unterstrich ersetzen *)
    IF DriveLabel[i] IN ['/', '|', '/'] THEN DriveLabel[i] := '!'
  END;                              (* oder durch ein Ausrufezeichen *)

  IF Length(OldLabel) > 0 THEN
    FOR i := Length(OldLabel) TO 11 DO OldLabel := OldLabel +  ' ';
    FOR i := 1 TO 11 DO           (* ausnullen und übertragen in FCB *)
      FCB[i +  7] := Ord(OldLabel[i]); (* Laufwerksnummer nach Pos 7 *)
      FCB[i + 23] := Ord(DriveLabel[i]);
    WITH Regs DO
      AH := $17;                   (* Funktion 17h: Label umbenennen *)
      DS := Seg(FCB);
      DX := Ofs(FCB);
      IF Regs.AH = $FF THEN SetLabel := GetExtendedError
                       ELSE SetLabel := 0           (* Fehlerabfrage *)
    FOR i := 1 TO 11 DO FCB[i + 7] := Ord(DriveLabel[i]);
    WITH Regs DO
      AH := $16;                        (* Funktion 16h: Neu anlegen *)
      DS := Seg(FCB);                   (* des Labels                *)
      DX := Ofs(FCB);
      IF Regs.AH = $FF THEN SetLabel := GetExtendedError
                       ELSE SetLabel := 0

tpqa index    tpqa_2 back   tpqa_4 forward

Get your own FREE HOMEPAGE