I have two different units in Delphi.
The first unit has a procedure named ApplyUpdates and all it does is run a query.
I need to access this procedure from another unit, and when I do so I get an error message that says "Access violation"".
The procedure in the first unit is:
procedure TForm1.ApplyUpdates ( var AppType: string);
begin
qryApplyUpdates.ParamByName('type').DataType := ftString;
qryApplyUpdates.ParamByName('type').ParamType := ptInput;
qryApplyUpdates.ParamByName('type').AsString := AppType;
qryApplyUpdates.ExecSQL;
end;
From the second unit I call this procedure as:
var
UserForm: TForm1;
begin
UserForm.ApplyUpdates (AppType );
end;
When I debug it, it stops right at the first line of the procedure.
My question is: What am I doing wrong that I cannot access this procedure from the first unit?
If the form is autocreated, don't use the local variable at all:
// The default declared variable for an autocreated form is the classname without the prefix
Form1.ApplyUpdates(AppType);
If the form is not autocreated, you have to create the form before you can use it.
var
UserForm: TForm1;
begin
UserForm := TForm1.Create(nil);
try
UserForm.ApplyUpdates(AppType);
finally
UserForm.Free;
end;
end;
Related
Running into a runtime error when I open a modal form (Form2) that, on create, calls another procedure that does somehting with a VCL component. The following program demonstrates the issue.
This is the code on the modal form:
procedure DoLabel;
begin
form2.Label1.Caption := 'A';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel;
end;
This compiles well. However, the program crashes on opening the modal form. The debugger says: access violation at address xxxx. It is probably a basic error, but what am I doing wrong? And how to solve this?
You are using the global Form2 variable, which has not been assigned yet (or at all) while the TForm2 object is still being constructed.
You need to change your code to not rely on that variable during construction (and preferably remove it entirely, unless TForm2 is auto-created at startup, which it does not sound like it is).
For instance, pass the Form's Self pointer, or even its TLabel pointer, as an input parameter to DoLabel(), eg:
procedure DoLabel(ALabel: TLabel);
begin
ALabel.Caption := 'A';
end;
procedure DoFormStuff(AForm: TForm2);
begin
// use AForm as needed...
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel(Label1);
DoFormStuff(Self);
end;
Though, in this case, it would make more sense to have DoFormStuff(), and possible DoLabel() too, be a member of the TForm2 class instead of free functions:
procedure TForm2.FormCreate(Sender: TObject);
begin
DoLabel;
DoFormStuff;
end;
procedure TForm2.DoLabel;
begin
Label1.Caption := 'A';
end;
procedure TForm2.DoFormStuff;
begin
// use Self as needed...
end;
I have ported an application from ADO to FireDAC applying several RegExp replaces on the source code to convert the ADOQuery, ADOTables, ADOCommands, ADOStoredProcs, etc. ... to the corresponding FireDAC components.
It has worked fine, but now when running that application plenty of forms raise errors because of the type of the persistent fields being different than the type expected (the one defined from ADO when the persistent field was created).
I'm trying to make a list of those errors, creating an instance of all my forms and opening their datasets with persistent fields, and logging the errors. I can get the list of forms from the project source code, but when I try to use FindClass to create each form I get an error telling that the class has not been found.
Is there any other way to create a Form/DataModule from its class name ?.
This is my current code:
class procedure TfrmCheckFormularis.CheckDatasets(ProjecteFile: string);
var frmCheckFormularis: TfrmCheckFormularis;
Projecte: string;
rm: TMatch;
cc: TComponentClass;
c: TComponent;
i: integer;
Dataset: TFDQuery;
begin
Projecte := TFile.ReadAllText(ProjecteFile);
frmCheckFormularis := TfrmCheckFormularis.Create(Application);
try
with frmCheckFormularis do begin
Show;
qryForms.CreateDataSet;
qryErrors.CreateDataSet;
// I get a list of all the forms and datamodules on my project
for rm in TRegEx.Matches(Projecte, '^(?:.* in '')(?<File>.*)(?:'' {)(?<Class>.*)(?:},)', [roMultiline]) do begin
qryForms.AppendRecord([rm.Groups['File'].Value, rm.Groups['Class'].Value]);
end;
// Check every form and datamodule
qryForms.First;
while not qryForms.Eof do begin
cc := TComponentClass(FindClass(qryFormsClass.Value));
c := cc.Create(frmCheckFormularis);
try
for i := 0 to c.ComponentCount - 1 do begin
if c.Components[i] is TFDQuery then begin
Dataset := c.Components[i] as TFDQuery;
// When the Dataset has persistent fields, I open it to check if the persistent fields are correct
if Dataset.FieldDefs.Count > 1 then begin
try
Dataset.Open;
except
on E: Exception do qryErrors.AppendRecord([c.Name, Dataset.Name, E.Message]);
end;
end;
end;
end;
finally
c.Free;
end;
qryForms.Next;
end;
end;
finally
frmCheckFormularis.Free;
end;
end;
Thank you.
Using the "new" RTTI in Delphi is quite easy. The following code will (hopefully*) create one instance of each form in your application:
procedure TForm1.Button1Click(Sender: TObject);
var
Context: TRttiContext;
&Type: TRttiType;
InstanceType: TRttiInstanceType;
begin
Context := TRttiContext.Create;
for &Type in Context.GetTypes do
begin
if (&Type.TypeKind = tkClass) and &Type.IsInstance then
begin
InstanceType := TRttiInstanceType(&Type);
if InstanceType.MetaclassType.InheritsFrom(TForm) and (InstanceType.MetaclassType <> TForm) then
TFormClass(InstanceType.MetaclassType).Create(Application){.Show}; // optionally show it
end;
end;
end;
* Technically, it will create one instance of each proper descendant class of TForm.
I'm trying to write a plugin for Delphi 5 that will store the paths to our testing exes in the DOF so that there is a direct association between the project and the tests for that project. When I go to add my own module to the DOF file, something like
[DUint Plugin]
IntegrationTestExe=Somepath
UnitTestExeList=Some;Path;
Anytime I go to add this either manually or through code, when I save the project, the lines I add are removed. I chalked this up to maybe the IDE just doesn't allow custom modules in the DOF.
However, we use a third party plugin called EurekaLog. EurekaLog injects its own vars into the DOF and when you save, those vars are not removed. I copied much of the code over so I could test if the EurekaLog code would work properly (through some magic) but their code just wrote their module to the DOF and did nothing else special.
Does anyone know how this is accomplished in EurekaLog? Do I need to register my module somewhere so that the IDE knows not to remove it?
Update After a bit of experimenting, it seems that saving settings to the DOF is actually noticeably more reliable than saving them to the DSK file.
Add another TEdit to the form and create LoadDOFSettings and SaveDOFSettings
analogous to the existing LoadSettings and SaveSettings and call them on receipt
of the DesktopLoad and DesktoSave notifications. The SaveDOFSettings doesn't need to be called via the Timer1 event because the renaming doesn't seem to happen to the DOF.
Original answer
I suggest that before reading this answer, you do a File | Close All in the IDE,
create a new package, add the unit below into it and install it in the IDE.
The purpose of the package is two-fold, firstly to show how to save custom settings in the DSK file and secondly to give you an idea of what event information about project
files you can get from the IDE via the services in the ToolsAPI unit..
Once you've installed the package, keep an eye on its form, which shows you file notifications in the upper memo as you open, work on and close a project. There are
several things to notice:
When you open a project, the last notification you receive is about its DSK file having been opened.
Not every file type is the subject of a notification. In particular, you don't receive any notifications specifically about the DOF file, so if you want to write to it and later read from it, you have to make assumptions about when it's safe (or not) to do so, and this is possibly why you have run into the problem you are asking about.
When you do a Close All on the project, the last file change you get notified about is the DSK being written. The catch is that it's initially written to a file of the same name but with the extension .$$$. Very soon afterwards, but asaics you can't tell exactly when, this .$$$ file is renamed to .DSK.
The form created by the code below has an edit box, edMyValue' which can be used to set a value in a section of the DSK file calledMySettingsand which is reloaded the next time the project is opened. The writing of theMySettings` section of the DSK file is triggered aby a TTimer with a 2-second delay to give the IDE time to write and rename the DSK file as I've described. This obviously provides the opportunity for a race condition.
You might like to refer to
http://www.gexperts.org/open-tools-api-faq/#dsk
(GExperts is the IDE add-in tool that's been around since very early days of Delphi)
The section of the article is talking about the current project's .DSK file. Like the DOF, this is in INI file format, with sections like
[Closed Files]
[Modules]
[EditWindow0]
[View0]
As you'll see it says
check for the ofnProjectDesktopLoad and ofnProjectDesktopSave NotifyCode values. When you see one of those, you can save/load values from the file indicated by the FileName parameter using a class such as TIniFile.
Perhaps it's a bit trickier than the article suggests, because of the renaming business.
Have fun!
unit IDEEventsu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ToolsAPI, Grids, IniFiles;
type
TFileEventsForm = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
edMyValue: TEdit;
btnClear: TButton;
Timer1: TTimer;
Memo2: TMemo;
procedure btnClearClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
function GetCurrentProject: IOTAProject;
public
// The following are using interfaces accessible via the ToolsAPI
Services: IOTAServices;
ProjectGroup : IOTAProjectGroup;
Project: IOTAProject;
Options : IOTAProjectOptions;
ModServices: IOTAModuleServices;
Module: IOTAModule;
NotifierIndex: Integer; // This is used to disconnect our notifier from the IDE
IsSetUp : Boolean;
SetUpCount : Integer;
DskFileName : String;
procedure SetUp;
procedure SaveSettings;
procedure LoadSettings;
end;
var
FileEventsForm: TFileEventsForm;
procedure Register;
[...]
uses
typinfo;
type
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier)
// This is the class we use to receive file notication events from the IDE via the
// interfaces in ToolsAPI.Pas
//
// It needs to implement the IOTANotifier and IOTAIDENotifier interfaces and,
// once registered with the IDE, the IDE calls its methods as a kind of call-back
// mechanism so that it gets notified of file events
//
// Note that this file also provides a form for displaying the received event
// notifications and that the IOTANotifier and IOTAIDENotifier interfaces could
// just as easily be implemented by the form itself
protected
procedure AfterCompile(Succeeded: Boolean);
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
end;
procedure Register;
// This is necessary to register the package in the IDE
var
Notifier : TIdeNotifier;
begin
FileEventsForm:= TFileEventsForm.Create(Nil);
FileEventsForm.Services := BorlandIDEServices as IOTAServices;
Notifier := TIdeNotifier.Create;
Notifier.Form := FileEventsForm;
FileEventsForm.NotifierIndex := FileEventsForm.Services.AddNotifier(TIdeNotifier.Create);
end;
procedure CloseDown;
begin
FileEventsForm.Services.RemoveNotifier(FileEventsForm.NotifierIndex);
FileEventsForm.Close;
FileEventsForm.Free;
end;
function NotifyCodeString(NotifyCode : TOTAFileNotification) : String;
begin
Result := Copy(GetEnumName(TypeInfo(TOTAFileNotification), Ord(NotifyCode)), 4, MaxInt);
end;
procedure TIdeNotifier.AfterCompile(Succeeded: Boolean);
begin
end;
procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
end;
procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
begin
if True {NotifyCode in [ofnProjectDesktopLoad, ofnActiveProjectChanged]} then begin
FileEventsForm.Show;
FileEventsForm.Memo1.Lines.Add(Format('%s file: %s', [NotifyCodeString(NotifyCode), FileName]));
case NotifyCode of
ofnProjectDesktopLoad,
ofnDefaultDesktopLoad : begin
FileEventsForm.DskFileName := FileName;
FileEventsForm.LoadSettings;
end;
ofnProjectDesktopSave,
ofnDefaultDesktopSave : begin
if True{CompareText(ExtractFileExt(FileName), '.DSK') = 0} then begin
FileEventsForm.Caption := FileName;
FileEventsForm.Timer1.Enabled := True; // causes DSK file to be updated after Timer1.Interval (=2000ms)
end;
end;
end; { case }
end;
end;
procedure TFileEventsForm.btnClearClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
function TFileEventsForm.GetCurrentProject: IOTAProject;
var
i: Integer;
begin
Result := nil;
ModServices := BorlandIDEServices as IOTAModuleServices;
for i := 0 to ModServices.ModuleCount - 1 do
begin
Module := ModServices.Modules[i];
if Supports(Module, IOTAProjectGroup, ProjectGroup) then begin
Result := ProjectGroup.ActiveProject;
Options := Result.ProjectOptions;
Exit;
end
else if Supports(Module, IOTAProject, Project) then
begin // In the case of unbound packages, return the 1st
if Result = nil then begin
Result := Project;
Options := Result.ProjectOptions;
end;
end;
end;
end;
procedure TFileEventsForm.SetUp;
begin
Project := GetCurrentProject;
Inc(SetUpCount);
Caption := 'Setup done ' + IntToStr(SetUpCount);
IsSetUp := True;
end;
procedure TFileEventsForm.LoadSettings;
var
Ini : TMemIniFile;
S : String;
begin
Ini := TMemIniFile.Create(DSKFileName);
try
S := Ini.ReadString('MySettings', 'Name', 'no value');
edMyValue.Text := S;
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.SaveSettings;
var
Ini : TMemIniFile;
S : String;
begin
S := DSKFileName;
Caption := 'Saving: ' + S;
Ini := TMemIniFile.Create(S);
try
Ini.WriteString('MySettings', 'Name', edMyValue.Text);
Ini.UpdateFile;
Ini.ReadSections(Memo2.Lines);
Memo2.Lines.Add('This file : ' + DSKFileName);
edMyValue.Text := '?';
finally
Ini.Free;
end;
end;
procedure TFileEventsForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
SaveSettings;
end;
initialization
finalization
CloseDown;
end.
There's an overloaded version of the Execute function of the TDBXCallback calls in Data.DBXJSon that looks like this
function Execute(Arg: TObject): TObject; overload; virtual; abstract;
Which in my Datasnap client, I've implemented like this:
type
ServerChannelCallBack = class(TDBXCallback)
public
function Execute(const Arg: TJSONValue): TJSONValue; overload; override; // this works!
function Execute(Arg: TObject): TObject; overload; override; // this doesn't
end;
function ServerChannelCallBack.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
Result := TObject.Create; // is this correct?
try
if Arg is TStringList then
begin
FormClient.QueueLogMsg('ServerChannel', 'Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
FormClient.QueueLogMsg('ServerChannel', TStringList(Arg)[i]);
end;
finally
end;
end;
This is called from the Datasnap server like this:
procedure TFormServer.Button2Click(Sender: TObject);
var
sr: TStringList;
begin
sr := TStringList.Create;
try
sr.Add('one');
sr.Add('two');
ServerContainer2.DSServer1.BroadcastObject('SERVERCHANNEL', sr);
finally
// sr
end;
end;
This is following on from an example in the video presented by Matt DeLong
Heavyweight Callbacks with DataSnap - Part 1: Thick Client
The callback works perfectly, but only exactly once! On the second call from the server (Button2Click), I get an AV in the client. It might be a bug in the DBX code. I don't know. I can't trace in there. Or perhaps I have initialized the Result from the ServerChannelCallBack.Execute incorrectly. Any assistance is appreciated.
UPDATE
The callback is registered on the client like this:
TFormClient = class(TForm)
CMServerChannel: TDSClientCallbackChannelManager;
...
private
ServerChannelCBID: string;
...
procedure TFormClient.FormCreate(Sender: TObject);
begin
ServerChannelCBID := DateTimeToStr(now);
CMServerChannel.RegisterCallback(
ServerChannelCBID,
ServerChannelCallback.Create
);
...
I'm basing this answer on the DataSnap Server + Client projects which can be downloaded from inside Delphi Seattle using `File | Open from version control'
https://radstudiodemos.svn.sourceforge.net/svnroot/radstudiodemos/branches/RadStudio_XE/Delphi/DataSnap/CallbackChannels
that's mentioned here: http://edn.embarcadero.com/article/41374.
The forms in both the server and client require a slight correction to get them to compile, name to add JSon to their Uses list.
On the server form, I've added the following:
procedure TForm3.Button1Click(Sender: TObject);
var
sr: TStringList;
begin
Inc(CallbackCount); // A form variable
sr := TStringList.Create;
try
sr.Add('Callback: ' + IntToStr(CallbackCount));
sr.Add('two');
ServerContainer1.DSServer1.BroadcastObject('ChannelOne', sr);
finally
// No need for sr.free
end;
end;
(I'm using ChannelOne for consistency with the client)
and on the client I have:
function TCallbackClient.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
// Result := TObject.Create; // is this correct?
Result := TJSONTrue.Create;
try
if Arg is TStringList then
begin
QueueLogValue('Server: Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
QueueLogValue('Server:' + TStringList(Arg)[i]);
end;
finally
end;
end;
With those variations from the code you've shown in your q, the server and client run fine, and I can click the server button as many times as I like and neither the server nor any of the clients get "stuck". So I think your problem must be specific to something in the code you are using, but at least the linked project gives you something to work from and compare with.
Btw, I changed the TCallbackClient.Execute return type to TJSONTrue.Create (same as the other override) because that's what it says in Marco Cantu's Delphi 2010 Handbook says it should return, admittedly in the context of a "lightweight" callback while a ServerMethod is executing: returning TJSONFalse tells the server to cancel the executing ServerMethod. However, the callbacks from the server work equally well with the TObject.Create you used.
I want to list name of all forms exist in my project in a ListBox Dynamically, then by clicking on each of them, list all buttons exist on that form in another ListBox.
But I don't know if it can be implemented and how it can.
In case you are on Delphi 2010 you can use RTTI to list all registered ( = somehow used in the application) form classes:
uses
TypInfo, RTTI;
procedure ListAllFormClasses(Target: TStrings);
var
aClass: TClass;
context: TRttiContext;
types: TArray<TRttiType>;
aType: TRttiType;
begin
context := TRttiContext.Create;
types := context.GetTypes;
for aType in types do begin
if aType.TypeKind = tkClass then begin
aClass := aType.AsInstance.MetaclassType;
if (aClass <> TForm) and aClass.InheritsFrom(TForm) then begin
Target.Add(aClass.ClassName);
end;
end;
end;
end;
You must somehow take care that the class is not completely removed by the linker (therefor the registered hint above). Otherwise you cannot get hands on that class with the method described.
The forms are usually listed using Screen.Forms property, ex:
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
Memo1.Lines.Clear;
for I:= 0 to Screen.CustomFormCount - 1 do
Memo1.Lines.Add(Screen.Forms[I].Caption);
end;
sabri.arslan's answer is the way to go to find all instantiated forms at run-time.
In the comments Hamid asked for a way to find unassigned forms as well. Assuming that by unassigned he means uninstantiated forms, there would be only one way to do so and that is to iterate over the registry of classes used by the vcl streaming system to instantiate components by name when a dfm is streamed in.
However, IIRC, forms are not automatically added to the registry. In fact, if you want to instantiate forms based on a string of their name, you need(ed) to add them to the class registry yourself. OP could of course do that for each of the forms in his project himself. But, that leaves the problem that the class registry used by the streaming system is implemented using var's in the implementation section of the classes unit. And therefore can't be iterated over (easily) from the outside.
So the solution would be to use the initialization section of all form units in the project and register each form in a "roll-your-own" registry with their name and class and have the registry provide the methods to iterate over the registered forms. These method can be used to populate the listbox mentioned by the OP.
To get at the TButtons on a form would then require instantiating the form (it could remain hidden) and iterating over the components using code similar to sabri.arslan's answer to find the TButton instances.
Instantiating the form would require getting the class of the form from the registry based on the form's name selected in the listbox.
Example of a simple roll-your-own form registry:
unit Unit1;
interface
uses
Classes
, Forms
, SysUtils
;
procedure RegisterForm(aName: string; aClass: TFormClass);
procedure ListForms(aNames: TStrings);
function InstantiateForm(aName: string): TCustomForm;
implementation
var
FormRegistry: TStringList;
procedure RegisterForm(aName: string; aClass: TFormClass);
begin
FormRegistry.AddObject(aName, Pointer(aClass));
end;
procedure ListForms(aNames: TStrings);
var
i: Integer;
begin
for i := 0 to FormRegistry.Count - 1 do begin
aNames.Add(FormRegistry[i]);
end;
end;
function InstantiateForm(aName: string): TCustomForm;
var
idx: Integer;
frmClass: TFormClass;
begin
Result := nil;
idx := FormRegistry.IndexOf(aName);
if idx > -1 then begin
frmClass := TFormClass(FormRegistry.Objects[idx]);
Result := frmClass.Create(nil);
end;
end;
initialization
FormRegistry := TStringList.Create;
FormRegistry.Duplicates := dupError;
FormRegistry.Sorted := True;
finalization
FreeAndNil(FormRegistry);
end.
you can use "for" loop.
procedure ListForms(lbForms:TListBox);
var
i,j:integer;
begin
for i:=0 to application.ComponentCount-1 do
if application.components[i] is tform then
begin
lbForms.add(tform(application.components[i]).Name);
end;
end;
procedure ListBox1Click(Sender:TObject);
var
ix,j,i:integer;
begin
ix:=ListBox1.ItemIndex;
if ix>=0 then
begin
for i:=0 to application.componentcount-1 do
if application.components[i] is tform then
begin
if tform(application.components[i]).name=listbox1.items.strings[ix] then
begin
for j:=0 to tform(application.components[i]).controlcount - 1 do
if tform(application.components[i]).controls[i] is tbutton then
begin
listbox2.add(tbutton(tform(application.components[i]).controls[i]).caption);
end;
break;
end;
end;
end;
end;
There is no way (easy) to find the included forms.
But if you loop through the RCdata of the resources (See (1) (2) (3)), you can find the names of the forms. But that dosn't help you creating them.
In order to make forms "findable" the have to "register" them yourself, using RegisterCLass og finding them again using FindClass. See an example here: http://www.obsof.com/delphi_tips/delphi_tips.html#Button
Do you need this to be built at run time, or would compile time information work for you?
In recent versions (Delphi 2006 and higher?), you can set a compiler option to generate XML documentation for your project. A separate XML file is generated for each unit. You could parse this XML to find and forms and look at the members for any buttons.