📄 zmisc2.htm
字号:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Misc</TITLE>
<META NAME="Description" CONTENT="Miscellaneous section of the Delphi Developers FAQ" >
<META NAME="KeyWords" CONTENT="" >
</HEAD>
<BODY bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" color="#00FF00">
<CENTER><FONT SIZE="7" FACE="Arial Black" COLOR="RED">Miscellaneous Part 2</FONT></CENTER>
<P><H1><A NAME="zmisc20">Playing a wave sound from a resource file</P></A></H1>
<P><I>From: Stefan.Westner@stud.uni-bamberg.de (Stefan Westner)</I></P>
<PRE>In article <01bbde3a$960b1a00$1500dece@dbrown.ee.net>, dbrown@ee.net says...
I am attempting to have a wave file play when a button is clicked, in my
Delphi application. Rather than install the wave file and use the
PlaySound() API call, I'd like to put it into a resource file so that it
plays with only the EXE present.
</PRE>
<P>you need a resource compiler (i. E. Resource Workshop ) and add an user-defined-resource WAVE. You can play the resource-file in your program using</P>
<HR><PRE>var FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin
FindHandle:=FindResource(HInstance, '<Name of your Ressource>', 'WAVE');
if FindHandle<>0 then begin
ResHandle:=LoadResource(HInstance, FindHandle);
if ResHandle<>0 then begin
ResPtr:=LockResource(ResHandle);
if ResPtr<>Nil then
SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
UnlockResource(ResHandle);
end;
FreeResource(FindHandle);
end;
end;
</PRE><HR>
<P><H1><A NAME="zmisc21">How can my app use MY FONTS? not user's</P></A></H1>
<P><I>From: choate@cswnet.com (Brad Choate)</I></P>
<PRE>>Can someone please tell me the neatest way to make sure my app uses
>fonts that I can provide, rather than the nearest font the user has
>installed on their system? I have tried copying a #.ttf file into the
>users windows\system directory but the app still can't pick it up.
</PRE>
<P>The following is some Delphi 1 code that I have used for successfully installing
dynamic fonts that are only loaded while the application is running.
You can place the font file(s) within the application directory.
It will be installed when the form loads and unloaded once the form is destroyed.
You may need to modify the code to work with Delphi 2 since it calls various Windows API
calls that may or may not have changed. Where you see "..." in the code, that is just to identify that other code can be placed there.</P>
<P>Of course, substitute "MYFONT" for the name of your font file.</P>
<HR><PRE>type
TForm1=class( TForm )
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
...
private
{ Private declarations }
bLoadedFont: boolean;
public
{ Public declarations }
end;
procedure TForm1.FormCreate(Sender: TObject);
var
sAppDir: string;
sFontRes: string;
begin
sAppDir := Application.ExeName;
sAppDir := copy( sAppDir, 1, rpos( '\', sAppDir ) );
sFontRes := sAppDir + 'MYFONT.FOT';
if not FileExists( sFontRes ) then
begin
sFontRes := sFontRes + #0;
sFont := sAppDir + 'MYFONT.TTF' + #0;
CreateScalableFontResource( 0, @sFontRes[ 1 ], @sFont[ 1 ], nil );
end;
sFontRes := sAppDir + 'MYFONT.FOT';
if FileExists( sFontRes ) then
begin
sFontRes := sFontRes + #0;
if AddFontResource( @sFontRes[ 1 ] ) = 0 then
bLoadedFont := false
else
begin
bLoadedFont := true;
SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
end;
end;
...
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
sFontRes: string;
begin
if bLoadedFont then
begin
sFontRes := sAppDir + 'MYFONT.FOT' + #0;
RemoveFontResource( @sFontRes[ 1 ] );
SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
end;
end;
</PRE><HR>
<P><H1><A NAME="zmisc22">how to eject and close CD-Drive?</P></A></H1>
<P><I>From: Christian Piene Gundersen <j.c.p.gundersen@jusstud.uio.no></I></P>
<PRE>ClaWenkel wrote:
>
> Is there any API command in Delphi2 to eject AND CLOSE the CD-ROM Drive
> physically e.g. by clicking on a button? I don't want to use the
> TMediaPlayer component (which can only eject...)
> thanks in advance, ClaWenkel
</PRE>
<P>To open the CD-ROM:</P>
<HR><PRE> mciSendString('Set cdaudio door open wait', nil, 0, handle); </PRE><HR>
<P>To close the CD-ROM:</P>
<HR><PRE> mciSendString('Set cdaudio door closed wait', nil, 0, handle); </PRE><HR>
<P>Remember to include the MMSystem unit in your uses clause.</P>
<P><H1><A NAME="zmisc23">Moving from VB to Delphi</P></A></H1>
<P><I>The Graphical Gnome <rdb@ktibv.nl></I></P>
If you have finally taken the big stap and want to go from VB to Delphi 2 there are a few things different. <P>
Borland has a page describing the differences between Delphi and VB. It can be found at <p>
<A HREF="http://netserv.borland.com/delphi/papers/vb2dl/compon.html">http://netserv.borland.com/delphi/papers/vb2dl/compon.html</A>
<P><H1><A NAME="zmisc24">sscanf in delphi?</P></A></H1>
<P><I>From: canalrun@vcomm.net (Barry)</I></P>
A kind soul sent me the following unit a while ago. I have found it
quite useful, but there may be a problem with the %s tag since its use
has generated errors on occasion.<P>
<HR><PRE>unit Scanf;
interface
uses SysUtils;
type
EFormatError = class(ExCeption);
function Sscanf(const s: string; const fmt : string;
const Pointers : array of Pointer) : Integer;
implementation
{ Sscanf parses an input string. The parameters ...
s - input string to parse
fmt - 'C' scanf-like format string to control parsing
%d - convert a Long Integer
%f - convert an Extended Float
%s - convert a string (delimited by spaces)
other char - increment s pointer past "other char"
space - does nothing
Pointers - array of pointers to have values assigned
result - number of variables actually assigned
for example with ...
Sscanf('Name. Bill Time. 7:32.77 Age. 8',
'. %s . %d:%f . %d', [@Name, @hrs, @min, @age]);
You get ...
Name = Bill hrs = 7 min = 32.77 age = 8 }
function Sscanf(const s: string; const fmt : string;
const Pointers : array of Pointer) : Integer;
var
i,j,n,m : integer;
s1 : string;
L : LongInt;
X : Extended;
function GetInt : Integer;
begin
s1 := '';
while (s[n] = ' ') and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;
function GetFloat : Integer;
begin
s1 := '';
while (s[n] = ' ') and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;
function GetString : Integer;
begin
s1 := '';
while (s[n] = ' ') and (Length(s) > n) do inc(n);
while (s[n] <> ' ') and (Length(s) >= n) do
begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;
function ScanStr(c : Char) : Boolean;
begin
while (s[n] <> c) and (Length(s) > n) do inc(n);
inc(n);
If (n <= Length(s)) then Result := True
else Result := False;
end;
function GetFmt : Integer;
begin
Result := -1;
while (TRUE) do begin
while (fmt[m] = ' ') and (Length(fmt) > m) do inc(m);
if (m >= Length(fmt)) then break;
if (fmt[m] = '%') then begin
inc(m);
case fmt[m] of
'd': Result := vtInteger;
'f': Result := vtExtended;
's': Result := vtString;
end;
inc(m);
break;
end;
if (ScanStr(fmt[m]) = False) then break;
inc(m);
end;
end;
begin
n := 1;
m := 1;
Result := 0;
for i := 0 to High(Pointers) do begin
j := GetFmt;
case j of
vtInteger : begin
if GetInt > 0 then begin
L := StrToInt(s1);
Move(L, Pointers[i]^, SizeOf(LongInt));
inc(Result);
end
else break;
end;
vtExtended : begin
if GetFloat > 0 then begin
X := StrToFloat(s1);
Move(X, Pointers[i]^, SizeOf(Extended));
inc(Result);
end
else break;
end;
vtString : begin
if GetString > 0 then begin
Move(s1, Pointers[i]^, Length(s1)+1);
inc(Result);
end
else break;
end;
else break;
end;
end;
end;
end.
</PRE><HR>
<P><H1><A NAME="zmisc25">Help Files Contents</P></A></H1>
<P><I>From: "Jarle Stabell" <jarle.stabel@dokpro.uio.no></I></P>
Using HELP_FINDER works if the "current tab"
is not the 'Index' or 'Find' tab. HELP_FINDER opens the Help Topics window,
but doesn't change tab to the Contents tab if current tab is 'Index' or
'Find'. <P>
Try this code: <p>
<HR><PRE>
Function L1InvokeHelpMacro(const i_strMacro: String; const i_bForceFile:
Boolean): Boolean;
Begin
if i_bForceFile then
Application.HelpCommand(HELP_FORCEFILE, 0);
Result:=Application.HelpCommand(HELP_COMMAND,
Longint(PChar(i_strMacro))); //The PChar cast not strictly necessary.
End;
</PRE>
Forces the associated help file to (be) open, and shows the 'Index' tab:
<PRE>
L1InvokeHelpMacro('Search()', True);
</PRE>
Forces the associated help file to (be) open, and shows the 'Contents' tab:
<PRE>
L1InvokeHelpMacro('Contents()', True);
</PRE>
Forces the associated help file to (be) open, and shows the 'Find' tab
(WinHelp 4 only):
<PRE>
L1InvokeHelpMacro('Find()', True);
</PRE><HR>
<P><H1><A NAME="zmisc26">Supporting Cut Copy Paste</P></A></H1>
<P><I>From: "Shejchenko Andrij" <andrij@dep01.niiit.kiev.ua></I></P>
I use following procedures. Call them when clicking correspondent menu
items. This will work with all editable controls. But you should
specially handle EDIT messages for trees. <p>
<HR><PRE>
procedure TMainForm.EditUndo(Sender: TObject);
var Mes:TWMUndo;
begin
Mes.Msg:=WM_UNDO;
Screen.ActiveControl.Dispatch(Mes);
end;
procedure TMainForm.EditCut(Sender: TObject);
var Mes:TWMCut;
begin
Mes.Msg:=WM_CUT;
Screen.ActiveControl.Dispatch(Mes);
end;
procedure TMainForm.EditCopy(Sender: TObject);
var Mes:TWMCopy;
begin
Mes.Msg:=WM_COPY;
Screen.ActiveControl.Dispatch(Mes);
end;
procedure TMainForm.EditPaste(Sender: TObject);
var Mes:TWMPaste;
begin
Mes.Msg:=WM_PASTE;
Screen.ActiveControl.Dispatch(Mes);
end;
</PRE><HR>
<H1><A NAME="zmisc27">D2: Win95 + Speaker + Sound := possible</A></H1>
<I>From: jatkins@paktel.compulink.co.uk (John Atkins)</I>
I use the following in Win95.
<HR><pre>
procedure Sound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then
begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(GetPort($61));
if (B and 3) = 0 then
begin
SetPort($61, Word(B or 3));
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, Freq shr 8);
end;
end;
procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;
procedure SetPort(address, Value:Word);
var
bValue: byte;
begin
bValue := trunc(Value and 255);
asm
mov dx, address
mov al, bValue
out dx, al
end;
end;
function GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;
</pre><hr>
<H1><A NAME="zmisc28">Multiple icons in a Delphi exe?</A></H1>
<i>From: janij@dystopia.fi (Jani J鋜vinen)</i>
<pre>
Does anyone know how to get Delphi to place mutliple icons into one
executable? ie so that when you set up a file type and browse your Delphi
compiled application you get a number of icons, not just the single one
you'd get by specifying an icon under Project|Options|Application|Icon </pre>
Just create a resource file (.res) for example with Image Editor, and
store your icons there. Then link in the resource with the $R compiler
directive, and your app has multiple icons.<p>
<p><H1><A NAME="zmisc29">Credit card verification<img src="../images/new.gif" width=28 height=11 border=0 alt=" [NEW]"></p></A></H1>
<i>From: bnear@sympatico.ca (Brian Near)</i><p>
<hr><pre>unit Creditc;
{*****************************************************************************
Credit Card Number Validator Unit for Delphi
Version: 1.1
Date: December 20, 1996
This unit is based on the public domain program ccard by Peter Miller.
It is released to the public for free of charge use, but the author
reserves all rights.
copyright 1996 by Shawn Wilson Harvell ( shawn@inet.net )
usage:
Add this unit to the uses clause of any unit that needs access to the
validation function.
IsValidCreditCardNumber( CardNumber, ReturnMessage ) returns Boolean
for example, use it in an if statement that Messages user if invalid.
CardNumber is a string containing the number that you want to validate
ReturnMessage is a string where the function can place any messages it
may return ( meaning that it will overwrite whatever is in it )
returns true if valid, false otherwise.
dashes and space in the input value are taken care of by the function,
if other characters are possible, you may wish to remove them as well.
The function RemoveChar will take care of this quite easily, simply
pass the input string and the char you wish to delete.
Users are free to modify this unit for their own use, but in
distributing you should advise all users of the changes made.
Use this unit at your own risk, it does not come with any warranties
either express or implied. Damages resulting from the use of this
unit are the sole responsibility of the user.
This should work as is for Delphi versions 1 and 2, some slight
modifications may be necessary for Turbo Pascal ( mainly due to use to
conversion functions from the SysUtils unit ).
If you do find this useful, have any comments or suggestions, please
drop the author an email at shawn@inet.net
Revision History
version 1.1 -- December 20, 1996
blooper with Discover cards, added their length mask to the "database"
version 1.0 -- October 26, 1996
initial release
*****************************************************************************}
interface
uses SysUtils;
function IsValidCreditCardNumber( CardNumber: String; var MessageText: String ): Boolean;
implementation
const
CardPrefixes: array[ 1..19 ] of string =
( '2014', '2149', '300', '301', '302',
'303', '304', '305', '34', '36', '37',
'38', '4', '51', '52', '53', '54', '55', '6011' );
CardTypes: array[ 1..19 ] of String =
( 'enRoute',
'enRoute',
'Diner Club/Carte Blanche',
'Diner Club/Carte Blanche',
'Diner Club/Carte Blanche',
'Diner Club/Carte Blanche',
'Diner Club/Carte Blanche',
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -