How to assign a parent to an object using only the parent object name - delphi-7

Basically, I have 8 panels and I want to assign to all of them a picture by using a loop, to do that I used a TComponent variable and an image that I create during runtime. But I am unable to find a way to assign that image a parent using this string ('pnlDisplay' + inttostr(i)).
So my code looks something like this:
var
imgPanel : TImage;
cPanel : TComponent;
begin
for i := 1 to 8 do
begin
cPanel := FindComponent('pnlDisplay' + inttostr(i));
imgPanel := TImage.Create(cPanel);
imgPanel.Parent := cPanel; //Here is my problem
imgPanel.Picture.LoadFromFile('Pic' + inttostr(i) + '.jpg');
imgPanel.Visible := True;
end;
end
Any help or even another way to achieve this would be helpful.

FindComponent() returns a TComponent, whereas the Parent property expects a TWinControl instead. Assuming FindComponent() is returning the correct component, just type-cast it:
imgPanel.Parent := TWinControl(cPanel);

Related

How to set a procedure (function) to an event in delphi 7?

I am writing which component will run through the array like ['form1.Button1', 'form1.memo1', 'form1'] - like
And put the showms2 handler on it (form1.Button1.onclick: = showms2)
var
comp: array of Tcomponent;
met: Tmethod;
start off
setlength (comp, Lines.Count);
for i: = 0 to Lines.Count-1 do
start off
comp [i]: = (FindComponent (Lines.Names [i]) as TControl);
met: = GetMethodProp (comp [i], 'OnClick');
meth.Code: = form1.MethodAddress ('showms2');
met.Data: = 0;
// When splitting into elements, nothing happens, is there an alternative?
FindComponent() does not work the way you are using it. You need to specify only the name of a component that is directly owned by the component being searched, you can't specify a chain of components, ie Form1.FindComponent('Form1.Button1') won't ever work, but Form1.FindComponent('Button1') will work, if Form1 owns Button1.
Also, if you are going to set both TMethod.Code and TMethod.Data then calling GetMethodProp() is completely redundant and should be removed.
Also, you need to use SetMethodProp() to actually assign the TMethod to the target event.
Try this instead:
var
comp: TComponent;
met: TMethod;
i: Integer;
begin
for i := 0 to Lines.Count-1 do
begin
comp := FindComponent(Lines.Names[i]);
if comp <> nil then
begin
if IsPublishedProp(comp, 'OnClick') then
begin
meth.Code := Form1.MethodAddress('showms2');
meth.Data := Form1;
SetMethodProp(comp, 'OnClick', met);
end;
end;
end;
end;

Function to load PNG Image from ResourceStream returns nothing

In Delphi 10.1 Berlin, I'm trying to change a picture on a form by loading a PNG image from a resource.
I've followed this:
Load image from embedded resource
and used a TWICImage to automatically handle different possible image formats.
In this case I specifically want to use a PNG for transparency.
For some reason the function I've created returns nothing.
However, if I call result.savetofile('test.png') within the function the resource is succesfully saved, which verifies that the resource exists in the EXE and has been found.
function LoadImageResource(NativeInstance: NativeUInt; ImageResource: string): TWICImage;
var
Strm: TResourceStream;
WICImage: TWICImage;
begin
Strm := TResourceStream.Create(NativeInstance, ImageResource, RT_RCDATA);
try
Strm.Position := 0;
WICImage := TWICImage.Create;
try
WICImage.LoadFromStream(Strm);
result := WICImage; //these return empty
result.savetofile('test.png'); //this succesfully saves the resource to disk
finally
WICImage.Free;
end;
finally
Strm.Free;
end;
end;
Outside of the function, if I attempt to assign the image by calling for example Image1.picture.assign(LoadFromResource(...)) or Image1.picture.graphic := LoadFromResource(...) nothing gets assigned. And If I then call Image1.savetofile('test.png') I get an access violation error.
What might I be missing?
The problem is that you are destroying the image that you return. It's important to understand that classes are reference types in Delphi. So after the assignment to Result, in your code, you still have only a single instance, but two references to that same single instance.
You need to remove the call to Free.
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
Result.LoadFromStream(Strm);
finally
Strm.Free;
end;
end;
A little tweak is needed to make the function exception safe:
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
try
Result.LoadFromStream(Strm);
except
Result.Free;
raise;
end;
finally
Strm.Free;
end;
end;
When you call the function it behaves like a constructor. It either succeeds and returns a new instance, handing over ownership to the caller. Or it raises an exception. Accordingly I would name the function CreateImageFromResource.

Setting `InitialDir` property of `TSelectDirectoryDialog` mutiple times

I'm trying to use the InitialDir property of TSelectDirectoryDialog:
procedure selectfolder;
begin
SelectDirectoryDialog1.InitialDir := strPath;
If SelectDirectoryDialog1.Execute then begin
Edit1.Text := SelectDirectoryDialog1.FileName;
end;
end;
The first time (with strPath=X) it works fine, the second time I'm using this procedure (with strPath=Y) it doesn't use the new path (Y), but the one I selected previously.
Do I have to call a method, something like SelectDirectoryDialog1."reinitiate" before I set the InitialDir property a second time? Another idea would be to use a different property then InitialDir, but I don't know which one would do the job. Unfortunately the doc page for TSelectDirectoryDialog is currently down, so I don't have a description for the available methods/properties for TSelectDirectoryDialog and the ones I tested to solve my problem.
I got it to work if I create the TSelectDirectoryDialog class instance manually and don't use the one from the Component Palette to create it "on the form". Then I just destroy the instance and create a new one.
procedure TForm1.Button4Click(Sender: TObject);
var SelectDirectoryDialogManual : TSelectDirectoryDialog;
begin
SelectDirectoryDialogManual := TSelectDirectoryDialog.Create(nil);
SelectDirectoryDialogManual.InitialDir := 'C:\Windows';
if SelectDirectoryDialogManual.Execute then ShowMessage(SelectDirectoryDialogManual.FileName);
SelectDirectoryDialogManual.Free;
end;
But how do I do that when I created SelectDirectoryDialog1 using the component Component Palette?
By saving and restoring the value of InitialDir before each invocation of Execute, or doing what #Sertac says in a comment, which works but is less "self-documenting" imo, ymmv.
The code below works fine for me. edInitialDir is a TEdit which saves the most recent directory selected using SelectDirectoryDialog1, which is then used for the next invocation.
procedure TForm1.Button1Click(Sender: TObject);
begin
SelectDirectoryDialog1.InitialDir := edInitialDir.Text;
if SelectDirectoryDialog1.Execute then
Caption := 'executed'
else
Caption := 'not executed';
edInitialDir.Text := SelectDirectoryDialog1.FileName;
end;
Note: All properties of SelectDirectoryDialog1 are the defaults for an instance freshly added from the Component Palette.
Regarding your comment, TSelectDirectoryDialog.Execute calls TWin32WSSelectDirectoryDialog.CreateHandle (see Dialogs.Pas, line 1219). The initial part of this is as follows:
class function TWin32WSSelectDirectoryDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
var
Options : TOpenOptions;
InitialDir : string;
Buffer : PChar;
bi : TBrowseInfo;
iidl : PItemIDList;
biw : TBROWSEINFOW;
Bufferw : PWideChar absolute Buffer;
InitialDirW: widestring;
Title: widestring;
DirName: string;
begin
DirName := '';
InitialDir := TSelectDirectoryDialog(ACommonDialog).FileName;
Options := TSelectDirectoryDialog(ACommonDialog).Options;
if length(InitialDir)=0 then
InitialDir := TSelectDirectoryDialog(ACommonDialog).InitialDir;
if length(InitialDir)>0 then begin
// remove the \ at the end.
if Copy(InitialDir,length(InitialDir),1)=PathDelim then
InitialDir := copy(InitialDir,1, length(InitialDir)-1);
// if it is a rootdirectory, then the InitialDir must have a \ at the end.
if Copy(InitialDir,length(InitialDir),1)=DriveDelim then
InitialDir := InitialDir + PathDelim;
end;
From this you can see that it initially attempts to derive the value of InitialDir from the FileName property and only if that results in an empty string does it attempt to use the stored value of the InitialDir property. This is why the dialog uses the previously-selected directory the next time Execute is invoked, which is exactly what you should be expecting, even if you do not like it. The only way to re-use the initial value of IntialDir from second and subsequent invocations is to restore it before each one.

How to dislay correct x-axis (bottom axis) label from datasource using Teechart (Delphi)

I would like to ask some help on displaying my datasource’s clientname at the bottom of my stacked bar chart. It seems from all the examples that I researched, the bottom chart axis label is set "automatically" by TeeChart looking at the datasource. However I cant seem to get it to work. Below is a picture of what I am trying to achieve.
Picture of what I am trying to achieve
I have three series' which I use to build the stacked chart. I have included a picture of each datasource I use for each query.
Datasources for three series' queries
From my research it seems I can also use the DBChart1GetAxisLabel() to custom set the labels. But I am struggling to understand how to ensure that the correct custom label name is associated with the correct "clientname" from my queries.
Here is a code sample of how I build the charts:
procedure TfrmSupplierAnalytics.btnOKClick(Sender: TObject);
var
S,NewTypeStr, test, clientSql : string;
var seriasNormalOrders:TBarSeries;
var seriasCreditNoteOrders:TBarSeries;
var seriasPartialOrders:TBarSeries;
N, i : integer;
begin
qCreditNoteOrders.Close;
qNormalOrders.Close;
qPartialOrders.Close;
qGetClientIdFromName.Close;
qClients.Close;
DBChart1.CleanupInstance;
DBChart1.ClearChart;
try
for N := 0 to clbClients.Items.Count-1 do
if clbClients.State[N] = cbChecked then begin
test := string(clbClients.Items[N]);
NewTypeStr := NewTypeStr + '(E.clientid = '+
IntToStr(FindClientID(test)) + ')';
clientSql := clientSql + NewTypeStr;
NewTypeStr := ' or ';
end;
except
on E : Exception do
ShowMessage(E.ClassName+' error raised, with message :
'+E.Message);
end;
OpenQueryCreditNoteOrders(clientSql);
OpenQueryPartialOrders(clientSql);
OpenQueryNormalOrders(clientSql);
seriasNormalOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasNormalOrders);
seriasCreditNoteOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasCreditNoteOrders);
seriasPartialOrders :=TBarSeries.Create(self);
DBChart1.AddSeries(seriasPartialOrders);
seriasNormalOrders.MultiBar := mbStacked;
seriasCreditNoteOrders.MultiBar := mbStacked;
seriasPartialOrders.MultiBar := mbStacked;
seriasNormalOrders.Marks.Visible := true;
seriasNormalOrders.MarksLocation:= mlCenter;
seriasNormalOrders.MarksOnBar := True;
seriasNormalOrders.YValues.ValueSource := 'NormalOrders';
seriasNormalOrders.DataSource := qNormalOrders;
seriasNormalOrders.Title := 'Correct Orders';
seriasNormalOrders.Marks.Visible := True;
seriasNormalOrders.Marks.AutoPosition := true;
seriasCreditNoteOrders.YValues.ValueSource := 'CreditNoteOrders';
seriasCreditNoteOrders.DataSource := qCreditNoteOrders;
seriasCreditNoteOrders.Title := 'Credit Note Orders';
seriasPartialOrders.YValues.ValueSource := 'PartialOrders';
seriasPartialOrders.DataSource := qPartialOrders;
seriasPartialOrders.Title := 'Short Orders';
seriasNormalOrders.CheckDataSource;
seriasCreditNoteOrders.CheckDataSource;
seriasPartialOrders.CheckDataSource;
end;
So, just to sum up, is there some setting in my code which I am missing that would show the "clientname" below each stacked bar, or must I use custom labels?
If I must use custom labels, I would appreciate some direction on how to ensure that I replace the correct "clientname" from the datasource to the correct ValueIndex in the DBChart1GetAxisLabel?
Thanks in advance.
I managed to get an answer.
You could set the XLabelsSource to show the text from the DataSource and then set the series Marks.Style to smsValue to force it showing values instead of showing the labels. Ie:
<pre>
procedure TForm1.FormCreate(Sender: TObject);
var ADOQuery1: TADOQuery;
i: Integer;
begin
ADOQuery1:=TADOQuery.Create(Self);
with ADOQuery1 do
begin
ConnectionString:='Provider=MSDASQL.1;Persist Security Info=False;Data
Source=TeeChart Pro Database';
SQL.Add('SELECT SALARY, LASTNAME from Employee WHERE LASTNAME='#39'Smith'#39);
end;
for i:=0 to 1 do
with DBChart1.AddSeries(TBarSeries) as TBarSeries do
begin
XLabelsSource:='LASTNAME';
DataSource:=ADOQuery1;
MultiBar:=mbStacked;
YValues.ValueSource:='SALARY';
Marks.Style:=smsValue;
end;
ADOQuery1.Open;
end;
</pre>
I tested it in my project and it works.

Virtual Method Table on Free Pascal

What I'm trying to do is to get the list of fields in a class without an instance... for example:
TAClass=class
a_: Integer;
b_: Integer;
constructor (a,b Integer);
end;
I'm not being able to get the fieldTable from the VMT:
ovmt: PVmt;
ftable: PVmtFieldTable;
finfo: PVmtFieldEntry;
ovmt:=PVmt(TAClass);
ftable := ovmt^.vfieldtable
finfo := ftable^.fields[0]
this way I'm not gettig the list of fields
any help is welcome,
thanks in advance
Afaik the field tables in classic delphi and FPC only work for published fields. Published fields must be class fields (value types like integer must go via properties). Newer Delphi's also allow RTTI for non published fields, but that works differently (different untis), and FPC doesn't support that yet.
I hacked together a small demonstration example since the help for typinfo seems to be light on examples. Note the tpersistent derivation.
{$mode delphi}
uses typinfo,classes;
type
TAClass=class(Tpersistent)
a: tstringlist;
b: tlist;
end;
var
ovmt: PVmt;
FieldTable: PVMTFieldTable;
PVMTFieldEntry;
i: longint;
begin
ovmt := PVmt(TAClass);
while ovmt <> nil do
begin
FieldTable := PVMTFieldTable(ovmt^.vFieldTable);
if FieldTable <> nil then
begin
FieldInfo := #FieldTable^.Fields[0];
for i := 0 to FieldTable^.Count - 1 do
begin
writeln(fieldinfo^.name);
FieldInfo := PvmtFieldEntry(PByte(#FieldInfo^.Name) + 1 + Length(FieldInfo^.Name));
end;
end;
{ Try again with the parent class type }
ovmt:=ovmt^.vParent;
end;
end.

Resources