Version: 2006-09-16
First maintainer: Esther Michaels
Current maintainer: Maarten Wiltink (Evil miniFAQ Boss)
//uses ShellAPI;
procedure RunAProgram (const theProgram, itsParameters, defaultDirectory: string);
var
rslt: integer;
msg: string;
begin
rslt := ShellExecute(0, 'open',
pChar (theProgram),
pChar (itsParameters),
pChar (defaultDirectory),
sw_ShowNormal);
if rslt <= 32 then
begin
case rslt of
0,
se_err_OOM:
msg := 'Out of memory/resources';
error_File_Not_Found:
msg := 'File "' + theProgram + '" not found';
error_Path_Not_Found:
msg := 'Path not found';
error_Bad_Format:
msg := 'Damaged or invalid exe';
se_err_AccessDenied:
msg := 'Access denied';
se_err_NoAssoc,
se_err_AssocIncomplete:
msg := 'Filename association invalid';
se_err_DDEBusy,
se_err_DDEFail,
se_err_DDETimeOut:
msg := 'DDE error';
se_err_Share:
msg := 'Sharing violation';
else
msg := 'no text';
end;
raise Exception.Create('ShellExecute error #' + IntToStr (rslt) + ': ' + msg);
end;
end;
The datatype of ProcInfo changed between Delphi3 and Delphi4.
| Code for Delphi4 and up: | Code for Delphi3: |
|---|---|
// uses Windows, SysUtils
procedure ProgramRunWait(const CommandLine,
DefaultDirectory: string;
Wait: boolean);
var
StartUpInfo: TStartUpInfo;
ProcInfo: Process_Information;
Dir, Msg: PChar;
ErrNo: integer;
E: Exception;
begin
FillChar(StartUpInfo, SizeOf(StartUpInfo), 0);
StartUpInfo.cb := SizeOf(StartUpInfo);
if DefaultDirectory <> '' then
Dir := PChar(DefaultDirectory)
else
Dir := nil;
if CreateProcess(nil,
PChar(CommandLine),
nil,
nil,
False,
0,
nil,
Dir,
StartUpInfo,
ProcInfo) then
begin
try
if Wait then
WaitForSingleObject(ProcInfo.hProcess,
INFINITE);
finally
CloseHandle(ProcInfo.hThread);
CloseHandle(ProcInfo.hProcess);
end;
end
else
begin
ErrNo := GetLastError;
Msg := AllocMem(4096);
try
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
nil,
ErrNo,
0,
Msg,
4096,
nil);
E := Exception.Create('Create Process Error #'
+ IntToStr(ErrNo)
+ ': '
+ string(Msg));
finally
FreeMem(Msg);
end;
raise E;
end;
end;
|
// uses Windows, SysUtils
procedure ProgramRunWait(const CommandLine,
DefaultDirectory: string;
Wait: boolean);
var
StartUpInfo: TStartUpInfo;
ProcInfo: TProcessInformation;
Dir, Msg: PChar;
ErrNo: integer;
E: Exception;
begin
FillChar(StartUpInfo, SizeOf(StartUpInfo), 0);
StartUpInfo.cb := SizeOf(StartUpInfo);
if DefaultDirectory <> '' then
Dir := PChar(DefaultDirectory)
else
Dir := nil;
if CreateProcess(nil,
PChar(CommandLine),
nil,
nil,
False,
0,
nil,
Dir,
StartUpInfo,
ProcInfo) then
begin
try
if Wait then
WaitForSingleObject(ProcInfo.hProcess,
INFINITE);
finally
CloseHandle(ProcInfo.hThread);
CloseHandle(ProcInfo.hProcess);
end;
end
else
begin
ErrNo := GetLastError;
Msg := AllocMem(4096);
try
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
nil,
ErrNo,
0,
Msg,
4096,
nil);
E := Exception.Create('Create Process Error #'
+ IntToStr(ErrNo)
+ ': '
+ string(Msg));
finally
FreeMem(Msg);
end;
raise E;
end;
end;
|
This code belongs the in the dpr file of your project, i.e. your main program.
// uses Windows, SysUtils
var hMyMutex : tHandle;
begin
hMyMutex := CreateMutex
(nil,
False,
pChar(Uppercase(ExtractFileName(Application.ExeName)+'_2nd_instance_lockout'))
);
if (hMyMutex <> Null) then
begin
try
if (GetLastError <> error_Already_Exists) then
begin
// the code maintained by Delphi
Application.Initialize;
. . .
Application.Run;
// end of code maintained by Delphi
end
finally
CloseHandle (hMyMutex);
end
end;
else ShowMessage ('CreateMutex returned error code ' + IntToStr(GetLastError));
end;
List box example, set ListBox.Style to lbOwnerDrawFixed
- every second line is shaded, and selected entry is not highlighted
when control loses focus
procedure tForm1.ListBox1DrawItem(Control : TWinControl;
Index : Integer;
Rect : TRect;
State : TOwnerDrawState);
var
frameIt : boolean;
begin
with (Control as tListBox), Canvas do
begin
Font.Assign (tListBox (Control).Font);
Font.Style := [];
Brush.Color := tListBox (Control).Color;
frameIt := False;
if ([odInactive, odDisabled, odGrayed] * State) <> []
then font.Color := clGrayText
else begin
frameIt := odSelected in State;
if frameIt and Focused
then begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end
else begin
if Odd (Index)
then Brush.Color := clBtnFace;
end;
end;
FillRect (Rect);
TextOut (Rect.Left, Rect.Top, Items [Index]);
if frameIt
then begin
if Focused
then begin
Pen.Style := psDot;
Pen.Mode := pmCopy;
Pen.Color := clWindowText;
FrameRect (Rect);
end
else DrawFocusRect (Rect);
end;
end;
end;
Runtime access to all the fields of the Project Options -> VersionInfo tab.
Download component
containing this code (kindly contributed by Daniel Rutten).
To use this component, drop it on a form and create 10 edit boxes (named Edit1 through Edit10). In the FormCreate method, put the following. The fields of the component have the same names as the fields of the Version Info tab in Delphi.
procedure TForm1.FormCreate(Sender: TObject); begin Edit1.Text := VersionInfo1.CompanyName; Edit2.Text := VersionInfo1.FileDescription; Edit3.Text := VersionInfo1.FileVersion; Edit4.Text := VersionInfo1.InternalName; Edit5.Text := VersionInfo1.LegalCopyright; Edit6.Text := VersionInfo1.LegalTradeMarks; Edit7.Text := VersionInfo1.OriginalFilename; Edit8.Text := VersionInfo1.ProductName; Edit9.Text := VersionInfo1.ProductVersion; Edit10.Text := VersionInfo1.Comments; end;
(There is no need to call VersionInfo1.Execute unless you want version info from a different file than the one the component belongs to.)
This help file introduces the reader to the use of streams. (Kindly contributed by Alan Lloyd.)
Make a form, add a button called CreateButton, give it an OnClick handler and copy the following code into it:
procedure TForm1.CreateButtonClick(Sender: TObject);
begin
if not Assigned(RuntimeButton1) then
begin
RuntimeButton1 := TButton.Create(Self);
RuntimeButton1.Parent := Form1;
RuntimeButton1.Top := CreateButton.Top + 32;
RuntimeButton1.Left := CreateButton.Left;
RuntimeButton1.Caption := 'Press me!';
RuntimeButton1.OnClick := RuntimeButtonClick;
end
else if not Assigned(RuntimeButton2) then
begin
RuntimeButton2 := TButton.Create(Self);
RuntimeButton2.Parent := Form1;
RuntimeButton2.Top := RuntimeButton1.Top + 32;
RuntimeButton2.Left := CreateButton.Left;
RuntimeButton2.Caption := 'Press me too!';
RuntimeButton2.OnClick := RuntimeButtonClick;
end;
end;
Copy the following lines into the declaration of TForm1 (put them in the public or private sections, but not where Delphi puts the objects added at design time):
RuntimeButton1: TButton; RuntimeButton2: TButton; procedure RuntimeButtonClick(Sender: TObject);
Then copy this procedure into the implementation section:
procedure TForm1.RuntimeButtonClick(Sender: TObject);
begin
ShowMessage('A button that was created at runtime was just pressed.'
+ #13#10#13#10
+ 'The button''s caption is: "' + TButton(Sender).Caption + '"');
end;
At runtime, initially there is only one button. If you press on it then a button with caption "Press me!" is created; if you press the original button again, a second button with caption "Press me too!" is created. Pressing the runtime-created buttons produces the ShowMessage dialog, which shows the caption of the button that was pressed.
var Edit: TEdit; i: Integer;
begin
for i:=0 to Pred(ComponentCount) do begin
if (Components[i] is TEdit) then begin { Only do TEdits }
Edit:=TEdit(Components[i]);
case Edit.Tag of { Tag values are set in the Object Inspector }
1: Edit.Color:=clRed;
2: Edit.Color:=clYellow;
3: Edit.Color:=clBlue;
end;
end;
end;
end;