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