Dynamic objects with an event handler - Delphi - delphi

I have two components created dynamically, a button (btnEnter) and an edit (edtID)- where the user will enter their user ID. What I want is for the program to verify whether the user has entered a valid ID when they have clicked the button.
The code I have:
1)When the objects are created
with btnEnter do
{edit properties such as caption, etc}
OnClick := ValidateID;
2)The procedure is declared as follows:
procedure ValidateID (Sender : TObject);
What I would like to do is pass the text in the edit through the procedure as a parameter, so that the procedure will be able to manipulate the text and determine whether it is valid or not.
So what I tried, but didn't work was:
procedure ValidateID (Sender : TObject; sID : string);
with btnEnter do
OnClick := ValidateID(edtID.Text);
Would really appreciate if someone could help me with this. Thanks

The TButton.OnClick event is of type TNotifyEvent which has a signature:
TNotifyEvent = procedure(Sender: TObject) of object;
Thus, you can not assign a procedure with a different signature to TButton.OnClick.
You need to declare the ValidateID procedure as a method of the form class and then, since the TEdit is on the same form, it is in the same scope as your validation method, and you can simply access EditID.Text in your ValidateID method.

This code works.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
button: TButton;
edit: TEdit;
procedure ValidateID(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
edit := TEdit.Create(self);
button := TButton.Create(self);
button.Parent := Form1;
edit.Parent := Form1;
edit.Left := 1;
edit.Top := 1;
button.Left := 1;
button.Top := 50;
button.OnClick := ValidateID;
end;
procedure TForm1.ValidateID(Sender: TObject);
begin
ShowMessage(edit.Text)
end;
end.

Related

How to interfere when user presses CTRL+X and still keep TMemo's default CTRL+X behavior?

I have a TMemo on the form and I've set an OnChange event for it. I hope the OnChange event not to be triggered when the user presses Ctrl+X in the memo. But Ctrl+X just cuts the text selection, which will for sure trigger the OnChange event. How can I prevent that?
I've tried to detect Ctrl+X in the KeyUp event, and if the user pressed Ctrl+X I unbind the memo's OnChange event and programmatically cut the text again. But this doesn't work, and I don't how to programmatically send Ctrl+X.
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = Ord('X')) and (Shift = [ssCtrl]) then
begin
Memo1.OnChange := nil;
// programmatically cut the text here, which I don't know how to do
Memo1.OnChange := Memo1Change;
end;
end;
Don't rely on keyboard events (They are not executed for example when you cut something by using the popupmenu), rely on windows messages instead.
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure Memo1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FPrevMemoWindowProc : TWndMethod;
procedure MemoWindowProc(var AMessage: TMessage);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Clipbrd;
procedure TForm1.MemoWindowProc(var AMessage: TMessage);
begin
if(AMessage.Msg = WM_CUT) then
begin
if(Memo1.SelLength > 0) then
begin
Memo1.OnChange := nil;
try
Clipboard.AsText := Memo1.SelText;
Memo1.ClearSelection();
Exit;
finally
Memo1.OnChange := Memo1Change;
end;
end;
end;
FPrevMemoWindowProc(AMessage);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FPrevMemoWindowProc := Memo1.WindowProc;
Memo1.WindowProc := MemoWindowProc;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
ShowMessage('Change');
end;

Delphi error while returning TList

I have made a very simple application but I have an issue that I really cannot understand. Look at this basic code:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, generics.collections, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
test: TList<integer>;
aList: TList<integer>;
public
{ Public declarations }
function testGenerics: TList<integer>;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
test := testGenerics;
test.Sort;
showmessage(test[0].tostring);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
test := TList<integer>.Create;
aList := TList<integer>.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
aList.Free;
test.Free;
end;
function TForm1.testGenerics: TList<integer>;
begin
aList.Add(4);
result := aList;
end;
end.
Basically when the Form opens I am going to create test and aList and then when I press the button the function testGenerics is called. Why do I have the Invalid pointer operation error?
I really cannot understand since I am creating and destroying the objects (I guess) properly. This code instead works fine:
function TForm1.testGenerics: TList<integer>;
begin
Result := TList<integer>.Create;
Result.Add(4);
end;
In this case I am returning an instance of TList<integer> but also in the case above I am returning an instance of aList (which is a TList).
If I'm correct in the first case test := testGenerics is like test := aList (because I am returning aList in fact) so I am going to give test the same reference as aList. Am I correct?
In the first example, whenever you call testGenerics(), you are re-assigning test to point at the aList object. You are losing track of the original test object created in the OnCreate event, so it is leaked. And then in the OnDestroy event, when you call test.Free, it crashes because you already freed the aList object beforehand, so you are trying to free the same object a second time, which is an invalid operation.
In the second example, you are still leaking the original test object (and every TList you allocate and assign to test, except for the last one), but you are not re-assigning test to point at the aList object anymore, so there is no crash in the OnDestroy event because both variables are pointing at separate objects.
What are you trying to accomplish in the first place? Returning objects in this manner is not good practice. Nor does it make sense to call Sort() on 1-element lists.
If you are trying to populate test with multiple values over time, you should pass test as an input parameter to testGenerics() (or just let testGenerics() access test directly via Self), don't use the return value at all.
And in any case, get rid of your aList private member, as you are not doing anything with it anyway.
Try this:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, generics.collections, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
test: TList<integer>;
public
{ Public declarations }
procedure testGenerics(aList: TList<integer>);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
testGenerics(test);
test.Sort;
ShowMessage(test[0].tostring);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
test := TList<integer>.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
test.Free;
end;
procedure TForm1.testGenerics(aList: TList<integer>);
begin
// FYI, a better way to exercise Sort()
// would be to use RandomRange() instead
// of a hard-coded number...
aList.Add(4);
end;
end.

Modal dialog does not return focus to application

I have a custom control derived from TPanel named TTestCtrl. It holds a TImage32 (from Graphics32).
When the user double clicks on the image, I show a message. The problem is that after I close the message, the focus is not returned back to the main application. So, the first click, no matter what I click on in the main app/main form, is lost.
Strange thing: If I call the Mesaj() procedure not from the TTestCtrl but from the main form, it works (the first click is not lost anymore):
unit DerivedControl;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Dialogs, Vcl.Forms, GR32, GR32_Image;
type
TTestCtrl = class(TPanel)
private
Img: TImage32;
protected
procedure ChromaDblClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
published
end;
procedure Mesaj(const MessageText, Title: string);
implementation
procedure Mesaj(const MessageText, Title: string);
begin
{$IFDEF MSWINDOWS}
Application.MessageBox(PChar(MessageText), PChar(Title), 0) { 'Title' will appear in window's caption }
{$ELSE}
MessageDlg(MessageText, mtInformation, [mbOk], 0);
{$ENDIF}
end;
constructor TTestCtrl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height := 86;
Img := TImage32.Create(Self);
Img.Parent := Self;
Img.Align := alClient;
Img.OnDblClick := ChromaDblClick;
end;
procedure TTestCtrl.ChromaDblClick(Sender: TObject);
begin
Mesaj('Caption', 'From derived control'); // focus lost
end;
end.
The simple/minimal application below is the tester:
unit TesterForm;
interface
uses
System.SysUtils, System.Classes, Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Controls, vcl.Forms, DerivedControl;
type
TfrmTester = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
frmTester: TfrmTester;
implementation
{$R *.dfm}
var
Ctrl: TTestCtrl;
procedure TfrmTester.FormCreate(Sender: TObject);
begin
Ctrl := TTestCtrl.Create(Self);
Ctrl.Parent := Self;
end;
procedure TfrmTester.Button1Click(Sender: TObject);
begin
Mesaj('Caption', 'From main form'); // works
end;
end.
Try this :
procedure TTestCtrl.ChromaDblClick(Sender: TObject);
var F : TcustomForm;
begin
Mesaj('Caption', 'From derived control'); // focus lost
F := GetParentForm(Self);
if Assigned(F) then F.BringToFront;
end;

Again over interfaces in Delphi

In order to understand interfaces I've realized a small application with a form, a data module with a simple database.
here is the form
The data module contains only a connection, a table and a TDataSource component.
The interface unit is this:
unit databaseInterface;
interface
uses
MSAccess;
type
IDBTest = interface
['{5B8CF4FF-66F7-402D-8E18-0159CB22F805}']
procedure SetTable(table: TMSTable);
function SetPriorRecord: Boolean;
function SetNextRecord: Boolean;
end;
implementation
end.
and it's implementation is this:
unit databaseImplementation;
interface
uses
databaseInterface, database, MSAccess;
type
TDBTest = class(TInterfacedObject, IDBTest)
protected
DBTable: TMSTable;
FbtnPriorStatus: Boolean;
procedure SetTable(Table: TMSTable);
function SetPriorRecord: Boolean;
function SetNextRecord: Boolean;
public
property Table: TMSTable read DBTable write SetTable;
end;
implementation
{ TDBTest }
procedure TDBTest.SetTable(Table: TMSTable);
begin
if DBTable <> Table then begin
DBTable := Table;
DBTable.Open;
end;
end;
function TDBTest.SetPriorRecord: Boolean;
begin
if not DBTable.Bof then begin
DBTable.Prior;
Result := DBTable.Bof;
end else
Result := True;
end;
function TDBTest.SetNextRecord: Boolean;
begin
if not DBTable.Eof then begin
DBTable.Next;
Result := DBTable.Eof;
end else
Result := True;
end;
end.
Now, this is the question. The code of my form is as below:
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, databaseInterface, databaseImplementation, JvExMask,
JvToolEdit, JvMaskEdit, JvCheckedMaskEdit, JvDatePickerEdit,
Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, JvDBDatePickerEdit, JvExControls,
JvButton, JvTransparentButton, database;
type
TfrmMain = class(TForm)
pnlCommands: TPanel;
pnlData: TPanel;
pnlMessages: TPanel;
bvlIcons: TBevel;
bvlNavigation: TBevel;
lblId: TLabel;
lblFirstName: TLabel;
lblLastName: TLabel;
lblBirthday: TLabel;
edtId: TDBEdit;
edtFirstName: TDBEdit;
edtLastName: TDBEdit;
dtpBirthday: TJvDBDatePickerEdit;
btnPrior: TJvTransparentButton;
btnNext: TJvTransparentButton;
procedure btnNextClick(Sender: TObject);
procedure btnPriorClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
DBTest: IDBTest;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DBTest := TDBTest.Create;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
DBTest.SetTable(dmAuthors.tblAuthors);
end;
procedure TfrmMain.btnPriorClick(Sender: TObject);
begin
btnPrior.Enabled := not DBTest.SetPriorRecord;
btnNext.Enabled := True;
end;
procedure TfrmMain.btnNextClick(Sender: TObject);
begin
btnNext.Enabled := not DBTest.SetNextRecord;
btnPrior.Enabled := True;
end;
end.
So I call the methods SetPriorRecord and SetNextRecord when the user click over the related button and then, accordingly with the status of the table (BOF or EOF), I disable or enable buttons.
I wonder if there is a way to set buttons status via interface, decoupling this operation from the form; for example binding buttons in any way or something else, but I don't know how to do it, if it is possible!
I hope I was clear in my explication of the problem.
The existing interface is not sufficient. You need to pass in some means of letting the client know the state of the table, but without exposing the TDataSet's detailed logic (preferably). A callback to an event handler would work; a way to trigger TAction would work; as would an anonymous method. You basically need to return a flag of some kind signifying BOF, EOF, or somewhere in between; possibly also a record# and record count.
I've modified the application interface in this way:
unit databaseInterface;
interface
uses
MSAccess;
type
IDBTest = interface
['{5B8CF4FF-66F7-402D-8E18-0159CB22F805}']
procedure SetTable(table: TMSTable);
procedure SetPriorRecord;
procedure SetNextRecord;
function GetIsBof: Boolean;
function GetIsEof: Boolean;
property IsBof: Boolean read GetIsBof;
property IsEof: Boolean read GetIsEof;
end;
implementation
end.
and this is the interface implementation:
unit databaseImplementation;
interface
uses
databaseInterface, database, MSAccess;
type
TDBTest = class(TInterfacedObject, IDBTest)
protected
DBTable: TMSTable;
FIsBof: Boolean;
FIsEof: Boolean;
procedure SetTable(Table: TMSTable);
procedure SetPriorRecord;
procedure SetNextRecord;
function GetIsBof: Boolean;
function GetIsEof: Boolean;
procedure SetCursorStatus;
public
property Table: TMSTable read DBTable write SetTable;
property IsBof: Boolean read GetIsBof;
property IsEof: Boolean read GetIsEof;
end;
implementation
{ TDBTest }
procedure TDBTest.SetTable(Table: TMSTable);
begin
if DBTable <> Table then begin
DBTable := Table;
DBTable.Open;
end;
end;
procedure TDBTest.SetPriorRecord;
begin
try
DBTable.Prior;
finally
SetCursorStatus;
end;
end;
procedure TDBTest.SetNextRecord;
begin
try
DBTable.Next;
finally
SetCursorStatus;
end;
end;
procedure TDBTest.SetCursorStatus;
begin
FIsBof := DBTable.Bof;
FIsEof := DBTable.Eof;
end;
function TDBTest.GetIsBof: Boolean;
begin
Result := FIsBof;
end;
function TDBTest.GetIsEof: Boolean;
begin
Result := FIsEof;
end;
end.
So the form code become this:
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, JvExMask, JvToolEdit,
JvMaskEdit, JvCheckedMaskEdit, JvDatePickerEdit, JvDBDatePickerEdit,
JvExControls, JvButton, JvTransparentButton, database, databaseInterface,
databaseImplementation;
type
TfrmMain = class(TForm)
pnlCommands: TPanel;
pnlData: TPanel;
pnlMessages: TPanel;
bvlIcons: TBevel;
bvlNavigation: TBevel;
lblId: TLabel;
lblFirstName: TLabel;
lblLastName: TLabel;
lblBirthday: TLabel;
edtId: TDBEdit;
edtFirstName: TDBEdit;
edtLastName: TDBEdit;
dtpBirthday: TJvDBDatePickerEdit;
btnPrior: TJvTransparentButton;
btnNext: TJvTransparentButton;
procedure btnNextClick(Sender: TObject);
procedure btnPriorClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
DBTest: IDBTest;
procedure SetNavButtonsStatus;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
DBTest := TDBTest.Create;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
DBTest.SetTable(dmAuthors.tblAuthors);
end;
{ Begin table navigation ----------------------------------------------------- }
procedure TfrmMain.btnPriorClick(Sender: TObject);
begin
DBTest.SetPriorRecord;
SetNavButtonsStatus;
end;
procedure TfrmMain.btnNextClick(Sender: TObject);
begin
DBTest.SetNextRecord;
SetNavButtonsStatus;
end;
procedure TfrmMain.SetNavButtonsStatus;
begin
btnPrior.Enabled := not DBTest.IsBof;
btnNext.Enabled := not DBTest.IsEof
end;
{ End table navigation ------------------------------------------------------- }
end.
Now I think buttons are decoupled, but I'm not sure abot the solution I've found. Can It be good?

How to bring an OpenDialog hidden by another window to the front

I have an application with multiple forms and a separate taskbar button for each form.
Let's say form2 displays an OpenDialog, I click away to another maximized application covering the full screen area, then I go back to form2 by selecting it's taskbar button. Voila! The OpenDialog is hidden behind the other application I selected, and I have to click on the now non-accessible form2 to bring the dialog back to the front. This is really annoying and may confuse the user.
Here is some code to illustrate the issue:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
end;
end.
________________
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure CreateParams(var Params: TCreateParams); override;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
end.
Is it possible maybe to get the handle of the visible opendialog? It used to be possible, but with the new Vista style OpenDialog if I trap OnDialogShow the OpenDialog reverts back to the old style which is a no go for me now.
Any ideas?
TOpenDialog.Execute() has an optional parameter that lets you specify a parent window that the dialog is not allowed to fall behind:
procedure TForm2.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute(Self.Handle);
end;
If you do not specify a parent window, the active Form's window is used if Application.ModalPopupMode is not pmNone, otherwise the Application.MainForm window is used instead.
So I've figured out how to bring the dialog to the front, but there is still one problem: the focus is on Form2, not the dialog. If someone can tell me how to put the focus on the opendialog instead of Form2 and post it as an answer, I'll accept it.
Here are the code excerpts to add to the original:
type
TForm1 = class(TForm)
private
procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
public
{ Public declarations }
end;
var
Form1: TForm1;
DialogFormHandle: HWnd;
...
procedure TForm1.WMActivate(var Msg: TWMActivate);
begin
inherited;
if DialogFormHandle <> 0 then
begin
BringWindowToTop(DialogFormHandle);
exit;
end;
end;
...
procedure TForm2.Button1Click(Sender: TObject);
begin
try
DialogFormHandle := Handle;
OpenDialog1.Execute(Handle);
finally
DialogFormHandle := 0;
end;
end;
Thanks!

Resources