SAPI with Dephi: Async speech doesn't work - delphi

The following works perfectly (Delphi 7):
procedure TMainForm.SayIt(s:string); // s is the string to be spoken
var
voice: OLEVariant;
begin
memo1.setfocus;
voice := CreateOLEObject ('SAPI.SpVoice');
voice.Voice := voice.GetVoices.Item(combobox1.ItemIndex); // current voice selected
voice.volume := tbVolume.position;
voice.rate := tbRate.position;
voice.Speak (s, SVSFDefault);
end;
The above works in "sync" mode (SVSFDefault flag), but if I change the flag to SVSFlagsAsync in an attempt to play the sound in async mode, no soud is produced. No error messages are given, but nothing is played on the speakers.
What might the problem be? I have the SpeechLib_TLB unit in Delphi's Imports folder.
EDIT: This is in Windows XP
Thanks,
Bruno.

When you uses the SVSFlagsAsync flag, the voice stream is queued in an internal buffer and stay waiting to be executed by the speech service, So I think which you issue is related to the lifetime of the voice object, because is a local variable , the instance is destroyed before to execute the sound.
As workaround you can wait for the sound, using the WaitUntilDone method
voice.Speak (s, SVSFlagsAsync);
repeat Sleep(100); until voice.WaitUntilDone(10);
or declare the voice variable in you form definition.
TMainForm = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
voice: OLEVariant;
procedure SayIt(const s:string);
end;
var
MainForm: TMainForm;
implementation
uses
ComObj;
{$R *.dfm}
procedure TMainForm.SayIt(const s:string); // s is the string to be spoken
const
SVSFDefault = 0;
SVSFlagsAsync = 1;
SVSFPurgeBeforeSpeak= 2;
begin
memo1.setfocus;
voice.Voice := voice.GetVoices.Item(combobox1.ItemIndex); // current voice selected
voice.volume := tbVolume.position;
voice.rate := tbRate.position;
voice.Speak (s, SVSFlagsAsync {or SVSFPurgeBeforeSpeak});
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
SayIt('Hello');
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
voice := CreateOLEObject('SAPI.SpVoice');
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
voice := Unassigned;
end;
end.
As additional note, since you are using late binding you don't need the SpeechLib_TLB unit.

Related

What is supposed to be a simple TCP Client Server,, STUCK

I am stuck. I have previously used the server and client sockets (non-indy) and they were nicely asynchronous and easy to use. I am trying to make a simple client server. Once connected to a client the server sends out small blocks of data on a timer event. The time is 77ms and the blocks of data are approximately 100 bytes.
I have tried my best to figure out indy from bits here and there and people's examples. (Obviously there wouldn't be so much about it on the web if people could get it working quickly). Below I extracted the relevant sections from my client and server.
I have the ip set to localhost and i am trying to first debug the server side. I start the client, I start the server in the debugger. the client connects and I can put a break point at the onconnect event and the program goes there. Now what is supposed to happen is the timer is enabled and then every time it trips I send my block of data. (this doesn't happen at least in the debugger)
The compiler forced me to add an onexecute event for the server and I don't know what to do with it now. I tried a blank event and I tried a dummy readln.
On the Client side. I copied a read thread from elsewhere once there is a connection it is supposed to start and read the data blocks as they occur. Right now I am not doing any error checking or automatic detection of loss of connection and attempted re-connection.
I would certainly appreciate any help , both in getting this working and also in hints on how to handle the corner cases.
thanks
robert
Server side this is supposed to send a block of data every 77 ms
....................................................................................
type
TForm8 = class(TForm)
SendButton: TButton;
SendWaveFormTimer: TTimer;
IdUDPClient1: TIdUDPClient;
IdTCPServer1: TIdTCPServer;
procedure SendWaveFormTimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
connectedto:TIdContext;
{ Private declarations }
public
{ Public declarations }
end;
var
Form8: TForm8;
procedure TForm8.IdTCPServer1Connect(AContext: TIdContext);
// this is not in the main ui thread and can't call showmessage
begin
connectedto:=acontext; // save the connected TIDcontext for use elsewhere?
self.SendWaveFormTimer.Enabled:=true; {set the send timer}
end;
procedure TForm8.SendWaveFormTimerTimer(Sender: TObject);
var tempbyte:tidbytes;
begin
tempbyte:=RawToBytes(WaveFormSample,sizeof(TWaveFormSample));
form8.connectedto.Connection.IOHandler.Write(tempbyte, sizeof(TWaveFormSample));
end;
procedure TForm8.IdTCPServer1Execute(AContext: TIdContext);
// again this in second thread
var recv:string;
begin
//I don't know what to put here I am not expecting anything right now
recv := AContext.Connection.Socket.ReadLn;
end;
Client Side
type
TForm3 = class(TForm)
IdUDPServer1: TIdUDPServer;
Label1: TLabel;
IdTCPClient1: TIdTCPClient;
Button1: TButton;
procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TReadingThread = class(TThread)
protected
FConn: TIdTCPConnection;
procedure Execute; override;
public
constructor Create(ACon: TIdTCPConnection); reintroduce;
end;
type
TMyNotify = class(TidNotify)
private
recvd_block:TWaveFormSample;
protected
procedure DoNotify; override;
end;
var
Form3: TForm3;
Udp_message_ID:tmessageid;
UDp_WaveFormSample:twaveformsample;
ReadingThread: TReadingThread = nil;
implementation
constructor TReadingThread.Create(ACon: TIdTCPConnection);
begin
FConn := ACon;
inherited Create(False);
end;
procedure TForm3.IdTCPClient1Connected(Sender: TObject);
begin
readingthread.Create(IdTCPClient1);
readingthread.execute; //this must be wrong
end;
procedure tform3.Button1Click(Sender: TObject);
begin
IdTCPClient1.Connect; //this works on the other end
end;
procedure TReadingThread.Execute;
var
TCP_TWaveFormSample:twaveformsample;
AData: TIdBytes;
data_rdy:boolean;
MyNotify: TMyNotify;
begin
MyNotify := TMyNotify.Create;
MyNotify.Notify;
data_rdy:=false;
while not Terminated do
begin
FConn.IOHandler.CheckForDataOnSource(1000);
FConn.IOHandler.CheckForDisconnect;
if not FConn.IOHandler.InputBufferIsEmpty and not data_rdy then
begin
fconn.iohandler.ReadBytes(Adata,sizeof(TWaveFormSample));
Idglobal.BytesToRaw(AData, TCP_message_ID, sizeof(tmessageid)); //global load
Idglobal.BytesToRaw(AData, TCP_TWaveFormSample, sizeof(twaveformsample));
data_rdy:=true;
end; // data
If not Drawing and data_rdy then //make sure the other thread can take it
begin
MyNotify.recvd_block :=Udp_TWaveFormSample;
MyNotify.Notify;
data_rdy:=false;
end;
end;
end ;
procedure TMyNotify.DoNotify;
begin
waveformunit.writenewdata (recvd_block.WaveformIndex,recvd_block.WaveformData,
samples_per_send);
drawing:=false;
end;
TIdTCPServer is a multi-threaded component. Its events are fired in worker threads. Your timer does not work because TTimer is a message-based timer and there is no message loop in those threads to service it.
You are supposed to do your I/O work with the client in the server's OnExecute event, which is fired in the thread that manages the client connection, not in the main UI thread.
Everything you have shown on the server side is all wrong. Try something more like this:
interface
...
type
TForm8 = class(TForm)
IdTCPServer1: TIdTCPServer;
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form8: TForm8;
implementation
type
TMyContext = class(TIdServerContext)
LastSend: TIdTicks;
end;
procedure TForm8.FormCreate(Sender: TObject);
begin
IdTCPServer1.ContextClass := TMyContext;
end;
procedure TForm8.IdTCPServer1Connect(AContext: TIdContext);
begin
TMyConext(AContext).LastSend := Ticks64;
end;
procedure TForm8.IdTCPServer1Execute(AContext: TIdContext);
var
Ctx: TMyContext;
temp: TIdBytes;
begin
Ctx := TMyContext(AContext);
if GetElapsedTicks(Ctx.LastSend) >= 77 then
begin
// grab the latest sample and send it...
temp := RawToBytes(Waveformsample, sizeof(TWaveFormSample));
AContext.Connection.IOHandler.Write(temp);
Ctx.LastSend := Ticks64;
end;
// in case the client sends something, just ignore it for now...
AContext.Connection.IOHandler.InputBuffer.Clear;
Sleep(0);
end;
That being said, since your server is expecting only 1 client, you might consider using TIdSimpleServer instead, which is not multi-threaded at all, so you can run it from the main UI thread if you want to. But if you want to service multiple clients, stick with TIdTCPServer.
On the client side, everything you have shown is also all wrong. You are misusing TThread, the IOHandler, and TIdNotify. Try something more like this:
interface
...
type
TForm3 = class(TForm)
IdTCPClient1: TIdTCPClient;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
type
TReadingThread = class(TThread)
protected
FConn: TIdTCPConnection;
procedure Execute; override;
public
constructor Create(ACon: TIdTCPConnection); reintroduce;
end;
TMyNotify = class(TIdNotify)
private
recvd_block: TWaveFormSample;
protected
procedure DoNotify; override;
end;
var
ReadingThread: TReadingThread = nil;
constructor TReadingThread.Create(ACon: TIdTCPConnection);
begin
FConn := ACon;
inherited Create(False);
end;
procedure TForm3.IdTCPClient1Connected(Sender: TObject);
begin
ReadingThread := TReadingThread.Create(IdTCPClient1);
end;
procedure Tform3.Button1Click(Sender: TObject);
begin
IdTCPClient1.Connect;
end;
procedure TReadingThread.Execute;
var
WaveFormSample: TWaveFormSample;
AData: TIdBytes;
MyNotify: TMyNotify;
begin
while not Terminated do
begin
FConn.IOHandler.ReadBytes(AData, sizeof(TWaveFormSample), False);
BytesToRaw(AData, WaveFormSample, sizeof(TWaveFormSample));
MyNotify := TMyNotify.Create;
MyNotify.recvd_block := WaveFormSample;
MyNotify.Notify;
end;
end;
procedure TMyNotify.DoNotify;
begin
// use recvd_block as needed...
end;

Delphi 2007: save only the breakpoint options in the DSK file?

Is it possible in Delphi to just save the breakpointss in the .DSK file for a project and no other Desktop settings?
Most of the .DSK gets in the way, but not being able to save debug breakpoints is a real pain (especially when they are conditionally or actions are attached).
I've never come across an IDE facility to save only the breakpoint-related settings in the .Dsk file.
For amusement, I thought I'd try and implement something via an IDE add-in using OTA notifications. The code below runs fine installed into a package installed in D7, and the IDE seems quite happy to re-open a project whose .Dsk file has been processed by it (and the breakpoints get set!).
As you can see, it catches an OTA notifier's FileNotification event when called with a NotifyCode of ofnProjectDesktopSave, which happens just after the IDE has saved the .Dsk file (initially with the extension '.$$$', which I faile to notice when first writing this). It then reads the saved file file, and and prepares an updated version from which all except a specified list of sections are removed. The user then has the option to save the thinned-out file back to disk. I've used a TMemIniFile to do most of the processing simply to minimize the amount of code needed.
I had zero experience of writing an OTA notifier when I read your q, but the GE Experts FAQ referenced below was immensely helpful, esp the example notifier code.
Normally, deleting a project's .Dsk file is harmless, but use this code with caution as it has not been stress-tested.
Update: I noticed that the filename received by TIdeNotifier.FileNotification event actually has an extension of '.$$$'. I'm not quite sure why that should be, but seemingly the event is called before the file is renamed to xxx.Dsk. I thought that would require a change to how
to save the thinned-out version, but evidently not.
Update#2: Having used a folder-monitoring utility to see what actually happens, it turns out that the desktop-save notification the code receives is only the first of a number of operations related to the .Dsk file. These include renaming any existing version of the .Dsk file as a .~Dsk file and finally saving the .$$$ file as the new .Dsk file.
unit DskFilesu;
interface
{$define ForDPK} // undefine to test in regular app
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, IniFiles, TypInfo
{$ifdef ForDPK}
, ToolsApi
{$endif}
;
{$ifdef ForDPK}
{
Code for OTA TIdeNotifier adapted from, and courtesy of, the link on http://www.gexperts.org/open-tools-api-faq/#idenotifier
}
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
{$endif}
type
TDskForm = class(TForm)
edDskFileName: TEdit;
SpeedButton1: TSpeedButton;
OpenDialog1: TOpenDialog;
lbSectionsToKeep: TListBox;
lbDskSections: TListBox;
moDskFile: TMemo;
btnSave: TButton;
procedure btnSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
procedure GetSectionsToKeep;
function GetDskFileName: String;
procedure SetDskFileName(const Value: String);
function GetDskFile: Boolean;
protected
public
DskIni : TMemIniFile;
property DskFileName : String read GetDskFileName write SetDskFileName;
end;
var
NotifierIndex: Integer;
DskForm: TDskForm;
{$ifdef ForDPK}
procedure Register;
{$endif}
implementation
{$R *.DFM}
{$ifdef ForDPK}
procedure Register;
var
Services: IOTAServices;
begin
Services := BorlandIDEServices as IOTAServices;
Assert(Assigned(Services), 'IOTAServices not available');
NotifierIndex := Services.AddNotifier(TIdeNotifier.Create);
end;
{$endif}
procedure DskPopUp(FileName : String);
var
F : TDskForm;
begin
F := TDskForm.Create(Application);
try
F.DskFileName := FileName;
F.ShowModal;
finally
F.Free;
end;
end;
function TDskForm.GetDskFileName: String;
begin
Result := edDskFileName.Text;
end;
procedure TDskForm.SetDskFileName(const Value: String);
begin
edDskFileName.Text := Value;
if Assigned(DskIni) then
FreeAndNil(DskIni);
btnSave.Enabled := False;
DskIni := TMemIniFile.Create(DskFileName);
DskIni.ReadSections(lbDskSections.Items);
GetSectionsToKeep;
end;
procedure TDskForm.btnSaveClick(Sender: TObject);
begin
DskIni.UpdateFile;
end;
procedure TDskForm.FormCreate(Sender: TObject);
begin
lbSectionsToKeep.Items.Add('watches');
lbSectionsToKeep.Items.Add('breakpoints');
lbSectionsToKeep.Items.Add('addressbreakpoints');
if not IsLibrary then
DskFileName := ChangeFileExt(Application.ExeName, '.Dsk');
end;
procedure TDskForm.GetSectionsToKeep;
var
i,
Index : Integer;
SectionName : String;
begin
moDskFile.Lines.Clear;
for i := lbDskSections.Items.Count - 1 downto 0 do begin
SectionName := lbDskSections.Items[i];
Index := lbSectionsToKeep.Items.IndexOf(SectionName);
if Index < 0 then
DskIni.EraseSection(SectionName);
end;
DskIni.GetStrings(moDskFile.Lines);
btnSave.Enabled := True;
end;
function TDskForm.GetDskFile: Boolean;
begin
OpenDialog1.FileName := DskFileName;
Result := OpenDialog1.Execute;
if Result then
DskFileName := OpenDialog1.FileName;
end;
procedure TDskForm.SpeedButton1Click(Sender: TObject);
begin
GetDskFile;
end;
{$ifdef ForDPK}
procedure RemoveNotifier;
var
Services: IOTAServices;
begin
if NotifierIndex <> -1 then
begin
Services := BorlandIDEServices as IOTAServices;
Assert(Assigned(Services), 'IOTAServices not available');
Services.RemoveNotifier(NotifierIndex);
end;
end;
function MsgServices: IOTAMessageServices;
begin
Result := (BorlandIDEServices as IOTAMessageServices);
Assert(Result <> nil, 'IOTAMessageServices not available');
end;
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
Cancel := False;
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
Cancel := False;
// Note: The FileName passed below has an extension of '.$$$'
if NotifyCode = ofnProjectDesktopSave then
DskPopup(FileName);
end;
initialization
finalization
RemoveNotifier;
{$endif}
end.

delphi Form with multi instance use

i've an FTP uploader project that uses a form created on run time to start uploading to multiple FTP Servers ( using Indy ) , my issue is as follows ( and i really need your help ) .
On a Form i put an IdFTP Component + an Upload button + public properties named FTPSrvAdrs and SrcFile + TrgFolder like this way :
type
TFtpUploader = class(TForm)
IdFTP: TIdFTP;
StartUpload:TButton;
UploadProgress:TProgressBar;
procedure StartUploadClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FFtpSrvAdrs:String;
FSrcFile:String;
FTargetFtpFld:String;
Procedure StartMyUpload();
procedure SetFtpAdrs(const value:string);
procedure SetSrcFile(const value:string);
procedure SetTargetFtpFld(const value:string);
{ Private declarations }
public
{ Public declarations }
property FtpAdrs:string read FFtpSrvAdrs write SetFtpAdrs;
property SourceFile:string read FSrcFile write SetSrcFile;
property TargetFtpFld:string read FTargetFtpFld write SetTargetFtpFld;
end;
var
FtpUploader: TFtpUploader;
implementation
procedure TFtpUploader.StartUploadClick(Sender: TObject);
begin
StartMyUpload();
end;
procedure TFtpUploader.SetFtpAdrs(const value: string);
begin
FFtpSrvAdrs:=value;
end;
procedure TFtpUploader.SetSrcFile(const value: string);
begin
FSrcFile:=value;
end;
procedure TFtpUploader.SetTargetFtpFld(const value: string);
begin
FTargetFtpFld:=value;
end;
procedure TFtpUploader.StartMyUpload;
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
end;
IdFTP.Connect(true, 1200)
IdFTP.Passive:= true;
IdFTP.ChangeDir(FTargetFtpFld)
IdFTP.Put(ftpUpStream,FSrcFile, false);
finally
ftpUpStream.Free;
end;
end;
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;
This Form will be created on RunTime ( 4 times = 4 buttons will launch it separately like this way :
in the main form i've this procedure :
Procedure MainForm.UploadTo(FTPSrv,SrcFile,FtpTargetFld:String);
var
FUploadFrm:TFtpUploader;
begin
FUploadFrm:=TFtpUploader.Create(nil);
if assigned(FUploadFrm) then
begin
FUploadFrm.FtpAdrs:=FTPSrv;
FUploadFrm.SourceFile:=SrcFile;
FUploadFrm.TargetFtpFld:=FtpTargetFld;
FUploadFrm.Show;
end;
end;
procedure MainForm.Button1Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_1','MySrcFile_1','MyFtpTargetFld_1');
end;
procedure MainForm.Button2Click(Sender: TObject);
begin
UploadTo('MyFtpSrv_2','MySrcFile_2','MyFtpTargetFld_2');
end;
// same with other 2 buttons
the FtpUploader form is Created / Opened ( 4 instances ) ,The ISSUE IS when i click on StartUpload button the FTP upload process is not started on all these 4 instances , but i've to wait each upload process is done ( finished ) and the other will auto-start , that means not all upload processes are started in same time .
Thank you .
It seems you have to either change Indy library for some non-blocking in-background library (event based or completion port based), or to make your program multi-threading (with it's own bunch of problems like user clicking a button 20 times or closing the form while the process is going, or even closing the program on the run).
Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it can look anything like this:
TFtpUploader = class(TForm)
private
CanCloseNow: boolean;
...
procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Self.CanCloseNow
then Action := caFree
else Action := caIgnore;
end;
procedure TFtpUploader.MyUploadComplete;
begin
Self.CanCloseNow := True;
Self.Close;
end;
procedure TFtpUploader.StartMyUpload;
begin
Self.CanCloseNow := false;
Self.Enabled := False;
Self.Visible := True;
Application.ProcessMessages;
Parallel.Async(
procedure
var
FtpUpStream: TFileStream;
begin
ftpUpStream:= TFileStream.create(FSrcFile, fmopenread)
try
with IdFTP do begin
Host:= FFtpSrvAdrs;
Username:='MyUserName';
Password:='MyPassword';
Connect(true, 1200)
Passive:= true;
ChangeDir(FTargetFtpFld)
// this does not return until uploaded
// thus would not give Delphi a chance to process buttons
// pressed on other forms.
Put(ftpUpStream,FSrcFile, false);
end;
finally
ftpUpStream.Free;
end;
end
,
Parallel.TaskConfig.OnTerminated(
procedure (const task: IOmniTaskControl)
begin
MyUploadComplete;
end;
);
end;
Or you can use simplier AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/

Drag and Drop files to Delphi form not working

I've tried to accept files that are dragged and dropped to a Form from the File Explorer but it doesn't work. My WM_DROPFILES handler is never called. I'm running Windows 8 if that makes any difference.
Here's a simple example of what I do (I just have a TMemo on the form):
type
TForm1 = class(TForm)
Memo1: TMemo;
private
{ Private declarations }
procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES;
procedure CreateWnd; override;
procedure DestroyWnd; override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, True);
end;
procedure TForm1.DestroyWnd;
begin
inherited;
DragAcceptFiles(Handle, false);
end;
procedure TForm1.WMDROPFILES(var msg: TWMDropFiles);
var
i, fileCount: integer;
fileName: array[0..MAX_PATH] of char;
begin
fileCount:=DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAX_PATH);
for i := 0 to fileCount - 1 do
begin
DragQueryFile(msg.Drop, i, fileName, MAX_PATH);
Memo1.Lines.Add(fileName);
end;
DragFinish(msg.Drop);
end;
Most likely you are running your application elevated. Probably because you are running Delphi elevated. In Vista and later, low privilege processes cannot send messages to higher privilege processes. This MSDN blog explains more.
If you are running your Delphi IDE elevated, I urge you to stop doing so. There's very seldom a need to do so for standard desktop application development.
As Remy points out, your DestroyWnd is incorrect. You are destroying the window handle before calling DragAcceptFiles. Simply reverse the order. Personally I'd use WindowHandle in both CreateWnd and DestroyWnd. The Handle property creates the window handle if it is not assigned and so masks such errors.
procedure TForm1.CreateWnd;
begin
inherited;
DragAcceptFiles(WindowHandle, True);
end;
procedure TForm1.DestroyWnd;
begin
DragAcceptFiles(WindowHandle, false);
inherited;
end;

Frames and Browse History in Delphi

I am currently developing a delphi application that will need a browse history and am trying to work out how exactly to implement this.
The application has 2 modes. Browse and Details. Both designed as Frames.
After a search an appropriate number of Browse Frames are created in Panel 1 and populated.
From a Browse Frame we can either open the Detail Frame, replacing the contents of Panel 1 with the contents of the Detail Frame. Alternatively a new search can be spawned, replacing the current set of results with a new set.
From the Detail Frame we can either edit details, or spawn new searches. Certain searches are only available from the Detail Frame. Others from either the Browse Frames or the Detail Frame.
Each time a user displays the Detail Frame, or spawns a new search I want to record that action and be able to repeat it. Other actions like edits or "more details" won't be recorded. (Obviously if a user goes back a few steps then heads down a different search path this will start the history fresh from this point)
In my mind I want to record the procedure calls that were made in a list e.g.
SearchByName(Search.Text);
SearchByName(ArchName.Text);
DisplayDetails(JobID);
SearchByName(EngineerName.Text);
DisplayDetails(JobID);
Then I can just (somehow) call each item in order as I go bak and forward...
In response to Dan Kelly's request to store the function:
However what I still can't see is how I call the stored function -
What you are referring to is storing a method handler. The code below demonstrates this. But, as you indicated your self, you could do a big if..then or case statement.
This all will works. But an even more "eloquent" way of doing all this is to store object pointers. For example, if a search opens another search, you pass a pointer of the first to the 2nd. Then in the 2nd if you want to refer back to it, you have a pointer to it (first check that it is not nil/free). This is a much more object oriented approach and would lend itself better to situations where someone might close one of the frames out of sequence.
unit searchit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TSearchObject = class
FSearchValue: String;
FOnEventClick: TNotifyEvent;
constructor Create(mSearchValue: string; mOnEventClick: TNotifyEvent);
procedure FireItsEvent;
end;
type
TForm1 = class(TForm)
SearchByName: TButton;
GoBack: TButton;
DisplayDetails: TButton;
searchfield: TEdit;
jobid: TEdit;
procedure FormCreate(Sender: TObject);
procedure SearchByNameClick(Sender: TObject);
procedure GoBackClick(Sender: TObject);
procedure DisplayDetailsClick(Sender: TObject);
private
{ Private declarations }
SearchObjectsList: TStringList;
procedure DisplayDetailFunction(Sender: TObject);
procedure SearchByNameFunction(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
constructor TSearchObject.Create(mSearchValue: string;mOnEventClick: TNotifyEvent);
begin
FOnEventClick := mOnEventClick;
FSearchValue := mSearchValue;
end;
{$R *.dfm}
procedure TSearchObject.FireItsEvent;
begin
if Assigned(FOnEventClick) then
FOnEventClick(self);
end;
procedure TForm1.SearchByNameClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject.Create(SearchField.Text,SearchByNameFunction);
SearchObjectsList.AddObject(SearchField.Text,mSearchObject);
end;
procedure TForm1.DisplayDetailFunction(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject(Sender);
ShowMessage('This is the Display Detail Event. The value of the JobID is '+mSearchObject.FSearchValue);
end;
procedure TForm1.SearchByNameFunction(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject(Sender);
ShowMessage('This is the SearchByName Event. The value of the Search Field is '+mSearchObject.FSearchValue);
end;
procedure TForm1.DisplayDetailsClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject.Create(jobid.text,DisplayDetailFunction);
SearchObjectsList.AddObject(jobid.text,mSearchObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SearchObjectsList := TStringList.Create;
end;
procedure TForm1.GoBackClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
if SearchObjectsList.count=0 then
showmessage('Cannot go Back!')
else begin
mSearchObject := TSearchObject(SearchObjectsList.Objects[SearchObjectsList.count-1]);
mSearchObject.FireItsEvent;
SearchObjectsList.Delete(SearchObjectsList.count-1);
end;
end;
end.
Keep track of everything in a TStringList; when they go "Back" you delete from the string list. This is a sort of prototype:
type
TSearchObject = class
FSearchFunction,FSearchValue: String;
constructor Create(mSearchFunction,mSearchValue: string);
end;
type
TForm1 = class(TForm)
SearchByName: TButton;
GoBack: TButton;
DisplayDetails: TButton;
searchfield: TEdit;
procedure FormCreate(Sender: TObject);
procedure SearchByNameClick(Sender: TObject);
procedure GoBackClick(Sender: TObject);
procedure DisplayDetailsClick(Sender: TObject);
private
{ Private declarations }
SearchObjectsList: TStringList;
jobid: String; //not sure how you get this
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
constructor TSearchObject.Create(mSearchFunction,mSearchValue: string);
begin
FSearchFunction := mSearchFunction;
FSearchValue := mSearchValue;
end;
{$R *.dfm}
procedure TForm1.SearchByNameClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject.Create('SearchByName',SearchField.Text);
SearchObjectsList.AddObject(SearchField.Text,mSearchObject);
end;
procedure TForm1.DisplayDetailsClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
mSearchObject := TSearchObject.Create('DisplayDetails',JobID);
SearchObjectsList.AddObject(JobId,mSearchObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SearchObjectsList := TStringList.Create;
end;
procedure TForm1.GoBackClick(Sender: TObject);
var
mSearchObject: TSearchObject;
begin
if SearchObjectsList.count=0 then
showmessage('Cannot go Back!')
else begin
mSearchObject := TSearchObject(SearchObjectsList.Objects[SearchObjectsList.count-1]);
if mSearchObject.FSearchFunction ='SearchByName' then
ShowMessage('Value of Search Field:'+mSearchObject.FSearchValue)
else
ShowMessage('Value of JobID:'+mSearchObject.FSearchValue);
SearchObjectsList.Delete(SearchObjectsList.count-1);
end;
end;
Another option would be to use my wizard framework, which does this with TForms but can easily also be adjusted to use frames. The concept is that each summary form knows how to create its appropriate details. In your case the framework is more of an example of how to do it, rather than a plug and play solution.
Complementing MSchenkel answer.
To persist the list between program runs, use an ini file.
Here is the idea. You have to adapt it. Specially, you have to figure out the way to convert object to string and string to object, sketched here as ObjectToString(), StringToStringID and StringToObject().
At OnClose event, write the list out to the ini file.
const
IniFileName = 'MYPROG.INI';
MaxPersistedObjects = 10;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
ini: TIniFile;
i: integer;
cnt: integer;
begin
ini:=TIniFile.Create(iniFileName);
cnt:=SearchObjectsList.Count;
if cnt>MaxPersistedObjects then
cnt:=MaxPersistedObjects;
for i:=1 to MaxPersistedObjects do
if i>cnt then
ini.WriteString('SearchObjects','SearchObject'+intToStr(i),'');
else
ini.WriteString('SearchObjects','SearchObject'+intToStr(i),
ObjectToString(SearchObjectsList[i-1],SearchObjectsList.Objects[i-1]) );
ini.Free;
end;
and read it back at OnCreate event.
procedure TForm1.FormCreate(Sender: TObject);
var
ini: TIniFile;
i: integer;
begin
SearchObjectsList := TStringList.Create;
ini:=TIniFile.Create(IniFileName);
for i:=1 to MaxPersistedObjects do
begin
s:=ini.ReadString('SearchObjects','SearchObject'+intToStr(i),'');
if s<>'' then
SearchObjectsList.AddObject(StringToID(s),StringToObject(s));
end;
ini.Free;
end;

Resources