How to get input from keyboard while not focussed Delphi - delphi

I would like to know how to get keyboard input in my delphi application while its not focussed.
The application i am programming is going to be taking a screenshot while i am in game.
I have wrote the screen capture code but i am missing this last piece any advice would be appreciated.

You can register a hotkey (using the RegisterHotKey and UnregisterHotKey functions) and use the WM_HOTKEY message to intercept when the key is pressed.
Try this sample
type
TForm3 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
procedure WMHotKey(var Message: TMessage); message WM_HOTKEY;
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
{ TForm3 }
const
SaveScreeenHK=666;
procedure TForm3.FormCreate(Sender: TObject);
begin
RegisterHotKey(Handle, SaveScreeenHK , MOD_CONTROL, VK_F10);
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, SaveScreeenHK);
end;
procedure TForm3.WMHotKey(var Message: TMessage);
begin
//call your method here
end;

I have since been busy and created a library for getting keystrokes in delphi.
You can find it here : https://github.com/Kobusvdwalt/DelphiKeylogger
It still needs documentation but basicly you just call the olgetletter function.

Related

Why the famous workaround for closing a popup menu with Esc is not working with a private handle?

I made a component to use tray icons in my application and when the icon shows the popup menu, it can't be closed with Esc key. Then I found a workaround here, by David Heffernan. I integrate the code in my component and now the menu can be closed with Esc but after I popup the menu my application become compleately dead, I can't access anything on the main form, even the system buttons doesn't work any more.
Here is the code to reproduce the problem:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ShellApi;
const WM_ICONTRAY = WM_USER+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Test1: TMenuItem;
Test2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
IconData: TNotifyIconData;
protected
procedure PrivateWndProc(var Msg: TMessage); virtual;
public
PrivateHandle:HWND;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
PrivateHandle:=AllocateHWnd(PrivateWndProc);
// add an icon to tray
IconData.cbSize:=SizeOf(IconData);
IconData.Wnd:=PrivateHandle;
IconData.uID:=1;
IconData.uFlags:=NIF_MESSAGE + NIF_ICON;
IconData.uCallbackMessage:=WM_ICONTRAY;
IconData.hIcon:=Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, #IconData);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IconData.uFlags:=0;
Shell_NotifyIcon(NIM_DELETE, #IconData);
DeallocateHWnd(PrivateHandle);
end;
procedure TForm1.PrivateWndProc(var Msg: TMessage);
var p:TPoint;
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.LParam=WM_RBUTTONUP) then
begin
GetCursorPos(p);
SetForegroundWindow(PrivateHandle);
PopupMenu1.Popup(p.x,p.y);
PostMessage(PrivateHandle, WM_NULL, 0, 0);
end;
end;
end.
I guess you just missed to call DefWindowProc. Try this:
procedure TForm1.PrivateWndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_ICONTRAY) and (Msg.lParam = WM_RBUTTONUP) then
begin
...
end
else
Msg.Result := DefWindowProc(PrivateHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

BDE vs ADO Database Error handling

I am working on Delphi 7 + SQLserver
in BDE all database related related erros can be handled using EDatabaseError
try
//all database related operations
Except
on EDatabaseError do
begin
showmessage(e.message)
end;
End;
but in ADO i tried different examples and i am getting different errors like EOleError/EDatabaseError/...
I Tried below 2 points to raise errors in ADO and i got different errors
1) In sql server stored procedure i am raising error on first line. when i execute that procedure using TADOStoredProc in delphi i am getting EOleError.
2) In TADOQuery i have written a wrong sql statement so when i open TADOQUery i am getting EDatabaseError.
so now i am confused how to handle ADO errors. i don't want to check for all the errors(EOleError,EDatabaseError,EAdoError...) in each and every form so i have written 2 examples,
Please suggest me which one is good. if both are wrong please give me a good example.
Example 1:
Here i am showing only one form in example so Delphi Procedure HandleErrors and function GetErrorDescription may look stupid. i don't want to write same piece of
code in all the forms. When it comes to real scenario i am gonna keep Delphi Procedure HandleErrors and function GetErrorDescription on different unit and use that unit all over the application.
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Procedure HandleErrors(e: Exception );
function GetErrorDescription : WideString;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.GetErrorDescription : WideString;
var
LastErrorIndex : Integer;
begin
LastErrorIndex :=ADOConnection1.Errors.Count-1;
Result:=ADOConnection1.Errors.Item[LastErrorIndex].Description;
//Code :=ADOConnection1.Errors.Item[LastErrorIndex].NativeError;
end;
procedure TForm1.HandleErrors(e: Exception);
var
Code: Integer;
ErrorDescription: WideString ;
begin
if e is EOleError then
ShowMessage(GetErrorDescription)
else
if e is EDatabaseError then
ShowMessage(GetErrorDescription)
else
if e is EADOError then
ShowMessage(GetErrorDescription)
else
ShowMessage(GetErrorDescription)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
// any database related operations
except
on E : Exception do
begin
HandleErrors(E);
end;
end;
end;
end.
Example 2:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ADODB, StdCtrls, DB,COMOBJ;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
LastErrorIndex : Integer;
begin
try
// any database related operations
except
on E : Exception do
begin
LastErrorIndex :=ADOConnection1.Errors.Count-1;
ShowMessage(ADOConnection1.Errors.Item[LastErrorIndex].Description);
end;
end;
end;
end.
which example is better. Can you please suggest a good one
As I said in a comment, you shouldn't scatter AdoConnections and datasets across multiple forms/ Instead you should put them in a datamodule then Use the datamodule's unit in your forms' units. That way, you will be able to connect TDataSources and db-aware components on the form to the datamodule's datasets.
The other thing you can do is to install an application-wide exception handler to centralize your exception handling, if that's what you want to do. Delphi's Application object has an OnException event which you can assign to your own exception handler using code like that shown below.
A downside of an application-wide exception handler is that it can be difficult in the OnException handler to identify which of your objects is actually responsible for causing the exception.
type
TMainForm = class(TForm)
[...]
procedure FormCreate(Sender: TObject);
private
procedure ApplicationException(Sender: TObject; E: Exception);
public
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnException := ApplicationException;
end;
procedure TMainForm.ApplicationException(Sender: TObject; E: Exception);
var
AErrors : Errors;
AError : Error;
i : Integer;
S : String;
begin
Caption := 'Exception';
if E is EDatabaseError then begin
AErrors := DataModule1.AdoQuery1.Connection.Errors;
for i := 0 to AErrors.Count - 1 do begin
AError := AErrors.Item[i];
S := Format('Number: %d, NativeError: %d, source: %s, description: %s',
[AError.Number, AError.NativeError, AError.Source, AError.Description]);
Memo1.Lines.Add(S);
end;
end;
end;

How can I drag & drop a file from the shell? [duplicate]

This question already has answers here:
Cross-application drag-and-drop in Delphi
(2 answers)
Closed 8 years ago.
I am trying to drag and drop a video file (like .avi) from desktop But ı can not take it to the my program.But when ı try to drag and drop inside my program it works fine.For ex: I have an edittext and a listbox inside my pro and ı can move text that inside edittext to listbox.I could not get what is the difference ??
I take the video using openDialog.But ı wanna change it with drag and drop.
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
MediaPlayer1.DeviceType:=dtAutoSelect;
MediaPlayer1.FileName := OpenDialog1.FileName;
Label1.Caption := ExtractFileExt(MediaPlayer1.FileName);
MediaPlayer1.Open;
MediaPlayer1.Display:=Self;
MediaPlayer1.DisplayRect := Rect(panel1.Left,panel1.Top,panel1.Width,panel1.Height);
panel1.Visible:=false;
MediaPlayer1.Play;
end;
end;
Here is a simple demo how to drag&drop files from Windows Explorer into a ListBox (for Delphi XE):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
protected
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellAPI;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, False);
end;
procedure TForm1.WMDropFiles(var Msg: TMessage);
var
hDrop: THandle;
FileCount: Integer;
NameLen: Integer;
I: Integer;
S: string;
begin
hDrop:= Msg.wParam;
FileCount:= DragQueryFile (hDrop , $FFFFFFFF, nil, 0);
for I:= 0 to FileCount - 1 do begin
NameLen:= DragQueryFile(hDrop, I, nil, 0) + 1;
SetLength(S, NameLen);
DragQueryFile(hDrop, I, Pointer(S), NameLen);
Listbox1.Items.Add (S);
end;
DragFinish(hDrop);
end;
end.
You can also use DropMaster from Raize software.
You can catch the WM_DROPFILES message.
First, set that your form will "accept" files from dragging in the FormCreate procedure:
DragAcceptFiles(Self.Handle, True);
After, declare the procedure in the desired form class:
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
Finally, fill the procedure body as follows:
procedure TForm1.WMDropFiles(var Msg: TMessage);
begin
// do your job with the help of DragQueryFile function
DragFinish(Msg.WParam);
end
Alternatively, check out "The Drag and Drop Component Suite for Delphi" by Anders Melander. It works as-is with 32-bit and with some tweaking can be made to work with 64-bit as well (read the blog - it has been upgraded by 3rd parties).

In my custom component, how can I augment the mouse-enter and -leave events?

I am making a custom Panel component which derives TPanel.
I want for my new component to have some code executed on the OnMouseEnter and OnMouseLeave events, however, i do not know how to implement it.
I see that TPanel has published properties OnMouseEnter, OnMouseLeave.
How do i override those and add some of my own code?
The example of my idea:
Default behaviour of TMyPanel which should be in component itself.
on event OnMouseEnter do: Color := NewColor;
on event OnMouseLeave do: Color := OldColor;
And then, i want to be able to assign some function to these events at run time.
This assignment is done in the application.
.. TButton1.Click ..
begin
MyPanel1.OnMouseEnter := DoSomethingMore;
MyPanel1.OnMouseLeave := DoSomethingElse;
end;
so in the end, when mouse is over new panel, it should change color AND do some other actions written in DoSomethingMore procedure.
Thanks
Anoher approach is to handle the windows messages yourself:
type
TMyPanel = class(TPanel)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published
end;
implementation
{ TMyPanel }
procedure TMyPanel.CMMouseEnter(var Message: TMessage);
begin
// Do whatever your want before the event
if Assigned(OnMouseEnter) then OnMouseEnter(Self);
end;
procedure TMyPanel.CMMouseLeave(var Message: TMessage);
begin
// Do whatever your want before the event
if Assigned(OnMouseLeave) then OnMouseLeave(Self);
end;
EDIT: See below for better VCL compliant version.
If they are available, you should override DoMouseEnter and DoMouseLeave. Otherwise, catch the corresponding messages, like the other answer demonstrates. Don't forget to call inherited, as this will call the events.
Here's a VCL compliant version (tested D2010)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TMyPanel = class(TPanel)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published
end;
TForm1 = class(TForm)
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure OnMEnter(Sender: TObject);
Procedure OnMLeave(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
With TMyPanel.Create(Form1) do
Begin
Parent := Form1;
Caption := 'Test';
OnMouseEnter := OnMEnter;
OnMouseLeave := OnMLeave;
End;
end;
procedure TForm1.OnMEnter(Sender: TObject);
begin
Form1.Caption := 'Entered';
end;
procedure TForm1.OnMLeave(Sender: TObject);
begin
Form1.Caption := 'Left';
end;
{ TMyPanel }
procedure TMyPanel.CMMouseEnter(var Message: TMessage);
begin
// Do whatever your want before the event
Self.Caption := 'Custom Enter';
// Call inhertied method handler
Inherited;
end;
procedure TMyPanel.CMMouseLeave(var Message: TMessage);
begin
// Do whatever your want before the event
Self.Caption := 'Custom Left';
// Call inhertied method handler
Inherited;
end;
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