procedure WalkChildren(Parent: TWinControl; Visit: TProc<TControl>);
var
i: Integer;
Child: TControl;
begin
for i := 0 to Parent.ControlCount-1 do
begin
Child := Parent.Controls[i];
Visit(Child);
if Child is TWinControl then
WalkChildren(TWinControl(Child), Visit);
end;
end;
aşağıdaki kod çalışıyor
WalkChildren( frame11, procedure(Child: TControl) begin
if Child is timageenview then
begin
Memo2.Lines.Add(Child.Name);
end;
end);
aşağıdaki kod çalışmıyor. Amacım, tüm child lerin ondblclick olayına ekleme yapmak.
WalkChildren(pagecontrol1, procedure(Child: TControl) begin
if Child is TOMultiPanel then
begin
with child do
ondblclick :=Frame11OMultiPanel3DblClick //// çalışmıyor
end;
end);
Tavsiyem aşağıdaki konulara bir göz atmanız.
Değerli Üstadlar yardımınıza ihtiyacım var
yapmak istediğim şeyi kısaca anlatayım componentleri kaydedip başka bir projede tekrar çağırıyorum .. onda bir problem yok ancak kaydetme işleminde herhangi bir componente event ataması yapıp tekrar çağırdığımda hata alıyorum .. hata alıyorum (invalid property value) .. oysa çağırdığım projede aynı procedure leri oluşturdum
Lütfen sorunuzu daha anlaşılır sorar mısınız.
Bileşeni kaydedip başka bir projede açmak ne demek?
"herhangi bir componente event ataması yapıp tekrar çağırdığımda hata alıyorum": çağırırken hata alıyorum diyorsunuz ama yukarıda sorduğunuz soruda atama esnasında sorun var diyorsunuz?
Soru pek anlaşılır değil(yada ben anlayamadım) ama yine de tahmin üzerinden yardımcı olmaya çalışayım: Paylaştığını kodlarda child değişkeni TControl tipinde ve bunun ondblclick olayına atama yapmaya çalışıyorsunuz. TControl sınıfının ondblclick olayı yok.
(10-10-2018, Saat: 16:08)SimaWB Adlı Kullanıcıdan Alıntı: [ -> ]Lütfen sorunuzu daha anlaşılır sorar mısınız.
Bileşeni kaydedip başka bir projede açmak ne demek?
"herhangi bir componente event ataması yapıp tekrar çağırdığımda hata alıyorum": çağırırken hata alıyorum diyorsunuz ama yukarıda sorduğunuz soruda atama esnasında sorun var diyorsunuz?
Soru pek anlaşılır değil(yada ben anlayamadım) ama yine de tahmin üzerinden yardımcı olmaya çalışayım: Paylaştığını kodlarda child değişkeni TControl tipinde ve bunun ondblclick olayına atama yapmaya çalışıyorsunuz. TControl sınıfının ondblclick olayı yok.
ben anlatamadım o zaman şöyle yapıyoruz kodlarla anlatayım
aşağıdaki kod component frame11 içindeki component düzenini kaydediyor
procedure TForm9.Button1Click(Sender: TObject);
var
idx: Integer;
MemStr: TStream;
sablon_id:string;
begin
MemStr := TMemoryStream.Create;
PanelStr := TMemoryStream.Create;
try
begin
If Not DirectoryExists(Extractfilepath(application.exename)+'TEMPLATE') Then // Klasör yoksa
If Not CreateDir(Extractfilepath(application.exename)+'TEMPLATE') Then // Oluştur
showmessage('Klasör Oluşturulamadı');
end;
// transfer ownership of controls to the panel
MemStr.WriteComponent(frame11);
StreamConvert(MemStr);
PanelStr.Position := 0;
memo1.Lines.LoadFromStream(PanelStr);
memo1.Lines.SaveToFile(Extractfilepath(application.exename)+'TEMPLATE\2_34.txt');
finally
MemStr.Free;
end;
end;
aşağıdaki şekilde kaydediyo
object ImageZemin: TImageEnVect
Left = 0
Top = 0
Width = 833
Height = 345
Background = clWhite
ParentCtl3D = False
BorderStyle = bsNone
ScrollBars = ssNone
AutoFit = True
EnableInteractionHints = True
Align = alClient
TabOrder = 0
object OMultiPanel4: TOMultiPanel
Left = 0
Top = 0
Width = 833
Height = 345
PanelCollection = <
item
Control = solpanel
Position = 0.500000000000000000
Visible = True
Index = 0
end
item
Control = sagpanel
Position = 1.000000000000000000
Visible = True
Index = 1
end>
MinPosition = 0.020000000000000000
Align = alClient
TabOrder = 0
object solpanel: TPanel
Left = 0
Top = 0
Width = 416
Height = 345
Margins.Left = 20
Margins.Top = 20
Margins.Right = 20
Margins.Bottom = 20
Align = alClient
BevelOuter = bvNone
TabOrder = 0
object OMultiPanel1: TOMultiPanel
Left = 0
Top = 0
Width = 416
Height = 345
PanelCollection = <
item
Control = ImageEnView2
Position = 1.000000000000000000
Visible = True
Index = 0
end>
MinPosition = 0.020000000000000000
Align = alClient
TabOrder = 0
DesignSize = (
416
345)
object ImageEnView2: TImageEnView
Left = 0
Top = 0
Width = 416
Height = 345
Background = clBtnFace
ParentCtl3D = False
AutoFit = True
Anchors = []
EnableInteractionHints = True
TabOrder = 0
OnMouseDown = Panel_DublorMouseDown
OnMouseMove = Panel_DublorMouseMove
OnMouseUp = Panel_DublorMouseUp
end
end
end
object sagpanel: TPanel
AlignWithMargins = True
Left = 419
Top = 0
Width = 414
Height = 345
Align = alClient
BevelOuter = bvNone
TabOrder = 1
object OMultiPanel2: TOMultiPanel
Left = 0
Top = 0
Width = 414
Height = 345
PanelCollection = <
item
Control = ImageEnView1
Position = 1.000000000000000000
Visible = True
Index = 0
end>
MinPosition = 0.020000000000000000
Align = alClient
TabOrder = 0
DesignSize = (
414
345)
object ImageEnView1: TImageEnView
Left = 0
Top = 0
Width = 414
Height = 345
Background = clBtnFace
ParentCtl3D = False
AutoFit = True
Anchors = []
EnableInteractionHints = True
TabOrder = 0
OnMouseDown = Panel_DublorMouseDown
OnMouseMove = Panel_DublorMouseMove
OnMouseUp = Panel_DublorMouseUp
end
end
end
end
end
object Panel_Dublor: TAdvPanel
Left = 733
Top = 328
Width = 209
Height = 134
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
UseDockManager = True
Version = '2.4.2.0'
Caption.Color = clHighlight
Caption.ColorTo = clNone
Caption.Font.Charset = DEFAULT_CHARSET
Caption.Font.Color = clWindowText
Caption.Font.Height = -11
Caption.Font.Name = 'Tahoma'
Caption.Font.Style = []
DoubleBuffered = True
StatusBar.Font.Charset = DEFAULT_CHARSET
StatusBar.Font.Color = clWindowText
StatusBar.Font.Height = -11
StatusBar.Font.Name = 'Tahoma'
StatusBar.Font.Style = []
Text = ''
FullHeight = 200
object Image_Dublor: TImage
Left = 32
Top = 16
Width = 145
Height = 102
end
end
object nav: TButton
Left = 32
Top = 320
Width = 75
Height = 25
Caption = 'nav'
TabOrder = 2
end
aşağıdaki kodlar ile de okutuyorum onda da sorun yok
procedure TForm9.Button2Click(Sender: TObject);
var
iTemp, iTemp2 : TStringList;
MemStr: TStream;
i: Integer;
begin
//PageControl1.Pages[0].Free;
With TTabSheet.Create( PageControl1 ) do
begin
Name := Format('Sayfa_%.2d', [ PageControl1.PageCount ]);
Caption := Name;
PageControl := PageControl1;
end;
iTemp := TStringList.Create;
iTemp2 := TStringList.Create;
iTemp.Duplicates := TDuplicates.dupAccept;
iTemp2.Duplicates := TDuplicates.dupAccept;
MemStr := TMemoryStream.Create;
PanelStr.Free;
try
PanelStr := TMemoryStream.Create;
LoadFromFileToMem(Extractfilepath(application.exename)+'TEMPLATE\2_34.txt',PanelStr);
PanelStr.Position := 0;
iTemp2.LoadFromStream( PanelStr ); // our original source
PanelStr.Size := 0;
MemStr.Position := 0;
MemStr.WriteComponent( PageControl1.Pages[PageControl1.PageCount-1]);
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;
memo1.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 );
RegisterClass( tOMultiPanel );
RegisterClass( timageenview );
RegisterClass( tieview );
RegisterClass( tImageEnVect );
MemStr.ReadComponent(PageControl1.Pages[PageControl1.PageCount-1] );
PageControl1.Pages[PageControl1.PageCount-1].Controls[0].Align:=alclient;
finally
iTemp.Free;
iTemp2.Free;
MemStr.Free;
end;
end;
button2 ile componentleri geri yüklerken
OnMouseDown = Panel_DublorMouseDown
OnMouseMove = Panel_DublorMouseMove
OnMouseUp = Panel_DublorMouseUp
bu bölüm yüklenirken hata alıyorum
Merhaba.
bu linkteki mesajı bir inceler misiniz ?
Bu linkteki ilgileceğinizi değerlendirdiğim function aşağıdaki kısım
uses
TypInfo;
function KopyaOlustur( aKaynak:TControl; aParent:TWinControl ):TControl;
var
i : Integer;
PropList : TypInfo.TPropList;
begin
With TMemoryStream.Create do
try
WriteComponent( aKaynak );
Position := 0;
Result := TControlClass(aKaynak.ClassType).Create(aParent);
Result.Parent := aParent;
ReadComponent(Result);
// Şimdi de EVENT'leri kopyalayalım...
for i := 0 to GetPropList(aKaynak.ClassInfo, [tkMethod], @PropList) - 1
do SetMethodProp(Result, PropList[i], GetMethodProp(aKaynak, PropList[i]));
finally
Free;
end;
end;
veya hemen takip eden aşağıdaki function
function Yukle( aKaynak:String; aClass:String; aParent:TWinControl ):TControl;
begin
RegisterClasses([TPanel, TLabel, TComboBox, TEdit, TButton, TRadioGroup]);
With TMemoryStream.Create do
try
LoadFromFile( aKaynak );
Position := 0;
Result := TControlClass( FindClass(aClass) ).Create(aParent);
Result.Parent := aParent;
ReadComponent(Result);
finally
Free;
end;
end;
sorunu bu şekilde çözemedim bende ilk başta sorduğum sorunun alt child lere event atamayla çözdüm..teşekkürler
WalkChildren( SPageControl1, procedure(Child: TControl) begin
if Child is timageenview then
begin
timageenview((Child)).OnMouseDown:=Panel_DublorMouseDown;
timageenview((Child)).OnMouseup:=Panel_DublorMouseup;
timageenview((Child)).OnMousemove:=Panel_DublorMousemove;
end;
end);
