From: Stefan.Westner@stud.uni-bamberg.de (Stefan Westner)
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.
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
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;
From: choate@cswnet.com (Brad Choate)
>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.
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.
Of course, substitute "MYFONT" for the name of your font file.
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;
From: Christian Piene Gundersen <j.c.p.gundersen@jusstud.uio.no>
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
To open the CD-ROM:
mciSendString('Set cdaudio door open wait', nil, 0, handle); To close the CD-ROM:
mciSendString('Set cdaudio door closed wait', nil, 0, handle); Remember to include the MMSystem unit in your uses clause.
The Graphical Gnome <rdb@ktibv.nl>
If you have finally taken the big stap and want to go from VB to Delphi 2 there are a few things different.Borland has a page describing the differences between Delphi and VB. It can be found at
http://netserv.borland.com/delphi/papers/vb2dl/compon.html
From: canalrun@vcomm.net (Barry)
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.
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.
From: "Jarle Stabell" <jarle.stabel@dokpro.uio.no>
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'.Try this code:
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;
Forces the associated help file to (be) open, and shows the 'Index' tab:
L1InvokeHelpMacro('Search()', True);
Forces the associated help file to (be) open, and shows the 'Contents' tab:
L1InvokeHelpMacro('Contents()', True);
Forces the associated help file to (be) open, and shows the 'Find' tab
(WinHelp 4 only):
L1InvokeHelpMacro('Find()', True);
From: "Shejchenko Andrij" <andrij@dep01.niiit.kiev.ua>
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.
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;
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;
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|IconJust 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.
This page has been created with
