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

USES DOS;

TYPE T_info = RECORD
               infolevel:      word;
               SrNo:           longint;
               VolumeLabel:    Array[1..11] of char;
               Filesystemtype: Array[1..8] of char;
               END;

var  info:t_info;

Procedure setser(DriveNr:byte);Assembler;
asm
    mov bl,drivenr
    lea dx,info
    mov bl,0
    mov ax,$6901
    int $21
end;
Procedure getser(DriveNr:byte);Assembler;
asm
    mov bl,drivenr
    lea dx,info
    mov bl,0
    mov ax,$6900
    int $21
end;
begin
  getser(1);
  writeln(info.SrNo);
  info.SrNo:=$12345678;
  setser(1);
  getser(1);
  writeln(info.SrNo)

end.

Gruss Willi

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
routines.

Features:
 - over 40 long filenames functions
      and procedures
 - over 10 functions and procedures
      implementing virtual machine
      services
 - 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)
           cristis@usa.net
           cstreng@hotmail.com
Address:   Cristi Streng
           str. Gen. Magheru nr. 11A ap.5
           3700 Oradea
           Romania
Phone:     +40-59-417477

download DOS70P13.ZIP (111 kB) at
http://www.lego.soroscj.ro/~cristis
it's really great!

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
address))}
        var
                temp:pointer; {used to read out of file}
                f:file; {file name variable}
                minpal:array[0..255,1..3]of byte; {our pallette}
begin
        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.}
        asm
                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}
        @loopen:
                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
repeated}
                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
        @enpix:
                stosb
        @nok_naa:
                cmp     di,63999
                jbe     @loopen
                pop ds
        end;
        freemem(temp,filesize(f)-768-128);
        seek(f,filesize(f)-768);
        blockread(f,minpal,768);
        setpal(minpal); {load pallette}
        close(f);
   end;

{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);
var
        l1:byte;
begin
        for l1:=0 to 255 do
        pal(l1,pally[l1,1],pally[l1,2],pally[l1,3]);
end;

procedure pal(col,r,g,b:byte);assembler;
asm
        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
end;

Nils Grimsmo

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!

  First you call CREATEUNIT(DBFPATH,DBFNAME),
  then a unit DBFNAME is being created and
  now you can access all fields by their name.

Example:

  {$DEFINE FIRST}
  Uses DBFSERV {$IFNDEF FIRST} ,FAKT {$ENDIF} ;

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

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)

or:

  [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

mailto:Antivivisektion@t-online.de
http://Antivivisektion.base.org (no PASCAL, no ENGLISH at all - sorry!)

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

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
transparently.

> [...]
> 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
call.

> 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 |

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
>Internet.

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.
http://ourworld.compuserve.com/homepages/yaminov
[No e-mail, please]

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
checking:

const
    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);

function
    bit(b: byte; n: byte):byte;
    var i, j: byte;
    begin
    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}

var
    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;

begin
    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);
    close(f);
    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];
        end;
    mpegSampleRateIndex := 2 * bit(h3, 5) + bit(h3, 6);
    case mpegVersion of
        1:  mpegSampleRate := mpeg1SampleRates[mpegSampleRateIndex];
        2:  mpegSampleRate := mpeg2SampleRates[mpegSampleRateIndex];
        25: mpegSampleRate := mpeg25SampleRates[mpegSampleRateIndex];
        end;
    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;
        end;
    mpegHasCopyright := (bit(h4, 5) > 0);
    mpegIsOriginal := (bit(h4, 6) > 0);
end.
_______________________________________
UL-Tomten (ircnet, #C-64) | icq 3167836

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;

CONST
   OFN_LONGNAMES = $00200000;

TYPE
  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):
Longint;
    lpTemplateName:     PChar;
  end;

VAR
   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;
BEGIN
  FillChar(Filter, SizeOf(Filter), #0);
  StrCopy(Filter, 'All files');
  StrCopy(@Filter[StrLen(Filter)+1], '*.*');
  DefExt := 'JOB'+#0;
  Ts := 'TEST WINDOW TITLE'+#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));
       End;
       CallRes := W32GetOpenFileName(W32OpenFN,
         id_W32GetOpenFileName)
     End;
   End;

END.

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.

Laine,

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
down:

procedure testwin.wmkeydown(var msg:tmessage);
begin
  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_left:;
    vk_right:;
    vk_up:;
    vk_down:;
    vk_next:Page Down;
    vk_prior:Page Up;
    vk_space:Space Bar;
    vk_delete:;
    Vk_F1:;
    vk_f2:;
    vk_f3:;
    vk_f4:;
    vk_f5:;
    vk_f7:;
    vk_f8:;
    vk_f9:;
    vk_return:;
    vk_tab:;
  end;
  msg.result:=0;
end;

You can also do the same for Wmkeyup.

Maria

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
like:

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);

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?"
http://www.monstersoft.com

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 |

Michele:

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,
8/8/97.
  // Used to print bitmap on any Windows printer.}
  PROCEDURE PrintBitmap(Canvas:  TCanvas; DestRect:  TRect;  Bitmap:
TBitmap);
    VAR
      BitmapHeader:  pBitmapInfo;
      BitmapImage :  POINTER;
      HeaderSize  :  INTEGER;
      ImageSize   :  INTEGER;
  BEGIN
    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
    GetMem(BitmapHeader, HeaderSize);
    GetMem(BitmapImage,  ImageSize);
    TRY
      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
      StretchDIBits(Canvas.Handle,
                    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}
                    BitmapImage,
                    TBitmapInfo(BitmapHeader^),
                    DIB_RGB_COLORS,
                    SRCCOPY)
    FINALLY
      FreeMem(BitmapHeader);
      FreeMem(BitmapImage)
    END
  END {PrintBitmap};

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

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

In article <6ioh62$ruv$1@camel21.mindspring.com>,
Michael J. Gregg <mjgregg@mindspring.com> wrote:
>This is a multi-part message in MIME format.
>
>------=_NextPart_000_0012_01BD7873.6FB5CEC0
>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;
    cdr:string[26];
    count,i:word;
begin
  CdRoms:='';
  if swap(dosversion)<5 then exit;
  rg.ax:=$1500;
  rg.bx:=0;
  intr($2f,rg);
  if rg.bx=0 then exit;
  cdr:='';
  for i:=1 to rg.bx do cdr:=cdr+chr(rg.cx+i+64);
  CDRoms:=cdr;
End;

Osmo

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
questions.

Eric
ntuser@teleport.com

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;
                    end;

Var VSNs : VSNstructure;

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

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

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

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

      Intr($21,regs);

      if (flags and 1) = 1 then exit;

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

Arnaud & Danièle Fietzke schrieb in Nachricht
<6j169n$5t3$1@news.online.de>...
>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?
>
>Thanks,
>Arnaud
>
Hello Arnaud!

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

FUNCTION GetLabel(Drive: BYTE): STRING; (* Label des Laufwerks lesen *)
VAR
  sr         : SearchRec;
  SearchDrive: PathStr;
  DriveLabel : STRING[12];
BEGIN
  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 *)
  BEGIN
    DriveLabel := sr.Name;                    (* aus SearchRec holen *)
    IF Pos('.', DriveLabel) > 0 THEN
      Delete(DriveLabel, Pos('.', DriveLabel), 1);  (* Punkt l”schen *)
  END
  ELSE
    DriveLabel := '';                               (* nicht gesetzt *)
  GetLabel := DriveLabel;
END;

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 ...    *)
VAR
  FCB     : ARRAY[0..45] OF BYTE;  (* File-Control-Block vereinfacht *)
  Regs    : Registers;
  OldLabel: STRING[11];             (* ursprüngliches Diskettenlabel *)
  i       : INTEGER;
BEGIN
  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       *)
  BEGIN
    SetLabel := DosError;            (* Funktionsergebnis = Fehler   *)
    Exit;                            (* ... und raus                 *)
  END;

  IF DriveLabel = '' THEN            (* --> Funktion Label löschen   *)
  BEGIN
    IF OldLabel <> '' THEN           (* war eines da                 *)
    BEGIN
      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            *)
      BEGIN
        AH := $13;                   (* Funktion 13h: Label löschen  *)
        DS := Seg(FCB);
        DX := Ofs(FCB);
        MsDos(Regs);
        IF Regs.AH = $FF THEN SetLabel := GetExtendedError
                         ELSE SetLabel := 0;  (* Fehlerprüfung       *)
        Exit;                                 (* ... und raus        *)
      END
    END
    ELSE
    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                   *)
    END;
  END;

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