procedure TForm1.controlClick(Sender: TObject);
var
i: Integer;
begin
for i := 2 to Dest.Count-1 do
begin
img[i-2].Create(Form1);
with img[i-2] do begin
Parent:= Panel1;
Width:= 100;
Height:= 150;
Top:= 10;
Left:= (i-2)*100;
end;
end;
end;
img type is array of TImage, control is a tab. I want to timages to show like an android gallery. But this gives me an error Access Violation.
This looks like the classic error in creating an object. Instead of
obj.Create;
you must write:
obj := TSomeClass.Create;
In your case you need to first of all allocate the array:
SetLength(img, Dest.Count-2);
And then in the loop you write:
img[i-2] := TImage.Create(Form1);
to instantiate the images.
Related
How i can to assign differents tags to various objects (e.j: TCircle) of the same type at runtime?
Lets me explain that: I want to create various Circles at runtime and to assign to each one of them a different tag and then with on click event to show the Circle that i clicked.
This is a fragment of my code:
procedure
TPhotoX.FormCreate(Sender:
TObject);
var
FilesN: String;
S: TBitmap;
Cir: TCircle;
begin
FlowLayout1.DeleteChildren;
GetFP:= TDirectory.GetFiles(GetPathIma, '*jpg', TSearchOption.soTopDirectoryOnly);
for FilesN in GetFP do
VertScrollBox1.BeginUpdate;
Cir.TCircle.Create(Self);
Cir.Parent:= FlowLayOut1;
Cir.Fill.Bitmap.WrapMode:=TWrapMode.TileOriginal;
Cir.Fill.Kind:= TBrushkind.Bitmap;
Cir.Height:= 85;
Cir.Width:= 85;
//...more circle's properties next including the Circle's Tag property that i ignore to implement
// Sorry i'm Delphi's Beginner but Delphi's power believer too!!! :-)
Cir.OnClick: CirClick;
try
S.TBitmap.Create;
FlowLayout1.AddObject(Cir);
S.LoadThumbnailsFromFile(FilesN, 150, 150);
Cir.Fill.Bitmap.Bitmap:=S;
Cir.Repaint;
VertScrollBox1.EndUpdate;
finally
S.Free;
end;
end;
//in the code above, how i can to assign differents tags for each circle for referencing later with this handler:
procedure TPhotoX.CirClick(Sender:TObject);
begin
case TCircle(Sender).Tag of
1: //event to show the image
inside the circle
2: // event to show another
image inside the circle
end;
end;
end;
I appreciate any kind of help... Thanks you
As pointed out in comments, there are several mistakes in your code. You are not creating the TBitmap and TCircle objects correctly. You are not adequately protecting resources. And your for loop lacks a required begin/end block to contain your loop logic.
And, to answer your question, since you are using a for..in loop, if you want to assign index-based Tag values then you need to use a separate variable to keep track of the current index as you iterate through the collection.
Try something more like this:
procedure TPhotoX.FormCreate(Sender: TObject);
var
FilesN: String;
S: TBitmap;
Cir: TCircle;
I: Integer;
begin
FlowLayout1.DeleteChildren;
GetFP := TDirectory.GetFiles(GetPathIma, '*jpg', TSearchOption.soTopDirectoryOnly);
if GetFP <> nil then Exit;
VertScrollBox1.BeginUpdate;
try
I := 1;
for FilesN in GetFP do
begin
Cir := TCircle.Create(Self);
try
Cir.Parent := FlowLayOut1;
Cir.Fill.Bitmap.WrapMode := TWrapMode.TileOriginal;
Cir.Fill.Kind := TBrushkind.Bitmap;
Cir.Height := 85;
Cir.Width := 85;
Cir.Tag := I; // <-- or whatever you need
Inc(I);
Cir.OnClick := CirClick;
S := TBitmap.Create;
try
S.LoadThumbnailsFromFile(FilesN, 150, 150);
Cir.Fill.Bitmap.Bitmap := S;
finally
S.Free;
end;
FlowLayout1.AddObject(Cir);
except
Cir.Free;
raise;
end;
//Cir.Repaint;
end;
finally
VertScrollBox1.EndUpdate;
end;
end;
procedure TPhotoX.CirClick(Sender: TObject);
begin
case TCircle(Sender).Tag of
1: // event to show the image inside the circle
2: // event to show another image inside the circle
end;
end;
I need to get the number of displayed lines in TMemo (this include the lines that was wrapped because WordWrap is set to true). I need this to auto adjust the height of the Tmemo to it's content.
lines.count of course don't care about wrapped lines so i can't use it. strangely TextPosToPos also don't care about wrapped lines so i can't use it too ...
I m under firemonkey and delphi Berlin
Edit after I learned about ContentsBounds. My original (and obsolete) answer is still visible in the revisions.
Why do you need the number of displayed lines to adjust the height of the TMemo? This resizes the TMemo to its content:
Memo1.Height := Memo1.ContentBounds.Height + 5; // Small const to allow for rendering margins
It also takes word-wrap into consideration.
I don't know why using ContentBounds is "not really ideal". Here's how I do it:
uses
FMX.TextLayout, FMX.Graphics;
function MeasureTextHeight(const AFont: TFont; const AText: string): Single;
var
LLayout: TTextLayout;
begin
LLayout := TTextLayoutManager.DefaultTextLayout.Create;
try
LLayout.BeginUpdate;
try
LLayout.WordWrap := False;
LLayout.Font.Assign(AFont);
LLayout.Text := AText;
finally
LLayout.EndUpdate;
end;
Result := LLayout.TextHeight;
finally
LLayout.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
LTextHeight: Single;
LLines: Integer;
begin
LTextHeight := MeasureTextHeight(Memo1.TextSettings.Font, Memo1.Text);
LLines := Round(Memo1.ContentBounds.Height / LTextHeight);
end;
This is the rough way i use to calculate the number of lines an TMemo (styled) under firemonkey :
type
_TStyledMemoProtectedAccess = class(TStyledMemo);
procedure TALStyledMemo.OnApplyStyleLookupImpl(sender: Tobject);
Var I, j, k, l: integer;
begin
// TALStyledMemo
// TStyledMemo
// TLayout
// TActiveStyleObject
// TLayout
// TScrollBar
// TScrollBar
// TLayout
// TSmallScrollBar
// TSmallScrollBar
// TScrollContent
for I := 0 to controls.Count - 1 do begin
if (controls[i] is TStyledMemo) then begin // << TStyledMemo
fStyledMemo := TStyledMemo(controls[i]);
end;
end;
end;
function TALStyledMemo.getLineHeight: Single;
begin
if fStyledMemo <> nil then result := _TStyledMemoProtectedAccess(fStyledMemo).GetLineHeight
else result := 0;
end;
function TALStyledMemo.getLineCount: integer;
var aLineHeight: Single;
begin
aLineHeight := getLineHeight;
if compareValue(aLineHeight, 0, Tepsilon.Position) > 0 then result := round(ContentBounds.Height / aLineHeight)
else result := 0;
end;
today I've a question about streaming a part of a form to a file.
In this example i use a Tmemo instead of file in order to see the stream.
here is my form:
The panel on the right top of the form has some controls, like label, edit and so on.
with the "Save panel" butto I save the panel on a TStream:
Here the code:
procedure TfrmMain.btnSaveClick(Sender: TObject);
var
idx: Integer;
MemStr: TStream;
begin
MemStr := TMemoryStream.Create;
PanelStr := TMemoryStream.Create;
try
for idx := 0 to pnlSource.ControlCount - 1 do begin
MemStr.Position := 0;
MemStr.WriteComponent(pnlSource.Controls[idx]);
StreamConvert(MemStr);
end;
PanelStr.Position := 0;
mmoStream.Lines.LoadFromStream(PanelStr);
finally
MemStr.Free;
end;
end;
and here the StreamConvert:
{ Conversione stream in formato testo }
procedure TfrmMain.StreamConvert(aStream: TStream);
var
ConvStream: TStream;
begin
aStream.Position := 0;
ConvStream := TMemoryStream.Create;
try
ObjectBinaryToText(aStream, ConvStream);
ConvStream.Position := 0;
PanelStr.CopyFrom(ConvStream, ConvStream.Size);
lblStreamSize.Caption := IntToStr(ConvStream.Size);
finally
ConvStream.Free;
end;
end;
PanelStr is a TStream object declared in private section of the form and create during form create.
This part works good and, as you can see in right part of the image the elements present on the form are register correctly.
Now my problem is to restore this element into the panel on the left bottom of the form.
I've tryed this routine:
{ Carica i controlli presenti nel pannello pnlSource in uno stream }
procedure TfrmMain.btnLoadClick(Sender: TObject);
var
idx: Integer;
MemStr: TStream;
begin
pnlSource.Free;
MemStr := TMemoryStream.Create;
try
PanelStr.Position := 0;
ObjectTextToBinary(PanelStr, MemStr);
MemStr.Position := 0;
MemStr.ReadComponent(pnlTarget);
finally
MemStr.Free;
end;
end;
but it doesn't work and in the following picture you can see the result:
What is wrong in my routine, and How can I read all the element present in the stream and not only the first?
Can someone help me in this headache?
The code you are currently running effectively transforms the source panel to a label. That's because the first object streamed is a label and the code is reading only one component. IOW, when the reader reaches the first end, reading is complete since there are no sub controls in the stream.
So, first of all, you have to write the panel - and only the panel. The panel is the one that is supposed to stream it's children. To have it to do so, it must own it's controls.
var
idx: Integer;
MemStr: TStream;
begin
MemStr := TMemoryStream.Create;
PanelStr := TMemoryStream.Create;
try
// transfer ownership of controls to the panel
for idx := 0 to pnlSource.ControlCount - 1 do
pnlSource.InsertComponent(pnlSource.Controls[idx]);
// write the panel
MemStr.WriteComponent(pnlSource);
StreamConvert(MemStr);
PanelStr.Position := 0;
mmoStream.Lines.LoadFromStream(PanelStr);
finally
MemStr.Free;
end;
This produces an output to the memo like this:
object pnlSource: TPanel
Left = 8
Top = 8
Width = 201
Height = 265
Caption = 'pnlSource'
TabOrder = 0
object Label1: TLabel
Left = 48
Top = 208
Width = 31
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
...
Note the indentation of the label definition and the missing 'end' of the owning panel (it's at the end).
You will need to register classes for the streamer to be able to find them when loading:
var
idx: Integer;
MemStr: TStream;
begin
pnlSource.Free;
RegisterClasses([TLabel, TEdit, TCheckBox, TRadioButton]);
MemStr := TMemoryStream.Create;
try
PanelStr.Position := 0;
ObjectTextToBinary(PanelStr, MemStr);
MemStr.Position := 0;
MemStr.ReadComponent(pnlTarget);
finally
MemStr.Free;
end;
Registration can be of course moved to elsewhere, like form creation or unit initialization.
You can also transfer ownership of the controls back to the form if it's required, like in the saving code.
As I put in my comments, you need to surround your data with Panel2 information. You also need to register each control type you are saving and restoring.
This means that only the load procedure needs to change - like this:
procedure TfrmMain.btnLoadClick(Sender: TObject);
var
iTemp, iTemp2 : TStringList;
MemStr: TStream;
i: Integer;
begin
// first read the destination panel an put it into a string list
pnlSource.Free;
iTemp := TStringList.Create;
iTemp2 := TStringList.Create;
iTemp.Duplicates := TDuplicates.dupAccept;
iTemp2.Duplicates := TDuplicates.dupAccept;
MemStr := TMemoryStream.Create;
try
PanelStr.Position := 0;
iTemp2.LoadFromStream( PanelStr ); // our original source
PanelStr.Size := 0;
MemStr.Position := 0;
MemStr.WriteComponent(pnlTarget);
StreamConvert(MemStr);
// PanelStr now has our destination poanel.
PanelStr.Position := 0;
iTemp.LoadFromStream( PanelStr );
for i := 0 to iTemp2.Count - 1 do
begin
iTemp.Insert( ITemp.Count - 1, iTemp2[ i ]);
end;
PanelStr.Size := 0;
iTemp.SaveToStream( PanelStr );
PanelStr.Position := 0;
mmoStream.Lines.LoadFromStream(PanelStr);
MemStr.Size := 0;
PanelStr.Position := 0;
ObjectTextToBinary( PanelStr, MemStr);
MemStr.Position := 0;
RegisterClass( TLabel );
RegisterClass( TPanel );
RegisterClass( TEdit );
RegisterClass( TCheckBox );
RegisterClass( TRadioButton );
MemStr.ReadComponent( pnlTarget );
finally
iTemp.Free;
iTemp2.Free;
MemStr.Free;
end;
end;
As commented in the previous answer, registration can be put somewhere else.
Unlike the previous answer, you do not need to change the ownership of the controls first. (That is just a comment - not a criticism). This is just an implementation of my comment.
My naming conventions are different to yours. I have tried to use the same names, but forgive me if I have missed any.
Is there a simple way to duplicate all child components under parent component, including their published properties?
For example:
TPanel
TLabel
TEdit
TListView
TSpecialClassX
Of course the most important factor, it should duplicate any new component which I drop on the TPanel without modifying the code under normal circumstances.
I've heard of the RTTI, but never used it actually. Any ideas?
You can propably use the CLoneProperties routine from the answer to "Replace visual component at runtime", after you have created the dup components in a loop thru the parent's controls.
Update: some working code....
. I assume from your question that you want to duplicate the Controls that are contained in a WinControl (as a Parent is a TWinControl).
. As I did not know if you also wanted to hook the duplicated controls with the same Event Handlers as the originals, I made an option for that.
. And you may want to give a proper meaningful Name to the duplicated controls.
uses
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
have a read of this page
Run-Time Type Information In Delphi - Can It Do Anything For You?
Noting the section Copying Properties From A Component To Another
which has a unit, RTTIUnit with a Procedure, which seems to do part of what you want but i don't think it will copy any child components with out extra code.
(i think its ok to paste it here...)
procedure CopyObject(ObjFrom, ObjTo: TObject);
var
PropInfos: PPropList;
PropInfo: PPropInfo;
Count, Loop: Integer;
OrdVal: Longint;
StrVal: String;
FloatVal: Extended;
MethodVal: TMethod;
begin
//{ Iterate thru all published fields and properties of source }
//{ copying them to target }
//{ Find out how many properties we'll be considering }
Count := GetPropList(ObjFrom.ClassInfo, tkAny, nil);
//{ Allocate memory to hold their RTTI data }
GetMem(PropInfos, Count * SizeOf(PPropInfo));
try
//{ Get hold of the property list in our new buffer }
GetPropList(ObjFrom.ClassInfo, tkAny, PropInfos);
//{ Loop through all the selected properties }
for Loop := 0 to Count - 1 do
begin
PropInfo := GetPropInfo(ObjTo.ClassInfo, PropInfos^[Loop]^.Name);
// { Check the general type of the property }
//{ and read/write it in an appropriate way }
case PropInfos^[Loop]^.PropType^.Kind of
tkInteger, tkChar, tkEnumeration,
tkSet, tkClass{$ifdef Win32}, tkWChar{$endif}:
begin
OrdVal := GetOrdProp(ObjFrom, PropInfos^[Loop]);
if Assigned(PropInfo) then
SetOrdProp(ObjTo, PropInfo, OrdVal);
end;
tkFloat:
begin
FloatVal := GetFloatProp(ObjFrom, PropInfos^[Loop]);
if Assigned(PropInfo) then
SetFloatProp(ObjTo, PropInfo, FloatVal);
end;
{$ifndef DelphiLessThan3}
tkWString,
{$endif}
{$ifdef Win32}
tkLString,
{$endif}
tkString:
begin
{ Avoid copying 'Name' - components must have unique names }
if UpperCase(PropInfos^[Loop]^.Name) = 'NAME' then
Continue;
StrVal := GetStrProp(ObjFrom, PropInfos^[Loop]);
if Assigned(PropInfo) then
SetStrProp(ObjTo, PropInfo, StrVal);
end;
tkMethod:
begin
MethodVal := GetMethodProp(ObjFrom, PropInfos^[Loop]);
if Assigned(PropInfo) then
SetMethodProp(ObjTo, PropInfo, MethodVal);
end
end
end
finally
FreeMem(PropInfos, Count * SizeOf(PPropInfo));
end;
end;
You can write the source component into a stream and read it back into the target component.
MemStream := TMemoryStream.Create;
try
MemStream.WriteComponent(Source);
MemStream.Position := 0;
MemStream.ReadComponent(Target);
finally
MemStream.Free;
end;
You may get problems with duplicate component names though.
It's actually fairly easy to duplicate existing components at runtime. The difficult part is to copy all of their published properties to the new (duplicated) objects.
I'm sorry, but my code example is in C++Builder. The VCL is the same, just a different language. It shouldn't be too much trouble to translate it Delphi:
for (i = 0; i < ComponentCount; ++i) {
TControl *Comp = dynamic_cast<TControl *>(Components[i]);
if (Comp) {
if (Comp->ClassNameIs("TLabel")) {
TLabel *OldLabel = dynamic_cast<TDBEdit *>(Components[i]);
TLabel *NewLabel = new TLabel(this); // new label
// copy properties from old to new
NewLabel->Top = OldLabel->Top;
NewLabel->Left = OldLabel->Left;
NewLabel->Caption = Oldlabel->Caption
// and so on...
} else if (Comp->ClassNameIs("TPanel")) {
// copy a TPanel object
}
Maybe somebody has a better method of copying all of the published properties of the old control to the new one.
Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.