7  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: Jan-16 1999    Index 1QA go to 1QA index page


   Subject: Re: Setting external application to Always On Top!
      Date: 25 Dec 1998 03:13:49 GMT
      From: icyexit@aol.combobox1 (Icy exit)
 Organization: AOL http://www.aol.com
 Newsgroups: comp.lang.pascal.delphi.misc

yes youd do it like this..

var note: hwnd;
begin
 note:=findwindow('notepad',nil);
 setwindowpos(note, hwnd_topmost,0,0,0,0, swp_nomove or swp_nosize or
swp_noactivate);
end;

take a look at setwindowpos in the api help file for all the ways to change it
around, topmost and not.

>Subject: Setting external application to Always On Top!
>From: "Tikotzki Tal" <aeroteam.tal@rs.co.il>
>Date: Thu, Dec 24, 1998 20:59 EST
>
>Is there a way to control a 3rd party application properties, such as
>Setting the Media Player to Always on top even though there is no such
>possibility within it's standard options.
>For example, we are developing a software that executes a video capture
>application, The Video app has no Stay-On-Top capability.
>We want to make Always-On-Top by altering it's properties from
>our application.
>Is there a way?
>
>Thanks!  >Happy Holidays! >Tal T.



   Subject: Re: Lösung für "Division by Zero" ???  Millisecond delay timer
      Date: 24 Dec 1998 21:30:00 +0100
      From: tc@thies.allcon.com (Mario Thies)
 Newsgroups:de.comp.lang.pascal.misc

Moin fam.plehn@t-online.de (Mein Name)
du schriebst am 24.12.98:

Schlechte Idee. Denn erstens ist eine Änderung der Systemuhr
nicht stetig, zweitens umgehst du damit nicht die bekannten
Probleme der vollen CPU-Auslastung während des Wartens.

Es gibt diverse bessere Alternativen für Warteschleifen,
alles, was bei mir noch mit BP7 läuft, arbeitet mit dieser
Routine zufriedenstellend:

Procedure Delay(ms:Word); Assembler;
 Asm
        mov     ax,1000
        mul     ms
        mov     cx,dx
        mov     dx,ax
        mov     ah,$86
        int     $15
End;
 __ _
  \ \_  public Key auf der Homepage
        http://homepages.allcon.com/~thies

CAUTION: The INT 15H system call is OS-version dependant!!!  Franz Glaser



   Subject: Loesung: Registry über API auslesen read registry using API
      Date: Sat, 26 Dec 1998 12:04:15 +0100
      From: ChrisR@t-online.de (Christian Rudolph)
Newsgroups: de.comp.lang.pascal.delphi

Lars Iwer schrieb in Nachricht ...

>ich versuche momentan verzweifelt, mit Hilfe der API die Registry direkt
>(ohne uses registry) auszulesen...... irgendwie scheitere ich daran
>immer....

---- snipped some off topic text (F.Glaser)
Pure API hat oft mehr Vorteile, als der Delphi Objekt-Wasserkopf ;-)
Pure API often has more advantages than the Delphi Object overhead

Mein Vorschlag:   my suggestion    Xlate added by Franz Glaser

// Funktion liest die Schluessel 'Lizenznehmer' und 'Organisation' aus,
// fuer welche Windows registriert wurde.
{ function to read the keys RegisteredOwner and RegisteredOrganisation,
  for whom Windows was registered}

function CheckRegistry : bool;
const
  HKLM     : hKey  = HKEY_LOCAL_MACHINE;
  SK_MS_95 : PChar = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
  ROwner   : PChar = 'RegisteredOwner';
  ROrg     : PChar = 'RegisteredOrganization';
var
  hRegKey  : hKey;                        // Handle fuer Schluessel  handle for key
  lpData   : pointer;                     // Pointer zu Daten     ptr to data
  lpType   : DWORD;                       // Type-Info von lpData    type info of lpData
  lpcbData : DWORD;                       // Groesse von lpData     size of lpData
begin
  result := false;
  if ERROR_SUCCESS =
     RegOpenKeyEx(HKLM,SK_MS_95,0,KEY_ALL_ACCESS,hRegKey) then
     begin
      lpcbData := 3;
      // erstmal checken, wie lang der String im Keywert ist
      {first check the stringlength in the keyvalue}
      if ERROR_SUCCESS =
         RegQueryValueEX(hRegKey,ROwner,nil,@lpType,nil,@lpcbdata) then
        begin
          GetMem(lpData,lpcbdata+1); // Speicher allokieren  allocate memory
          if lpData = nil then exit;   // wenn fehlgeschlagen if failed
          if ERROR_SUCCESS = RegQueryValueEX
             (hRegKey,ROwner,nil,@lpType,lpdata,@lpcbdata) then
            begin
            // nun haben wir den String in lpdata :-)
            // ... irgendwas mit dem String anstellen ...
            {now we have the string in lpdata :-)
             do something with the string...}
              FreeMem(lpdata,lpcbdata+1); // Speicher wieder freigeben release mem
            end
          else
            begin
              FreeMem(lpdata,lpcbdata+1);
              exit;
            end;
        end  {if regqueryvalueex}
      else
        exit;

      lpcbData := 3;              // nochmal ...  once again
      if ERROR_SUCCESS =
          RegQueryValueEX(hRegKey,ROrg,nil,@lpType,nil,@lpcbdata) then
        begin
          GetMem(lpData,lpcbdata+1); // siehe oben    see above
          if lpData = nil then exit;
          if ERROR_SUCCESS = RegQueryValueEX
             (hRegKey,ROrg,nil,@lpType,lpdata,@lpcbdata) then
           begin
            // nun haben wir den 2. String in lpdata :-)
            // ... irgendwas mit dem String anstellen ...
            {now we have the 2nd string in lpdata :-)
             do something with the string...}
              FreeMem(lpdata,lpcbdata+1);
            end
          else
            begin
              FreeMem(lpdata,lpcbdata+1);
              exit;
            end;
        end {if regqueryvalueex}
      else
        exit;
      RegCloseKey(hRegKey);
    end {if regopenkeyex}
  else
    exit;
  result := true;
end;

Diese Variante gilt fuer auszulesende Strings. DWords und/oder
Binaerdaten erfordern eine etwas andere Vorgehensweise.

This version is valid for strings to be obtained. DWords and/or
binary data need a slightly distinct approach

Wenn noch Fragen sind -> Mail an mich.
HTH



    Subject: Re: two or more lines in 'HINT'    note: 2 mails
       Date: Sun, 27 Dec 1998 12:02:41 -0600
       From: Andrew Rossmann <andyross@ntsource.com>
 Organization: Posted via RemarQ, http://www.remarQ.com - Discussions start here!
 Newsgroups: comp.lang.pascal.delphi.components.misc, comp.lang.pascal.delphi.misc

Mirco Schmedicke wrote:
> is it possible to write two or more lines in the Hint-property? When 'yes'
> - how?

  Try this neat add-on:

procedure TWinDplotMainForm.GetHintInfo(var HintStr: string;
                                        var CanShow: boolean;
                                        var HintInfo: THintInfo);
begin
  HintStr:=WrapText(HintStr, #13#10, ['.', ' ', '-', ','], 35);
                  //adjust the 35 to how many chars wide you want.
end;
  Then, somewhere in your main form's FormCreate, add this:
Application.OnShowHint:=GetHintInfo;
Application.HintHidePause:=5000;  //optional, adjust to what you want.
   Now, all of your hints will automatically wrap as needed! Although,
technically, hints shouldn't be so long that they need wrapping!!
  WrapText is a standard Delphi routine (at least it's in 4.0's SysUtils
unit), so you should find the information about it in the help system.
--
http://www.ntsource.com/~andyross



    Subject: Re: two or more lines in 'HINT'  2nd mail
       Date: Sun, 27 Dec 1998 18:44:18 +0100
       From: "Niels Vanspauwen" <Niels.Vanspauwen@Student.Kuleuven.Ac.Be>
 Organization:KULeuvenNet
 Newsgroups: comp.lang.pascal.delphi.components.misc, comp.lang.pascal.delphi.misc

>is it possible to write two or more lines in the Hint-property? When 'yes'
>- how?

Yes. At designtime, click the elipsis button (the '...' button) of the hint
property to pop up an editor. You can enter multiple lines there.
At runtime, you can do this by adding a #13 between strings, like this:

Button1.Hint := 'This is line1.' + #13 + 'This is line 2.';
HTH, Niels.

--------------------------------------------
Niels Vanspauwen Student @ KULeuven  Faculty of Engineering  Department of Computer Science
--------------------------------------------
Author of the most powerful macro-component for all your Delphi-applications.
TMagicMacros records, plays, shows infoboxes, supports VisualHelp, and much more!
Check out: http://magicmacros.8m.com



   Subject: Re: How to merge menus in MDI applications??
      Date: Mon, 28 Dec 1998 13:55:56 GMT
      From: Reid Roman <rkroman@home.com>
 Organization:@Home Network
 Newsgroups: comp.lang.pascal.delphi.misc

Bo Berglund wrote:
>
> No matter how I do it the menus do not merge! Instead they get
> replaced. :-(
>
> What I want to do is this:
> Main MDI form has a few common menus:
> File
> Window
> Help
>
<CUT HERE>

The trick is the GroupIndex property of the menu Items.

1) Make sure the AutoMerge property is set to TRUE for each form.

2) If you have a file menu on the mdiParent (main) form that you
want replaced by the file menu on the mdiChild form, set the
GroupIndex property on the mdiChild form's menu item to a HIGHER
value than the mdiParent.

If you want to keep the parent's file menu after the merge, set
the mdiChild form's menu item to a LESSER value.

One note: If you are new to MDI apps and you want a the Parent
form's Window menu to list the child forms automatically, make
sure to set the WindowMenu property to the Window menu you create.

HTH  Rkr
                   \|||/
                   /'^'\
                  ( 0 0 )
--------------oOOO--(_)--OOOo--------------
Reid Roman, Delphi Programmer
TVisualBasic:=class(None) May the Source be With You              .
-------------------------------------------
. Auto-By-Tel (http://www.autobytel.com) Irvine, CA U.S.A
E-Mail : rkroman@home.com



   Subject: Re: Transparent bitmap
      Date: Mon, 28 Dec 1998 21:10:31 +0100
      From: "Geir Wikran" <gwikran@online.no>
Newsgroups: borland.public.delphi.graphics

Axel CHAMBILY wrote in message <75q9jg$p10$1@news2.isdnet.net>...
>A TImage has a transparent property. But, I have to print preview and then
>to print this image. So, I need to reproduce the transparency by code. I
>guess that I should use some CopyMode, but my tries were unsuccessfull. The
>transparency seems to be automatic with WMFs but obviously not with BMPs.
>Can anybody help ?
 

Drawing a bitmap transparently unsing Win32 api:

We presuppose that FTrnsColor is set to the transparent color,
and that FBitmap contains the original bitmap.

var
  FTrnsColor: TColor;  // transparent color
  FBitmap   : TBitmap; // original bitmap
  FMono     : TBitmap; // black/white maske
  FMasked   : TBitmap; // masked version of bitmap

procedure CreateMask;

{ Procedure for creating the maskes necessary for transparent drawing.  }
{ We need a B/W maske (FMono) where the transparent pixles are set to   }
{ white and the nontransparent to black. We also need a masked version  }
{ of the bitmap (FMasked) where all the transparent pixles are set to   }
{ black. The original bitmap (FBitmap) is only needed in the process of }
{ making the maskes, it is not needed in the drawing process, so one is }
{ free to destroy it. It is not necessary to recreate the maskes every  }
{ time the bitmap shall be drawn, so it is wise to preserve the maskes  }
{ between each drawing. The maskes only needs to be recreated when the  }
{ original bitmap has changed.                                          }

var
  SrcRect: TRect;
  DDB    : TBitmap;
  DdbDC  : HDC;
  SrcDC  : HDC;
  MnoDC  : HDC;
  MskDC  : HDC;
begin
  if FBitmap.Empty then Exit

  SrcRect := Bounds(0,0,FBitmap.Width,FBitmap.Height);

{ create mono with transparent pixels white and nontransparent black: }
  DDB := TBitmap.Create;
  DDB.Assign(FBitmap);
  DDB.HandleType := bmDDB; // MUST come AFTER assign on DDB (prev line)
  DDB.Canvas.Brush.Color := FTrnsColor;
  DdbDC := DDB.Canvas.Handle;

  FMono := TBitmap.Create;
  FMono.Monochrome := true;
  FMono.Width := FBitmap.Width;
  FMono.Height := FBitmap.Height;
  MnoDC := FMono.Canvas.Handle;

  BitBlt(MnoDC,0,0,FBitmap.Width,FBitmap.Height,DdbDC,0,0,SRCCOPY);
  DDB.Free;

{ create masked version of source picture: }
  FMasked := TBitmap.Create;
  FMasked.Width := FBitmap.Width;
  FMasked.Height := FBitmap.Height;
  MskDC := FMasked.Canvas.Handle;

  { copy source picture to masked: }
  SrcDC := FBitmap.Canvas.Handle; // MUST come AFTER assign on DDB
  BitBlt(MskDC,0,0,FBitmap.Width,FBitmap.Height,SrcDC,0,0,SRCCOPY);

  { set transparent pixels to black in masked: }
  BitBlt(MnoDC,0,0,FBitmap.Width,FBitmap.Height,0,0,0,DSTINVERT); // invert
mono
  BitBlt(MskDC,0,0,FBitmap.Width,FBitmap.Height,MnoDC,0,0,SRCAND);
  BitBlt(MnoDC,0,0,FBitmap.Width,FBitmap.Height,0,0,0,DSTINVERT); // restore
mono
end;
 

procedure DrawTrans(Canvas: TCanvas; x,y: Integer);

{ Procedure for drawing the bitmap tansparently on a given canvas }
{ by using the already created maskes.                            }

var
  DstDC: HDC;
  MnoDC: HDC;
  MskDC: HDC;
begin
  if FBitmap.Empty then Exit;

  DstDC := Canvas.Handle;
  MnoDC := FMono.Canvas.Handle;
  MskDC := FMasked.Canvas.Handle;

  { set nontransparent pixels to black on canvas: }
  BitBlt(DstDC,x,y,FMono.Width,FMono.Height,MnoDC,0,0,SRCAND);

  { combine destination and masked: }
  BitBlt(DstDC,x,y,FMasked.Width,FMasked.Height,MskDC,0,0,SRCPAINT);
end;

Geir



   Subject: Re: Euro character  (printer related)
      Date: 6 Jan 1999 01:38:51 GMT
      From: tfiske@delphi.com (Todd Fiske)
 Organization: Delphi Internet Services <http://www.delphi.com/>
 Newsgroups: comp.lang.pascal.borland
 

On Wed, 30 Dec 1998 23:51:07 -0100, G.Velema / M. Hilvers
<gvelema@inter.NL.net> wrote:

>For a billing program I need to print the Euro (money) character.
...
>I know that my (HP) printer supports 'user defined' or 'downloadable'
>characters but the printer manual is not clear on how to do this.

Hi Martin -

The following program will create a little file called EUROCHAR.PCL, which
will generate and print the Euro mark in a bit of sample text. You will
need to send it to your printer with a command like:

   copy /b eurochar.pcl lpt1

You will need to study the program and see how I created it, then adapt
those techniques to your own program.

I drew the character initially as a text bitmap (technically it's more of a
"byte-map"). I then wrote a little routine to convert this into a real
binary bitmap which is what eventually gets sent to the printer. I sent it
as the contents of a PCL macro so it can be called multiple times per print
job.

The character is in a 32x32 pixel bitmap, which when printed at 300dpi
resolution, will occupy just over 1/10 of an inch, which will be okay if
you're printing at 10cpi in a fixed width font such as Courier (I only
tested it with default printer settings). If you are printing at a
different pitch, or are using a proportional font, you may need to make
some adjustments to things.

Let me know if you have questions about any of this.

Cheers, Todd

{---------------------------------------------------------------------------}
{- EUROCHAR.PAS    generate HP PCL code to print the Euro currency symbol  -}
{- Todd Fiske      tfiske@delphi.com                                       -}
{-                                                                         -}
{- 1999-01-05      first version                                           -}
{---------------------------------------------------------------------------}

This program defines a bitmap to resemble the Euro currency character, and
provides routines to convert it into HP PCL code so that it can be printed
along with other text.

The approach is to send the character as Raster Data, and wrap the raster
data in a PCL macro which takes care of cursor positioning so that the
character can be printed with relative ease. "Relative" since PCL printing is
always a bit finicky to begin with.

----------------------------------------------------------------------------}

program eurochar;

const
   CharBitmap : array [ 0..31, 0..31 ] of char =

     {          11111111112222222222333 }
     { 12345678901234567890123456789012 }
   (
      '................................', {  1 }  { This is my crude repre- }
      '................................', {  2 }  { sentation of the Euro   }
      '................................', {  3 }  { symbol, based on what I }
      '.................xxxxxx.........', {  4 }  { saw on the Europa web   }
      '...............xxxxxxxxxx.......', {  5 }  { page.                   }
      '.............xxxxxxxxxxxxxx.....', {  6 }
      '...........xxxxxxx....xxxxxx....', {  7 }
      '.........xxxxxx..........xxxxx..', {  8 }
      '........xxxxx.............xxxxx.', {  9 }
      '.......xxxxx................xxx.', { 10 }  { Use an "x" for a black  }
      '.......xxxx..................x..', { 11 }  { pixel, and a "." for a  }
      '......xxxx......................', { 12 }  { clear pixel, and modify }
      '..xxxxxxxxxxxxxxxxxxxxxxxxxx....', { 13 }  { the bitmap to properly  }
      '.xxxxxxxxxxxxxxxxxxxxxxxxxx.....', { 14 }  { reflect the mark.       }
      'xxxxxxxxxxxxxxxxxxxxxxxxxx......', { 15 }
      '....xxxx........................', { 16 }
      '....xxxx........................', { 17 }
      '..xxxxxxxxxxxxxxxxxxxxx.........', { 18 }
      '.xxxxxxxxxxxxxxxxxxxxx..........', { 19 }  { You can change the      }
      'xxxxxxxxxxxxxxxxxxxxx...........', { 20 }  { black and clear pixel   }
      '......xxxx......................', { 21 }  { characters to be what-  }
      '......xxxxx..................x..', { 22 }  { ever you like, but make }
      '.......xxxxx................xxx.', { 23 }  { sure to change ALL of   }
      '........xxxxx.............xxxxx.', { 24 }  { them, and change the    }
      '.........xxxxxx..........xxxxx..', { 25 }  { zero_char and one_char  }
      '..........xxxxxxxx....xxxxxxx...', { 26 }  { constants below to      }
      '............xxxxxxxxxxxxxxx.....', { 27 }  { match.                  }
      '..............xxxxxxxxxxx.......', { 28 }
      '.................xxxxxx.........', { 29 }
      '................................', { 30 }
      '................................', { 31 }
      '................................'  { 32 }
   );

var
   CharArray : array [ 0..127 ] of byte;  { this will hold the binary       }
                                          { version of the above bitmap -   }
                                          { see convert_bitmap_to_array()   }

{- This could also be defined as "array [ 0..31, 0..3 ] of byte", but my
initial attempt was to redefine a character in a font, where the binary data
appears all as one sequence (using raster data, each raster line is sent
separately). In any event, the array access is similar either way, so I left
it as is.
-}

{- The following definitions and routines provide a simple way to convert a
byte into a binary string representation and vice versa. For example:

   AByte   := ord( 'T' );
   AString := byte2bit( AByte );

   AString now contains '.x.x.x..'

byte2bit() is not used in this program. bit2byte() is used to convert the
text bitmap above into binary data to be sent to the laser printer.

Real2Str() is used by the demo in write_pcl() below. It's not used by the
bit/byte conversion routines, I just like to put all of my "library-level"
routines together.

Iifc() returns one of two characters depending on the given boolean. It is
used by byte2bit().

Redefine the constants zero_char and one_char if you want, or use the
routines set_zero_char() and set_one_char(). I use "." for 0 and "x" for 1
because they come pretty close to clear and filled pixels respectively.
-}

const
   zero_char : char = '.';
   one_char  : char = 'x';

type
   string_8  = string[ 8 ];

{- Real2Str                                                                   -}
function real2str( r : real; l, d : integer ) : string;
var
   s : string;
begin
   str( r : l : d, s );
   real2str := s;
end;

{- Iifc                                                                    -}
function iifc( b : boolean; c1, c2 : char ) : char;
begin
   if b then
      iifc := c1
   else
      iifc := c2;
end;

{- Set Zero Char                                                           -}
procedure set_zero_char( c : char );
begin
   if c <> one_char then
      zero_char := c;
end;
procedure set_one_char( c : char );
begin
   if c <> zero_char then
      one_char := c;
end;

{- Bit2Byte                                                                -}
function bit2byte( s : string_8 ) : byte;
var
   i, j, w : byte;
begin
   i := 128;
   j := 1;
   w := 0;
   for j := 1 to 8 do begin
      if s[ j ] = one_char then
         w := w + i;
      i := i shr 1;
   end;
   bit2byte := w;
end;

{- Byte2Bit                                                                -}
function byte2bit( b : byte ) : string_8;
var
   i : byte;
   j : byte;
   w : string_8;
begin
   i := 128;
   w := '';
   j := 1;
   while i > 0 do begin
      w[ j ] := iifc( ( b and i ) = i, one_char, zero_char );
      i := i shr 1;
      inc( j );
   end;
   w[ 0 ] := #8;
   byte2bit := w;
end;

{- Convert Bitmap To Array                                                 -}
procedure convert_bitmap_to_array;
var
   rind : word; { bitmap row index }
   cind : word; { bitmap column index }
   aind : word; { array index }

   s : string_8;
   b : byte;
begin
   {- for each row of bitmap
         for each octet of row
            convert octet to byte
            put byte in array
   -}

   aind := 0;
   rind := 0;
   while rind < 32 do begin                      { for each row of bitmap }

      cind := 0;
      while cind < 32 do begin                   { for each octect of row }

         move( CharBitmap[ rind, cind ], s[ 1 ], 8 ); { copy data to string }
         s[ 0 ] := #8;                           { set string length }

         b := bit2byte( s );                     { convert string to byte }
         CharArray[ aind ] := b;                 { put byte in array }

         inc( aind );                            { advance array }
         inc( cind, 8 );                         { advance column by 8 }
      end;

      inc( rind );                               { advance row }
   end;
end;

{- Write Pcl                                                               -}
procedure write_pcl;
const
   cEsc = #27;
   cNl  = #13#10; { "Nl" = "new line" }
var
   f    : file;
   rind : word;
   aind : word;

   dollars  : real;
   euros    : real;
   xchgrate : real;

   procedure send( s : string );
   begin
      blockwrite( f, s[ 1 ], length( s ) );
   end;

begin
   assign( f, 'eurochar.pcl' );
   rewrite( f, 1 );

   {- start macro definition -}
   send( cEsc + '&f1Y' ); { set macro id to 1 }
   send( cEsc + '&f0X' ); { start definition }

   {- get cursor ready - graphics top left is at text baseline, so fix it -}
   send( cEsc + '&f0S' );   { save (push) cursor position }
   send( cEsc + '*p-32Y' ); { move up 32 dots }

   {- send graphics -}
   send( cEsc + '*t300R' ); { set resolution to 300dpi }
   send( cEsc + '*r1A'   ); { start raster graphics at cursor position }

   { send raster data }
   rind := 0;
   aind := 0;
   while rind < 32 do begin
      send( cEsc + '*b4W' ); { signal that 4 bytes of data follow }
      blockwrite( f, CharArray[ aind ], 4 ); { send the 4 bytes }
      inc( aind, 4 );
      inc( rind );
   end;
   send( cEsc + '*rB' );  { end of raster data }

   send( cEsc + '&f1S' ); { restore (pop) cursor position }
   send( ' ' );           { write a space to move beyond Euro mark }

   {- finish macro -}
   send( cEsc + '&f1X' ); { finish macro definition }

   {----------------------------------------}

   {- usage example -}
   xchgrate := 1.18195;
   dollars  := 52;
   euros    := dollars * xchgrate;

   send( cEsc + '&l2H' ); { manual feed, for testing purposes }

   send( cNl + cNl + 'The cost is $'+ real2str( dollars, 5, 2 ) +' or ' );
   send( cEsc + '&f3X' ); { call macro to place a Euro mark in text }
   send( real2str( euros, 5, 2 )+ ', given an' + cNl );
   send( 'estimated exchange rate of '+ real2str( xchgrate, 6, 4 ) +' ' );
   send( cEsc + '&f3X' ); { call macro again }
   send( ' per $.' + cNl );

   {- above will produce something like the following:

         The cost is $99.99 or *99.99, given an
         estimated exchange rate of 9.9999 * per $.

      where * is the Euro mark
   -}

   {- delete macro, reset printer -}
   send( cEsc + '&f8X' );
   send( cEsc + 'E' );

   close( f );
end;

{---------------------------------------------------------------------------}
{- Main                                                                    -}
begin
   convert_bitmap_to_array;
   write_pcl;
end.
{- EOF : EUROCHAR.PAS                                                      -}
{---------------------------------------------------------------------------}
some cosmetic snips made by Franz Glaser (comment bars erased) for html size reduction



   Subject: Re: How to convert color to grayscale ?
      Date: Thu, 07 Jan 1999 04:34:39 -0500
      From: Davie Reed <davie@smatters.com>
Newsgroups: borland.public.delphi.graphics

The following is what's used in a lot of BIOS's for grayscaling, BUT You will
notice that if you change the shades of BLUE or RED, they make TOO much of an
adjustement using this method. There is a STANDARD way of converting and is
used by TV sets as well :)

PCXGrayValue:=((R Shl 5)+(G Shl 6)+(B*12)) Div 108;

This line will give you a gray value that is VERY close to the perfect number
based on eye response standards. The standard is this:

Red gets 30 %
Green gets 59%
Blue gets 11%

>From this you can see that changes in green are more noticable to the eye than
changes in blue!
The little snippet of code above actually gives you:
Red: 29.5%
Green 59.3%
Blue 11.1%

AS you can see the results are VERY close to actual. And since no
multiplication is used you can achieve the correct results very fast :)

Davie
 
 

Mark Malakanov wrote:

> I think all laser printer drivers have option to print color picture as
> grayscale.
> But anycase, algorithm is simple.
>
> type TBGR = packed record B,G,R :byte; end; // internal bitmap 24-bit data
> format
>         PBGR = ^TBGR;
> var Line = PBGR;
> begin
> Picture.Format := 24bit; //I dont remember sharply, but you must insure
> 24bit format for picture;
> for y:=0 to Picture.Height - 1 do
>   begin
>   Line := Picture.ScanLine[y];
>   for y:=0 to Picture.Width - 1 do
>     with Line^[x] do
>     begin
>     R:= (R+G+B) div 3;  // It is simple AVERAGE value. You can make lighter
> or darker here;
>     G:= R; B:=R;
>     end;
>   end;
>
> Mark
> www.chat.ru/~markmal     there are many of freeware/shareware components
>
> Søren Kolind ÐÉÛÅÔ × ÓÏÏÂÝÅÎÉÉ <01bd6ae5$09b73aa0$2193efc2@default> ...
> >How can a colorpicture be converted to a grayscale, suitabel for printing
> >on a laserprt. ?
> >The pictures I work with, mostly contain dark colors like deep dark-brown,
> >and its been printed like black. The pics are jpeg, loaded to TBitmap.
> >
> >Søren Kolind, rasak@post3.tele.dk


  Subject: Re: Help: MS-DOS Screen Capture (in Full-Screen Mode) Under Win 95/98/NT
      Date: Fri, 8 Jan 1999 09:50:24 +1100
      From: "Christopher Latta" <clatta@ozemail.com.auX>
 Newsgroups:
          alt.comp.lang.borland-delphi, alt.lang.delphi, comp.lang.pascal.delphi.components.misc,
          comp.lang.pascal.delphi.components.usage, comp.lang.pascal.delphi.components.writing,
          comp.lang.pascal.delphi.databases,
          comp.lang.pascal.delphi.misc, comp.sources.del

If you want a cheesy SendKeys solution, grab PushKeys from
http://www.ozemail.com.au/~clatta in the download section. Actually, its not
cheesy, its excellent (showing that modesty is one of my many, many great
personality attributes :) ).

PushKeys is a reworking of the flaky VB SendKeys command (using the Win32
keybd_event API call), and is syntax compatible with it, although it does
stuff beyond what SendKeys does, like sending keystrokes to DOS apps, plus
extended keystrokes and functionality. There are versions for VB, Delphi,
and C available. It comes with full source, a help file, and its free.

Getting the output of a DOS app is a little tricky. What you can do here is
run the
DOS app in a window, and use PushKeys to cut and paste between the DOS app
and your app. To do this, invoke the control menu by sending a Alt-Space to
the DOS window, then selecting E to Edit and K to mark. Then use the arrow
keys to negotiate your way to the area of the screen you want, press the
Shift key, and use the arrow keys to mark the text you want. Now re-invoke
the control menu (Alt-Space) and select E to Edit and Y to Copy. You now
have copied the
area you want to the clipboard. Put the focus back to your app, and paste
into an edit box or whatever.

Good luck!
Christopher Latta

Louis S. Berman wrote in message <770oai$t25$1@news2.i-2000.com>...
>Hi!  I need to implement a program that can capture an MS-DOS screen, in
>full-screen mode, under Win 95/98/NT.  I spent the last day trying to find a
>good answer to this, but so far, I have come up with nothing.  I know that I
>could, in theory, implement a cheesy "SendKeys" solution and/or snag the
>image via the clipboard, but I am looking for a much more elegant solution.



   Subject: Re: Wie dateizugriff in tsr ?  file access in TSR (German)
      Date: Sat, 09 Jan 1999 11:20:03 +0100
      From: Frédéric <fb@rz-online.de>
 Newsgroups: de.comp.lang.pascal.misc

Martin Laabs wrote:

> Ich bin schon recht weit in meinem TSR. Nun habe ich aber viele Abstürze
> gehabt, und habe auch die warscheinliche ursache von diesen gefunden.
> Da ich öfters auf die Festplatte die Daten (Tastatureingabe) speichere muß
> gibt es warscheinlich probleme mit anderen Programmen, die dieses auch tuen.
> Wie kann ich also so lange warten, bis garantiert kein Plattenzugrif
> erfolgt?
> Wäre es möglich, in einer anderen Routine, die vom int 28h aufgerufen wird
> so lange zu warten, bis dieser auferufen wird, und die daten die anfallen so
> lange in einem Puffer zu speichern ?
> Oder sowieso in einen Puffer speichern und seltener auf die Platte zugreifen
> ?
> Oder ist das gar nicht das Problem ?

Ich habe das Problem auch einmal gehabt - allerdings nicht in Pascal, sondern in
Assembler. Mein TSR sollte den Namen des Programms, das gerade ausgeführt wurde,
in eine Datei schreiben. Dazu hat es Int 21h/AX=4B00h abgefangen.

Das eigentliche Problem bei mir war das PSP, und die Process ID. Ich habe leider
keine Ahnung, wie Pascal hier vorgeht; also ob der Compiler automatisch dafür
sorgt, dass man auf die korrekte Datei zugreift, oder ob man das selber machen
muss. Für den Fall, dass man es selber machen muss (und ansonsten erkläre ich
das hier eben umsonst):

Im PSP steht drin, welche Dateien ein Prozess geöffnet hat. Wenn dein TSR
aufgerufen wird, und in eine Datei zu schreiben versucht, benutzt es noch den
PSP des Programms, das aktiv war, als dein TSR aufgerufen wurden. Und das läuft
schief. Du musst vor jedem Zugriff auf die Datei erst dein eigenes PSP wieder
gültig machen.

Du kannst deine eigene Process ID ausfindig machen über:
AH=51h, Int 21h. In BX wird ein Wert übergeben, den du am besten in einer
Variable ablegst.

Setzen kannst du die Process ID über:
AH=50h, BX=(Wert, der vorher übergeben wurde), Int 21h.

Bevor das Programm resident wird, sollte es seine eigene Process ID herausfinden
und speichern.

Du musst dann innerhalb des TSR so vorgehen:
- Speichern der Process ID des aufrufenden Programms
- Setzen der eigenen Process ID
- Zugriff auf Datei
- Wiederherstellen der Process ID des aufrufenden Programms

Bis ich das herausgefunden hatte, hat auch eine Weile gedauert, und jetzt
funktioniert das Programm. Aber wie gesagt, ich weiß nicht ob dir das für Pascal
was bringt. Übrigens sollte man die beiden Funktionen 50h und 51h nicht von
einem Int 28h Handler aus aufrufen.



   Subject: Re: COM port  SendThroughRS232('\\.\COM1', 'Data String');
      Date: Thu, 14 Jan 1999 10:33:01 +1100
      From: "Cyrille de Brebisson" <cyrille_de-brebisson@aus.hp.com>
 Newsgroups:comp.lang.pascal.delphi.misc

bonjour

Here is it!
SendThroughRS232('\\.\COM1', 'Data String');
 

Function SendThroughRS232(Com: String; Data:String): boolean;
var
  dcb: _DCB;
  w: DWord;
  i: THandle;
begin
  result:= False;
  i:= CreateFile(pchar(com), GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, 0, 0);
  if i= INVALID_HANDLE_VALUE then exit;
  try
    if not GetCommState(i, dcb) then exit;
    dcb.BaudRate:= 9600;
    dcb.Flags:= 1;
    dcb.ByteSize:= 8;
    dcb.Parity:= 0;
//    dcb.StopBits:= 1;
    if not SetCommState(i, dcb) then exit;
    while length(data)>0 do
    Begin
      if not WriteFile(i, pchar(Data)^, min(Length(Data), 100), w, nil) then
        exit;
      if integer(w)<>min(Length(Data), 100) then Exit;
      data:= copy(data, 101, MaxInt);
      if Length(Data)<>0 then sleep(100);
    end;
    result:= True;
  finally
    CloseHandle(i);
  end;
end;
 

--
A+ Cyrille de Brebisson

Le Meilleur moment pour planter un arbre etait il y a 20 ans. Le Deuxiemme
meilleur moment est maintenant
The Best Time to plant a tree was 20 years ago. The second best moment is
now.

http://www.capway.com/brebisso
Peeteris Paikens wrote in message <77ieg3$h5n@news.latnet.lv>...
> Has anybody done reading/writing from/to a COM port in Delphi?
>If so, could you send me a small example or a link about such things?


tpqa index    tpqa_6 back    tpqa_8 forward    tp_index faq_page



Get your own FREE HOMEPAGE