Sorry for having to open new question but I can't find an answer anywhere.
My app is still in progress, but basically I'm trying to call another Form from my MainForm when initializing players, however I get an Access Violation error. Would you please explain to me why this could be happening?
My MainForm code:
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, jpeg, pngimage, getPlayer_u;...
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Randomize;
InitGameSetup();
end;...
procedure TfrmMain.InitGameSetup();
begin
SetWindowProperties();
InitBackGround();
InitMainMenu();
InitGameBoard();
InitScrabbleTileRack();
InitPlayers();
// GameLoop();
end; ...
procedure TfrmMain.InitPlayers();
var
I : Integer;
sName, sSurname : string;
begin
setLength(Players, NUMBER_OF_PLAYERS);
for I := 1 to High(Players) do
begin
GetPlayer(); ---------------- problem is here
with Players[I] do
begin
Name := sName;
Surname := sSurname;
end;
end;
end;...
procedure TfrmMain.GetPlayer();
begin
frmGetPlayer.Show;
end;
My frmGetPlayer:
unit getPlayer_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmGetPlayer = class(TForm)
btnSubmit: TButton;
edtName: TEdit;
edtSurname: TEdit;
procedure FormCreate(Sender: TObject);
procedure btnSubmitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
sPlayerName, sPlayerSurname : string;
end;
var
frmGetPlayer: TfrmGetPlayer;
implementation
{$R *.dfm}
procedure TfrmGetPlayer.btnSubmitClick(Sender: TObject);
begin
sPlayerName := edtName.Text;
sPlayerSurname := edtSurname.Text;
if not ((Length(sPlayerName) >= 1) and (Length(sPlayerSurname) >= 1)) then
MessageDlg('Please enter a name and surname.', mtInformation, [mbOK], 0)
else
Self.Free;
end;
procedure TfrmGetPlayer.FormCreate(Sender: TObject);
begin
with Self do
begin
Position := poScreenCenter;
BorderStyle := bsDialog;
end;
end;
end.
My dpr:
program main_p;
uses
Forms,
main_u in 'main_u.pas' {frmMain},
getPlayer_u in 'getPlayer_u.pas' {frmGetPlayer};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
The error:
Only your MainForm object is created automatically at program startup. Inside its OnCreate event, your Player Form object hasn't been created yet, so the frmGetPlayer variable is not pointing at a valid object.
frmGetPlayer is a global variable, so it is initially nil. The error message is telling you that you are accessing invalid memory near address 0, which is almost always an indication of accessing a member of a class via a nil pointer.
So, you can't call frmGetPlayer.Show() until after you have created the Player Form object and assigned frmGetPlayer to point at it. Which the code you showed is not doing.
When I work with TServerSocket I can use the property Data to store a pointer to a class for example for each client.
Now I will use Indy TIdCmdTCPServer and I'd like to know if there is an equivalent property.
Yes, there is - the TIdContext.Data property. In TIdCmdTCPServer events that give you a TIdCommand parameter instead of a TIdContext parameter, you can access the TIdContext object from the TIdCommand.Context property. For example:
type
TMyClass = class
// add whatever you need...
end;
procedure TForm1.IdCmdTCPServer1Connect(AContext: TIdContext);
var
MyCls: TMyClass;
begin
MyCls := TMyClass.Create;
// initialize MyCls as needed...
AContext.Data := MyCls;
end;
procedure TForm1.IdCmdTCPServer1Disconnect(AContext: TIdContext);
begin
AContext.Data.Free;
AContext.Data := nil;
end;
procedure TForm1.IdCmdTCPServer1CommandHandlerCommand(ACommand: TIdCommand);
var
MyCls: TMyClass;
begin
MyCls := TMyClass(ACommand.Context.Data);
// use MyCls as needed...
end;
Indy also has another useful feature. You can derive a custom class from TIdServerContext, add whatever you want to it, and then assign it to the server's ContextClass property before activating the server. That way, you can simply typecast any TIdContext pointer to your class type when you need to access your custom members. For example:
type
TMyContext = class(TIdServerContext)
public
// add whatever you need...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
//...
end;
destructor TMyContext.Destroy;
begin
//...
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdCmdTCPServer1.ContextsClass := TMyContext;
end;
procedure TForm1.IdCmdTCPServer1Connect(AContext: TIdContext);
var
MyCtx: TMyContext;
begin
MyCtx := TMyClass(AContext);
// initialize MyCtx as needed...
end;
procedure TForm1.IdCmdTCPServer1CommandHandlerCommand(ACommand: TIdCommand);
var
MyCtx: TMyContext;
begin
MyCtx := TMyClass(ACommand.Context);
// use MyCtx as needed...
end;
This way, you don't need to waste time and memory allocating a separate class per client, when you can use the one that the server already creates for you.
The console application below gives "Runtime error"...
Why would this happen ? Many thanks !
PS: Related SO post
program Project2;
{$APPTYPE CONSOLE}
type
TParent = class;
TParentClass = class of TParent;
TParent = class
public
procedure Work; virtual; abstract;
end;
TChild1 = class(TParent)
public
procedure Work; override;
end;
TChild2 = class(TParent)
public
procedure Work; override;
end;
procedure TChild1.Work;
begin
WriteLn('Child1 Work');
end;
procedure TChild2.Work;
begin
WriteLn('Child2 Work');
end;
procedure Test(ImplClass: TParentClass);
var
ImplInstance: TParent;
begin
ImplInstance := ImplClass.Create;
ImplInstance.Work;
ImplInstance.Free;
end;
begin
Test(TParent);
Test(TChild1);
Test(TChild2);
Readln;
end.
The TParent.Work method is declared as abstract. The documentation says:
You can call an abstract method only in a class or instance of a class in which the method has been overridden.
When you call TParent.Work you break that rule and so encounter a runtime error.
Having a situation: two packages: "Base" and "Descendant" and an application "Example".
The Base package and the Example application may be in one project group, but the Descendant package has to be in other project group, without any source code of Base and Example.
The aim of such manipulation is to hide Base and Application sources from workers who will work with Descendant package.
Base package contains a form: TFormBase with some components and some code. I build it and get some binary files: bpl, dcp, etc...
type
TFormBase = class(TForm)
Panel1: TPanel;
BOk: TButton;
BCancel: TButton;
procedure BOkClick(Sender: TObject);
procedure BCancelClick(Sender: TObject);
private
protected
function GetOkButtonCaption: string; virtual;
function GetCancelButtonCaption: string; virtual;
public
end;
implementation
{$R *.dfm}
procedure TFormBase.BCancelClick(Sender: TObject);
begin
ShowMessage('"' + GetCancelButtonCaption + '" button has been pressed');
end;
procedure TFormBase.BOkClick(Sender: TObject);
begin
ShowMessage('"' + GetOkButtonCaption + '" button has been pressed');
end;
function TFormBase.GetCancelButtonCaption: string;
begin
Result := 'Cancel';
end;
function TFormBase.GetOkButtonCaption: string;
begin
Result := 'Ok';
end;
Descendant package contains TFormDescendant = class(TFormBase)
type
TFormDescendant = class(TFormBase)
private
protected
function GetOkButtonCaption: string; override;
function GetCancelButtonCaption: string; override;
public
end;
implementation
{$R *.dfm}
function TFormDescendant.GetCancelButtonCaption: string;
begin
Result := 'Descendant Cancel';
end;
function TFormDescendant.GetOkButtonCaption: string;
begin
Result := 'Descendant Ok';
end;
And code of Descendant.dfm:
inherited FormDescendant: TFormDescendant
Caption = 'FormDescendant'
end
Descendant.dpr:
requires
rtl,
vcl,
Base;
contains
Descendant in 'Descendant.pas' {FormDescendant};
When creating FormDescendant it should look like FormBase because it is simply inherited from it. And we can add some other components on this FormDescendant saving FormBase look.
But when we try to open FormDescendant in Delphi IDE, it crashes with "Error creating form: Ancestor for 'TFormBase' not found."
And that's right: Base.bpl contains only binary code and Delphi doesn't know how TBaseForm looks in design-time.
What should I do to open FormDescendant in Delphi?
I've read How do I use or resolve issues with visual form inheritance in Delphi? and Register custom form so I can inherit from it from multiple projects, without copying the form to the Object Repository folder
But those advices didn't help.
Is there a way to open FormDescendant in design-time without sources of TFormBase?
Here're the projects of the example for experiments: http://yadi.sk/d/IHT9I4pm1iSOn
You can provide a stub unit with (some of the) implementation code stripped, only the .dfm and interface has to be identical. This is what Allen Bauer did for his Opening Doors article showing how to implement dockable IDE forms.
Your developers will then need to first open the stub form unit and then they will be able to open the descendant form.
Look at this sample:
//----------------------------------------------------------------------------
type
ISomeInterface = interface
procedure SomeMethod;
end;
// this is wrong, but illustrates that, what i need:
TSomeClassWhichImplementsSomeInterface = class of ISomeInterface;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
end;
...
// TMyClass implements ISomeInterface, so i can pass it into Dummy:
Dummy(TMyClass);
//----------------------------------------------------------------------------
Of course i can inherit TMyClass and use it childs, but I don't need this. I want to use another classes with their own hierarchy, just adding into them implementation of ISomeInterface (because there are no multiple-inheritance avaiable in Object Pascal, like in C++).
I know it may be looked crazy, don't ask me why I need this, just say - it is possibly to implement or not. Thanks a lot!
I think what you are looking for is this:
procedure Dummy;
var Intf : ISomeInterface;
begin
if Assigned(gHardCodedPointer) and Supports(gHardCodedPointer,ISomeInterface,Intf) then
Intf.SomeMethod
end;
If it's not, I have no clue about what you are trying to achieve there...
You can declare metaclasses, but you cannot define them in terms of what interfaces the base class implements. Interface implementation can only be checked at run time.
You can pass your Dummy function a metaclass, but you cannot use that metaclass to type-cast your plain pointer to a more specific type. Type-casting is a compile-time operation, but the actual value of the metaclass parameter isn't known until run time. The best you can do is type-cast it to the metaclass's base class. Then you can call all the methods that are defined in that base class.
But it seems you don't actually care what the base class is, as long as the class implements your interface. In that case, you can ignore the metaclass parameter. Type-cast your pointer to be a TObject (or, better yet, declare gHardCodedPointer to be a TObject in the first place), and then use the Supports function to get the interface reference.
var
SupportsInterface: Boolean;
Some: ISomeInterface;
begin
SupportsInterface := Supports(TObject(gHardCodedPointer), ISomeInterface, Some);
Assert(SupportsInterface, 'Programmer stored bad class instance in gHardCodedPointer');
Some.SomeMethod;
end;
If you really care about the metaclass parameter, you can add some enforcement for it, too. You can check whether the given class implements your interface, and you can check whether the object in gHardCodedPointer is an instance of that class:
Assert(ASomeClassToWorkWith.GetInterfaceEntry(ISomeInterface) <> nil);
Assert(TObject(gHardCodedPointer).InheritsFrom(ASomeClassToWorkWith));
But notice that you don't need to check either of those results to be able to call SomeMethod on gHardCodedPointer. They don't really matter.
By the way, the only hard-coded pointer value you can hope to have in Delphi is nil. All other pointer values are addresses that are very hard to predict at compile time because the compiler, the linker, and the loader all determine where everything really goes in memory. I suggest you come up with some other name for that variable that more accurately describes what it really holds.
Why can't you use the interface reference?
But, assuming there is a good reason for that, this might help.
As you have found out, you can't do class of on an interface.
What's more you can't use a variable value to cast anything to anything else. Casting is hardwired telling the compiler that you know the reference you are casting is of a specific type. Trying to do that with a var such as your ASomeClassToWorkWith parameter is going to produce errors as it goes against the very nature of casting.
Code below is not something I'd recommend, but it compiles and I think it does what you want. What it does is use a "dummy" ancestor and employs polymorfism to get the compiler to call the method on the correct type. If you do not mark SomeMethod as virtual, you will get the dummy ancestor's message on both button clicks.
The Instance function in the interface is there to show you a means of getting to the implementing instance of an interface without using RTTI. Just be aware of the caveat of this when using interface delegation: you may not get the instance you are expecting.
type
TForm1 = class(TForm)
TSomethingBtn: TButton;
TMyClassBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure TSomethingBtnClick(Sender: TObject);
procedure TMyClassBtnClick(Sender: TObject);
private
{ Private declarations }
FSomething: TObject;
FMyClass: TObject;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TSomething = class; // forward;
TSomethingClass = class of TSomething;
ISomeInterface = interface
procedure SomeMethod;
function Instance: TSomething;
end;
TSomething = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
var
gHardCodedPointer: Pointer; // no matter
procedure Dummy(aSomething: TSomething);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
aSomething.SomeMethod;
end;
type
TMyClass = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual;
function Instance: TSomething;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSomething := TSomething.Create;
FMyClass := TMyClass.Create;
end;
{ TMyClass }
function TMyClass.Instance: TSomething;
begin
Result := TSomething(Self);
end;
procedure TMyClass.SomeMethod;
begin
ShowMessage('This comes from TMyClass');
end;
{ TSomething }
function TSomething.Instance: TSomething;
begin
Result := Self;
end;
procedure TSomething.SomeMethod;
begin
ShowMessage('This comes from the "dummy" ancestor TSomething');
end;
procedure TForm1.TMyClassBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FMyClass;
Dummy(TSomething(gHardCodedPointer));
end;
procedure TForm1.TSomethingBtnClick(Sender: TObject);
begin
// Presume this has been set elsewhere
gHardCodedPointer := FSomething;
Dummy(TSomething(gHardCodedPointer));
end;
It seems I see what you want to do. You just have to use what MS and partners implemented in the core of interfaces, use guids. Below is the example, but you should definitely use your own guid with CTRL+SHIFT+G in IDE
...
type
ITestInterface = interface
['{2EA2580F-E5E5-4F3D-AF90-2BBCD65B917B}']
procedure DoSomething;
end;
TTestObject = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
TTestObject2 = class(TInterfacedObject, ITestInterface)
procedure DoSomething;
end;
...
procedure TestMethod(Obj: TInterfacedObject);
var
Intf: ITestInterface;
begin
if (Obj as IUnknown).QueryInterface(ITestInterface, Intf) = S_OK then
Intf.DoSomething;
end;
{ TTestObject }
procedure TTestObject.DoSomething;
begin
MessageDlg('This is TTestObject showing something', mtInformation, [mbOk], 0)
end;
{ TTestObject2 }
procedure TTestObject2.DoSomething;
begin
MessageDlg('This is TTestObject2 showing something', mtInformation, [mbOk], 0)
end;
procedure TForm2.Button1Click(Sender: TObject);
var
Obj1, Obj2: TInterfacedObject;
begin
Obj1:=TTestObject.Create;
Obj2:=TTestObject2.Create;
TestMethod(Obj1);
TestMethod(Obj2);
end;
Even if you could, you couldn't typecast the interface with a interface-var anyway.
Same as with classes when you typecast a pointer to a metaclass, you'll get something of type metaclass (class of), not something of the type that is in metaclass.
With classes you solve this by typecast to the lowest common class in the hierachy. You can do the same with interfaces. ... If they inherit from eachother.
I think you have to use the interface, not the class:
procedure Dummy(ASomeClassToWorkWith: ISomeInterface);
begin
// actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
// must implement SomeMethod, so i can make something like this:
ASomeClassToWorkWith.SomeMethod;
end;
You just have to think amout reference counting
If you realy want the object instance you could change the interface like this:
type
ISomeInterface = interface
procedure SomeMethod;
function ImplementedInObject: TObject;
end;
procedure Dummy(ASomeInterfaceToWorkWith: ISomeInterface);
var
ASomeObjectToWorkWith: TObject;
begin
ASomeInterfaceToWorkWith.SomeMethod;
ASomeObjectToWorkWith := ASomeInterfaceToWorkWith.ImplementedInObject;
// Do what is needed with object
end;
...
type
TMyClass = class(TInterfacedObject, ISomeInterface)
function ImplementedInObject: TObject;
end;
function TMyClass.ImplementedInObject: TObject;
begin
Result := Self;
end;
The difference when calling code via interface variable or via variable pointing to an instance of a class that implements methods of the same interface is that different virtual method tables (VMT) are used, i.e. in a VMTs of an interface there will be only interface methods (plus AddRef, Release and QI, of course), in a VMT of a class there will be all virtual methods of that class.
That means that your code
ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
will be compiled to call TSomeClassWhichImplementsSomeInterface.SomeMethod directly instead of virtual method in VMT of ISomeInterface through interface pointer.
Even more, since interfaces cannot declare class methods and class attributes, an interface type is not a object (while class is an object), therefore "class of interface" does not make any sence.
You can add intermediate abstract class and declare you "class of interface" as class of the intermediate class:
type
TInterfacedObjectWithISomeInterface = class(TInterfacedObject, ISomeInterface)
procedure SomeMethod; virtual; abstract;
end;
TSomeClassWhichImplementsSomeInterface = class of TInterfacedObjectWithISomeInterface;
procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
...
type
TMyClass = class(TInterfacedObjectWithISomeInterface)
procedure SomeMethod; override;
end;