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?
Related
I need to play and loop a WAV audio track from resources.
I found an answer to a similar question here: https://stackoverflow.com/a/47960211/19160533
But when I paste it into my code, it says this:
My resources look like this (don't mind the name of the project):
The code I pasted into my project is:
procedure TForm1.FormShow(Sender: TObject);
begin
PlaySound(BG, 0, SND_RESOURCE or SND_ASYNC);
end;
And the whole thing looks like this:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Unit2, Unit3, Unit4, Unit5,
Vcl.MPlayer, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
Button1: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MediaPlayer1Enter(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
PlaySound(BG, 0, SND_RESOURCE or SND_ASYNC);
end;
Maybe I need to include some library or something else? I'm new to Delphi.
To use PlaySound() in Delphi, you simply need to add the Winapi.MMSystem unit to your uses clause.
But, since you also have a TMediaPlayer in your project, you could use that instead of PlaySound(), which would have the extra benefit of giving you more control over the playback (pausing/resuming, skipping, etc).
TMediaPlayer does not natively support playing WAV audio from a resource, but it can be done with a little extra coding.
Internally, TMediaPlayer uses MCI via the mciSendCommand() function. According to Microsoft (HOWTO: Use MCI to Play AVI/WAVE Files from Memory), you can setup MCI to play WAV audio from memory (such as a resource) by installing a custom IO callback, and then specifying that callback when opening the player device. Fortunately, the callback is triggered by file extension, hence this approach is compatible with the TMediaPlayer.FileName property.
So, you should be able to write an IO callback function with a custom file extension (for example, .RES for resource), and have that callback load the WAV resource and read its data, and then you would set MediaPlayer1.DeviceType to dtWaveAudio and MediaPlayer1.FileName to a filename ending with the custom extension. The rest is handled by the OS for you, and you can then use MediaPlayer1 to control the playback as needed.
For example (untested, might need some tweaking):
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Unit2, Unit3, Unit4, Unit5,
Vcl.MPlayer, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
Button1: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MediaPlayer1Enter(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Winapi.MMSystem;
{$R *.dfm}
function MAKEFOURCC(ch0, ch1, ch2, ch3: BYTE): FOURCC;
begin
Result := DWORD(ch0) or (DWORD(ch1) shl 8) or (DWORD(ch2) shl 16) or (DWORD(ch3) shl 24);
end;
function MyResourceIOProc(lpMMIOInfo: PMMIOInfo; uMessage: UINT; lParam1, lParam2: LPARAM): LRESULT; stdcall;
var
Res: TResourceStream;
function GetResourceStream: TResourceStream;
begin
Move(lpMMIOInfo.adwInfo, Result, SizeOf(TResourceStream));
end;
procedure SetResourceStream(Stream: TResourceStream);
begin
Move(Stream, lpMMIOInfo.adwInfo, SizeOf(TResourceStream));
end;
begin
case uMessage of
MMIOM_OPEN: begin
try
Res := TResourceStream.Create(HInstance, ChangeFileExt(PChar(lParam1), ''), 'WAVE');
except
SetResourceStream(nil);
Exit(MMIOM_CANNOTOPEN);
end;
SetResourceStream(Res);
lpMMIOInfo.lDiskOffset := 0;
Exit(MMSYSERR_NOERROR);
end;
MMIOM_CLOSE: begin
Res := GetResourceStream;
SetResourceStream(nil);
Res.Free;
Exit(MMSYSERR_NOERROR);
end;
MMIOM_READ: begin
Res := GetResourceStream;
Move((PByte(Res.Memory) + lpMMIOInfo.lDiskOffset)^, Pointer(lParam1)^, lParam2);
Inc(lpMMIOInfo.lDiskOffset, lParam2);
Exit(lParam2);
end;
MMIOM_SEEK: begin
case lParam2 of
SEEK_SET: begin
lpMMIOInfo.lDiskOffset := lParam1;
end;
SEEK_CUR: begin
Inc(lpMMIOInfo.lDiskOffset, lParam1);
end;
SEEK_END: begin
Res := GetResourceStream;
lpMMIOInfo.lDiskOffset := Res.Size - 1 - lParam1;
end;
end;
Exit(lpMMIOInfo.lDiskOffset);
end;
else
Exit(MMSYSERR_NOERROR);
end;
end;
var
ccRES: FOURCC;
procedure TForm1.FormCreate(Sender: TObject);
begin
ccRES := MAKEFOURCC(Ord('R'), Ord('E'), Ord('S'), Ord(' '));
mmioInstallIOProc(ccRES, TFNMMIOProc(MyResourceIOProc), MMIO_INSTALLPROC or MMIO_GLOBALPROC);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mmioInstallIOProc(ccRES, nil, MMIO_REMOVEPROC);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
MediaPlayer1.FileName := 'BG.RES+';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
I have one Delphi 10.0 Seattle project to FTP some files to a server.
I will do the following:
On Button1 OnClick event, I will calculate something and will make one text file. Edit1 will hold the file name.
On Button2 OnClick event, the last 4 characters of the file name will be deleted. The file will be renamed with the new name. Edit2 will hold the new name and it will be uploaded to one server.
During the file uploading, no button click will work and the Form cannot be closed. I have used one Boolean variable FileToBeTranferred. It is false at Form creation.
I have written the following code:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FileToBeTranferred: boolean;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileToBeTranferred = false then
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := true;
end
else
begin
Button1.Click(nil);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FileToBeTranferred = true then
begin
Edit2.Text := delete(Edit1.Text, (length(Edit1.Text)-4), 4);
//Upload to Server
Button2.Click(self);
end
else
begin
//Upload finished
FileToBeTranferred := false;
Button2.Click(nil);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if FileToBeTranferred = true then CanClose := false
else CanClose := true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := false;
end;
end.
I am unable to do anything. I am getting too many errors. The errors are as follows:
[dcc32 Error] Unit1.pas(44): E2197 Constant object cannot be passed as var parameter in Edit2.Text := delete(Edit1.Text, (length(Edit1.Text)-4), 4); - for deleting last 4 characters for file rename.
[dcc32 Error] Unit1.pas(47): E2034 Too many actual parameters in Button2.Click(nil); - as FTP is in progress so no more modification to the file is allowed. Button1.Click will not perform anything.
[dcc32 Error] Unit1.pas(47): E2034 Too many actual parameters in Button2.Click(self);- as FTP progress completed so the file is ready to be appended. Button2.Click will not perform its usual work.
What is the solution to this?
The code you have shown is just all kinds of wrong. Not just the syntax errors, but also logic errors. Even if the code compiled, your Button1 click handler will get stuck in an endless recursive loop if FileToBeTranferred is true, and your Button2 click handler will get stuck in an endless recursive loop regardless of FileToBeTranferred.
Try something more like this instead:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
FileToBeTranferred: boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if not FileToBeTranferred then
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FileToBeTranferred then
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := not FileToBeTranferred;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := False;
end;
end.
That being said, you might consider a different approach. For instance, one that doesn't require the FileToBeTranferred Boolean at all:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled := False;
//Do some calculation
//Edit1.Text := Output File Name
Button2.Enabled := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Button2.Enabled := False;
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server
Button1.Enabled := True;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := Button1.Enabled;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Enabled := True;
Button2.Enabled := False;
end;
end.
Or, you could combine the two approaches, by enabling/disabling the TButton objects based on the current value of FileToBeTranferred at any given moment.
You can override the Form's virtual UpdateActions() method:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
protected
procedure UpdateActions; override;
private
{ Private declarations }
FileToBeTranferred: boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := not FileToBeTranferred;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := False;
end;
procedure TForm1.UpdateActions;
begin
inherited;
Button1.Enabled := not FileToBeTranferred;
Button2.Enabled := FileToBeTranferred;
end;
end.
Or, you can drop a TActionList on the Form and assign a TAction to each TButton, and then enable/disable the TAction objects in their OnUpdate events:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math, Vcl.ActnList;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
procedure Action1Update(Sender: TObject);
procedure Action2Update(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FileToBeTranferred : Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Action1Update(Sender: TObject);
begin
Action1.Enabled := not FileToBeTranferred;
end;
procedure TForm1.Action2Update(Sender: TObject);
begin
Action2.Enabled := FileToBeTranferred;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
end.
I have a record that contains what I believe is a pointer to a reference counted object. I would expect that if I create the reference counted object within the record that when the record goes out of scope the reference count of the object would fall to zero, and the object would be destroyed. But this does not seem to be that case. Here is sample minimum code. My form happens to have some panels and a memo, but only the TButton (and specifically Button1Click) is important.
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TUserData = class( TInterfacedObject )
public
AData : integer;
constructor Create;
destructor Destroy; override;
end;
TTestRec = Record
AField : integer;
UserData : TUserData;
End;
TForm4 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Memo1: TMemo;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
var
iRec : TTestRec;
begin
iRec.UserData := TUserData.Create;
// stop too much optimisation
Button1.Caption := IntToStr( iRec.UserData.AData );
end; // I would expect TTestRec and hence TTestRec.UserData to go out of scope here
procedure TForm4.FormShow(Sender: TObject);
begin
// show leaks on exit
ReportMemoryLeaksOnShutdown := TRUE;
end;
{ TUserData }
constructor TUserData.Create;
begin
inherited Create;
AData := 4;
end;
destructor TUserData.Destroy;
begin
inherited;
end;
end.
I confess I don't really understand how reference counting works in detail, although I do understand the principle. What am I missing? Am I expecting too much and if so, is there any way to avoid memory leaks, not in this specific case (where obviously I could destroy UserData on exit) but in general, since records do not support destructors.
Automatic reference counting is performed through interface variables. You don't have any. Instead of a variable of type TUserData you need a variable that is an interface.
You could use IInterface here but that would be a little useless. So you should define an interface that exposes the public functionality you need the object to support and then have your class implement that interface.
This program demonstrates what I mean:
type
IUserData = interface
['{BA2B50F5-9151-4F84-94C8-6043464EC059}']
function GetData: Integer;
procedure SetData(Value: Integer);
property Data: Integer read GetData write SetData;
end;
TUserData = class(TInterfacedObject, IUserData)
private
FData: Integer;
function GetData: Integer;
procedure SetData(Value: Integer);
end;
function TUserData.GetData: Integer;
begin
Result := FData;
end;
procedure TUserData.SetData(Value: Integer);
begin
FData := Value;
end;
type
TTestRec = record
UserData: IUserData;
end;
procedure Main;
var
iRec: TTestRec;
begin
iRec.UserData := TUserData.Create;
end;
begin
Main;
ReportMemoryLeaksOnShutdown := True;
end.
This program does not leak. Change the variable declaration in the record type to UserData: TUserData and the leak returns.
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;
I have problem with host application, which loads DLL form and interfaceing some function and properties.
The purpose is load a dll, show name as module name, set connection to ADOTable component and show form with data. Everything is working fine. But after close the host app a host app crashed and I get windows that hostapp.exe stopped working.
I do not know whether it is by freeing library or setting nil for interface.
Do you have any solution? Thanks.
Interface CODE
unit u_baseplugin_intf;
interface
uses Data.Win.ADODB, Data.DB;
type
IBaseModuleInterface = interface
['{060A9C46-B3CF-4BA4-B025-2DC1D9F45076}']
function GetModuleName: Ansistring;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
procedure showF;stdcall;
procedure freeF;stdcall;
property ModuleName: Ansistring read GetModuleName;
property Connection : TAdoConnection write SetConn;
end;
implementation
end.
DLL code
library profileslist;
uses
System.SysUtils,
System.Classes,
u_baseplugin_intf,
u_profileslist in 'u_profileslist.pas' {Form_DLL};
{$R *.res}
function LoadModule:IBaseModuleInterface;stdcall;
begin
result:=TForm_DLL.Create(nil);
end;
exports
LoadModule;
begin
end.
DLL Form code
unit u_profileslist;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls,
u_baseplugin_intf, Data.DB,Data.Win.ADODB;
type
TForm_DLL = class(TForm, IBaseModuleInterface)
DBGrid1: TDBGrid;
ADOTable1: TADOTable;
DataSource1: TDataSource;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
{Interface methods implementation}
function GetModuleName: AnsiString;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
public
{ Public declarations }
{Interface methods implementation}
procedure ShowF;stdcall;
procedure FreeF;stdcall;
end;
var
Form_DLL: TForm_DLL;
implementation
{$R *.dfm}
{Interface methods implementation}
function TForm_DLL.GetModuleName;
begin
Result := 'Profiles list';
end;
procedure TForm_DLL.SetConn(sConn: TAdoConnection);
begin
AdoTable1.Connection:=sConn;
end;
procedure TForm_DLL.ShowF;
begin
ShowModal;
end;
procedure TForm_DLL.FreeF;
begin
FreeAndNil(Form_DLL);
end;
{Form_DLL methods implementation}
procedure TForm_DLL.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AdoTable1.Active:=false;
end;
procedure TForm_DLL.FormShow(Sender: TObject);
begin
AdoTable1.Active:=true;
end;
end.
HOST app code
program hostapp;
uses
Vcl.Forms,
u_hostapp in 'u_hostapp.pas' {Form1},
u_baseplugin_intf in 'u_baseplugin_intf.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Host app FORM code
unit u_hostapp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
u_baseplugin_intf,
Data.Win.ADODB, Data.DB;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TModuleInterface = function:IBaseModuleInterface; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
aModuleIntf : IBaseModuleInterface;
dllHandle : cardinal;
procedure LoadModule( aLibName : pWideChar );
var
lModule : TModuleInterface;
begin
dllHandle := LoadLibrary(aLibName) ;
if dllHandle <> 0 then
begin
#lModule := GetProcAddress(dllHandle, 'LoadModule') ;
if Assigned (lModule) then
aModuleIntf := lModule //call the function
else
begin
ShowMessage('GetModuleIntf not found.') ;
FreeLibrary(dllHandle) ;
end;
end
else
begin
ShowMessage(aLibName+' not found.') ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aModuleIntf.Connection:=AdoConnection1;
aModuleIntf.ShowF;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
aModuleIntf.Connection:=nil;
aModuleIntf.freeF;
aModuleIntf:=nil;
FreeLibrary(dllHandle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadModule('profileslist.dll');
Label1.Caption:=aModuleIntf.ModuleName;
end;
end.
You never assign to Form_DLL. This means that when you call FreeF, you then perform FreeAndNil(Form_DLL). Since Form_DLL is nil, this does nothing, and the form still exists.
Fix that by changing LoadModule:
function LoadModule:IBaseModuleInterface;stdcall;
begin
Assert(not Assigned(Form_DLL));
Form_DLL:=TForm_DLL.Create(nil);
result:=Form_DLL;
end;
Although, I'd probably change the design completely by removing Form_DLL altogether. The host app maintains a reference to the form, on which the call to Free can be made. In other words, remove Form_DLL and implement FreeF like this:
procedure TForm_DLL.FreeF;
begin
Free; // or Destroy
end;
Or even better, use reference counted interfaces on the implementing object and let aModuleIntf:=nil take the form down.