Merhabalar,
Application.onCreateForm gibi bir event varmıdır ,
Application nesnesi içeriisnde göremedim, haricen yazabiliyormuyuz acaba?.
Amacım uygulama içerisinde herhangi bir yerde ve zamanda create edilen tüm form türlerinin tek merkezden denetimini sağlamak.
Bu amaca hizmet edecek bir event tetiklenebilir mi?
Teşekkürler.
(18-07-2024, Saat: 17:41)Master_Crazy Adlı Kullanıcıdan Alıntı: [ -> ]Please describe in more detail what you want to do. https://www.thoughtco.com/create-delphi-...ng-1057672
Tabi ki,
Büyük bir projede create edilen birçok formda
ki bunların bir çoğu mdichild form , modal form , normal formlar,
ve class function ile create edip işlediğim return aldığım formlar var.
her birinin create koduna gidip bişeyler yazmak istemiyorum, zaten bazıları mdichild iken modal da değiştirip modal açıyorum duruma göre.
herbirine gidip tekrar kod yazamam , yada tek metotola herbirini create edemem gönderdiğiniz linkdeki gibi.
işte Application sınıfında Tüm bu CreateForm olaylarını yakalayabileceğim alttakilerine benzer bir event varmı tetikleyebilirmiyim yazabilirmiyim bunu araştırıyorum.
Umarım anlatabilmişimdir.
@
Tuğrul HELVACI hocam senin bu konuda bir yorumun olabilir mi?
[
attachment=2753]
(18-07-2024, Saat: 23:34)bydelphi Adlı Kullanıcıdan Alıntı: [ -> ] (18-07-2024, Saat: 17:41)Master_Crazy Adlı Kullanıcıdan Alıntı: [ -> ]Please describe in more detail what you want to do. https://www.thoughtco.com/create-delphi-...ng-1057672
Tabi ki,
Büyük bir projede create edilen birçok formda
ki bunların bir çoğu mdichild form , modal form , normal formlar,
ve class function ile create edip işlediğim return aldığım formlar var.
her birinin create koduna gidip bişeyler yazmak istemiyorum, zaten bazıları mdichild iken modal da değiştirip modal açıyorum duruma göre.
herbirine gidip tekrar kod yazamam , yada tek metotola herbirini create edemem gönderdiğiniz linkdeki gibi.
işte Application sınıfında Tüm bu CreateForm olaylarını yakalayabileceğim alttakilerine benzer bir event varmı tetikleyebilirmiyim yazabilirmiyim bunu araştırıyorum.
Umarım anlatabilmişimdir.
@Tuğrul HELVACI hocam senin bu konuda bir yorumun olabilir mi?
Merhabalar,
Daha önce bu şekilde bir konu geçömişti forumda ama bulamadım.
Umarım aşağıda ki kod yardımcı olur.
ApplicationEvents1: TApplicationEvents;
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
if Msg.message = WM_CREATE then
begin
if Msg.hwnd <> 0 then
begin
ShowMessage('Form oluştu: ' + IntToStr(Msg.hwnd));
end;
end;
end;
Kolay gelsin.
Şöyle bir durumu ifade etmekte fayda var.
WM_CREATE mesajı, Application seviyesinde kendi kendine üretilen bir mesaj değil de direkt Windows mesaj sırasına atılan türden bir mesaj olacaktır.
Dolayısıyla proje içerisinden yakalayamazsanız üzülmeyin, çözümü var.
Aşağıdaki örneği denemek isteyebilirsiniz.
Bir boş proje açın bir button ve bir MEMO koyun.
Button OnClick eventi içine formun bir kopyasını create eden aşağıdaki örnekteki gibi basit bir kod ekleyin.
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with TForm1.Create(self) do
try
ShowModal();
finally
free;
end;
end;
var
FHHook: HHOOK;
function CBT_HookFunc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
ClassNameBufferSize = 1024;
var
LClassName : Array[0..254] of Char;
hWindow : HWND;
begin
Result := CallNextHookEx(FHHook, nCode, wParam, lParam);
if NOT Assigned(Application.MainForm)
then // MainForm olgunlaşmamışsa (o da OnCreate aşamasında olabilir) üzerindekilere de yazamayız...
Exit;
if nCode < 0 then exit;
if nCode = HCBT_CREATEWND then
begin
hWindow := HWND(wParam);
GetClassName(hWindow, LClassName, 256);
if ( hWindow > 0 )
and ( pos('TForm', LClassName) > 0 ) // TForm ile başlayan bir sınıf create edilmişse...
then
begin
Form1.Memo1.Lines.Add( Format( 'Form oluştu: %xh (%d)', [hWindow, hWindow]) );
end;
end;
end;
Procedure InitHook();
var
dwThreadID : DWORD;
begin
dwThreadID := GetCurrentThreadId;
FHHook := SetWindowsHookEx(WH_CBT, @CBT_HookFunc, hInstance, dwThreadID);
if FHHook = 0
then
RaiseLastOSError;
end;
Procedure KillHook();
begin
if (FHHook <> 0) then
UnhookWindowsHookEx(FHHook);
end;
initialization
InitHook();
finalization
KillHook();
Ne kadar güzel, arkadaşlarımız farklı bakış açıları ile çözümler sunmuşlar. Hepsinin ellerine sağlık. Ben de farklı bir bakış açısı sunayım. Kullanacağımız yöntemin adı, interposer class.
Bir unit hazırlayın; adına uFormHelper ismini verin örneğin. İçine aşağıdaki kodları yazın:
unit uFormHelper;
interface
uses
System.Classes,
Vcl.Dialogs,
Vcl.Forms,
Vcl.Controls;
type
TForm = class(Vcl.Forms.TForm)
public
constructor Create(AOwner: TComponent); override;
procedure AfterConstruction; override;
end;
implementation
{ TForm }
procedure TForm.AfterConstruction;
begin
inherited;
ShowMessage('Yeni bir form oluşturuldu.');
end;
constructor TForm.Create(AOwner: TComponent);
begin
try
inherited;
except
inherited CreateNew(AOwner);
end;
end;
end.
Ardından, tüm formlarınızın olduğu pas dosyalarını dolaşıp en üstteki uses bloğunun en sonuna uFormHelper'i eklerseniz; artık tüm formlar Vcl.Forms.pas 'daki TForm'dan türemek yerine; uFormHelper.pas içindeki TForm'dan türemeye başlarlar. Bu da size merkezilik kazandırır.
Katkılarınız için çok teşekkür ederim.
herbiri birbiirnden değerli kıymetli yaklaşımlar, farklı kapılar açıyor
(20-07-2024, Saat: 21:16)Master_Crazy Adlı Kullanıcıdan Alıntı: [ -> ] (19-07-2024, Saat: 17:06)bydelphi Adlı Kullanıcıdan Alıntı: [ -> ]Katkılarınız için çok teşekkür ederim.
herbiri birbiirnden değerli kıymetli yaklaşımlar, farklı kapılar açıyor
I don't see your response after the help of the forum administrators.
I searched through my documents and found this. I wonder if this is of any help to you:
- Question:
In Access and PB applications, I have implemented menus based on database tables. Ie., you select a particular entry and it load a particular form based on the text in the table. The question is, how do I do something similar in Delphi?
- Answer:
//--------------------------------------------------------------------------------------
Solve 1:
//--------------------------------------------------------------------------------------
Let's assume that you want to show one of the forms of class TForm1, TForm2 or TForm3 and that the classname is held in a string called FormString.
Add the units holding the forms to a Uses statement - implementation section if possible (i.e Uses Form1, Form2, Form3)
Add an initialization section (before final end.):
initialization
RegisterClasses([TForm1, TForm2, TForm3]);
end.
Write a procedure to show a form. For example:
procedure TForm1.ShowForm(const fname: string);
begin
with TFormClass(FindClass(fname)).Create(Application) do
try
ShowModal;
finally
Free;
end;
end;
Thus you would call this via:
ShowForm(FormString);
//--------------------------------------------------------------------------------------
Solve 2:
//--------------------------------------------------------------------------------------
Yes, you can do this. The requirement is that you register all your forms (at least those that need to be created by name) using the RegisterClass method. That adds the form class and its name to an internal list maintained by the VCL. You can now call FindClass or GetClass to get the class reference back using the class name.
var
fc: TFormClass; {class of TForm, a class reference type}
form: TForm;
begin
fc := TFormClass(getClass(formclassnamefromdatabase));
if Assigned(fc) then
begin
form := fc.Create(Application);
try
form.ShowModal
finally
form.free
end;
end;
end;
The main problem here is that you cannot use the default form variables the IDE puts into the form units Interface, so better delete them to prevent accidental references to them. There is no mechanism to find a variable by name build into the VCL, but if you really need to use the form variables you could build your own registration mechanism that would build a list associating form class name, the form class, and the address of the form variable.
Once the form is created you can find a reference to it from elsewhere in the app by iterating through the Screen.Forms array, looking for a form with a specific class name.
//--------------------------------------------------------------------------------------
Solve 3:
//--------------------------------------------------------------------------------------
Here are a couple of approaches. As long as you are only accessing Methods and Properties common to TForm, the following will work for you. Pay special attention to the RegisterClasses call in the initialization section:
unit GenericFormCreate;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FileCtrl, Buttons, ExtCtrls;
type
TFrmGenericFormCreate = class(TForm)
BtnCreateFromString: TButton;
BtnCreateFromClass: TButton;
RgrSelect: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure BtnCreateFromStringClick(Sender: TObject);
procedure BtnCreateFromClassClick(Sender: TObject);
private
procedure CreateFromClass(AForm: TClass);
procedure CreateFromClassName(AForm: string);
public
end;
var
FrmGenericFormCreate: TFrmGenericFormCreate;
implementation
{$R *.DFM}
uses
Unit2, Unit3;
procedure TFrmGenericFormCreate.FormCreate(Sender: TObject);
begin
RgrSelect.ItemIndex := 0;
end;
procedure TFrmGenericFormCreate.CreateFromClass(AForm: TClass);
begin
with TFormClass(AForm).Create(Application) do
try
ShowModal;
finally
Release;
end;
end;
procedure TFrmGenericFormCreate.CreateFromClassName(AForm: string);
begin
try
with TFormClass(FindClass(AForm)).Create(Application) do
try
ShowModal;
finally
Release;
end;
except
ShowMessage(Format('Class %s not found', [AForm]));
end;
end;
procedure TFrmGenericFormCreate.BtnCreateFromStringClick(Sender: TObject);
begin
CreateFromClassName('TForm' + IntToStr(RgrSelect.ItemIndex + 2));
RgrSelect.SetFocus;
end;
procedure TFrmGenericFormCreate.BtnCreateFromClassClick(Sender: TObject);
begin
case RgrSelect.ItemIndex of
0: CreateFromClass(TForm2);
1: CreateFromClass(TForm3);
end;
RgrSelect.SetFocus;
end;
initialization
RegisterClasses([TForm2, TForm3]);
end.
//--------------------------------------------------------------------------------------
Solve 4:
//--------------------------------------------------------------------------------------
unit unt_myforms;
interface
uses classes, sysutils, myFormList;
function GetmyFormByDialogName(const psDialogName: string; poOwner : TComponent; peLogEvent : TGetStrProc ): TmyForm;
implementation
const
cntMaxmyClasses = 99;
type
TmyFormClass = class of TmyForm;
TmyForm1 = class(TmyForm);
TmyForm2 = class(TmyForm);
TmyForm3 = class(TmyForm);
TmyForm4 = class(TmyForm);
TmyForm5 = class(TmyForm);
TmyForm6 = class(TmyForm);
TmyForm7 = class(TmyForm);
TmyForm8 = class(TmyForm);
TmyForm9 = class(TmyForm);
TmyForm10 = class(TmyForm);
TmyForm11 = class(TmyForm);
TmyForm12 = class(TmyForm);
TmyForm13 = class(TmyForm);
TmyForm14 = class(TmyForm);
TmyForm15 = class(TmyForm);
TmyForm16 = class(TmyForm);
TmyForm17 = class(TmyForm);
TmyForm18 = class(TmyForm);
TmyForm19 = class(TmyForm);
TmyForm20 = class(TmyForm);
TmyForm21 = class(TmyForm);
TmyForm22 = class(TmyForm);
TmyForm23 = class(TmyForm);
TmyForm24 = class(TmyForm);
TmyForm25 = class(TmyForm);
TmyForm26 = class(TmyForm);
TmyForm27 = class(TmyForm);
TmyForm28 = class(TmyForm);
TmyForm29 = class(TmyForm);
TmyForm30 = class(TmyForm);
TmyForm31 = class(TmyForm);
TmyForm32 = class(TmyForm);
TmyForm33 = class(TmyForm);
TmyForm34 = class(TmyForm);
TmyForm35 = class(TmyForm);
TmyForm36 = class(TmyForm);
TmyForm37 = class(TmyForm);
TmyForm38 = class(TmyForm);
TmyForm39 = class(TmyForm);
TmyForm40 = class(TmyForm);
TmyForm41 = class(TmyForm);
TmyForm42 = class(TmyForm);
TmyForm43 = class(TmyForm);
TmyForm44 = class(TmyForm);
TmyForm45 = class(TmyForm);
TmyForm46 = class(TmyForm);
TmyForm47 = class(TmyForm);
TmyForm48 = class(TmyForm);
TmyForm49 = class(TmyForm);
TmyForm50 = class(TmyForm);
TmyForm51 = class(TmyForm);
TmyForm52 = class(TmyForm);
TmyForm53 = class(TmyForm);
TmyForm54 = class(TmyForm);
TmyForm55 = class(TmyForm);
TmyForm56 = class(TmyForm);
TmyForm57 = class(TmyForm);
TmyForm58 = class(TmyForm);
TmyForm59 = class(TmyForm);
TmyForm60 = class(TmyForm);
TmyForm61 = class(TmyForm);
TmyForm62 = class(TmyForm);
TmyForm63 = class(TmyForm);
TmyForm64 = class(TmyForm);
TmyForm65 = class(TmyForm);
TmyForm66 = class(TmyForm);
TmyForm67 = class(TmyForm);
TmyForm68 = class(TmyForm);
TmyForm69 = class(TmyForm);
TmyForm70 = class(TmyForm);
TmyForm71 = class(TmyForm);
TmyForm72 = class(TmyForm);
TmyForm73 = class(TmyForm);
TmyForm74 = class(TmyForm);
TmyForm75 = class(TmyForm);
TmyForm76 = class(TmyForm);
TmyForm77 = class(TmyForm);
TmyForm78 = class(TmyForm);
TmyForm79 = class(TmyForm);
TmyForm80 = class(TmyForm);
TmyForm81 = class(TmyForm);
TmyForm82 = class(TmyForm);
TmyForm83 = class(TmyForm);
TmyForm84 = class(TmyForm);
TmyForm85 = class(TmyForm);
TmyForm86 = class(TmyForm);
TmyForm87 = class(TmyForm);
TmyForm88 = class(TmyForm);
TmyForm89 = class(TmyForm);
TmyForm90 = class(TmyForm);
TmyForm91 = class(TmyForm);
TmyForm92 = class(TmyForm);
TmyForm93 = class(TmyForm);
TmyForm94 = class(TmyForm);
TmyForm95 = class(TmyForm);
TmyForm96 = class(TmyForm);
TmyForm97 = class(TmyForm);
TmyForm98 = class(TmyForm);
TmyForm99 = class(TmyForm);
var
slmyFormAssigned,
slmyFormClasses : TStringlist;
procedure SetupmyFormClasses;
begin
slmyFormClasses := TStringlist.Create;
slmyFormAssigned := TStringList.Create;
RegisterClasses([
TmyForm1, TmyForm2, TmyForm3, TmyForm4, TmyForm5,
TmyForm6, TmyForm7, TmyForm8, TmyForm9, TmyForm10,
TmyForm11, TmyForm12, TmyForm13, TmyForm14, TmyForm15,
TmyForm16, TmyForm17, TmyForm18, TmyForm19, TmyForm20,
TmyForm21, TmyForm22, TmyForm23, TmyForm24, TmyForm25,
TmyForm26, TmyForm27, TmyForm28, TmyForm29, TmyForm30,
TmyForm31, TmyForm32, TmyForm33, TmyForm34, TmyForm35,
TmyForm36, TmyForm37, TmyForm38, TmyForm39, TmyForm40,
TmyForm41, TmyForm42, TmyForm43, TmyForm44, TmyForm45,
TmyForm46, TmyForm47, TmyForm48, TmyForm49, TmyForm50,
TmyForm51, TmyForm52, TmyForm53, TmyForm54, TmyForm55,
TmyForm56, TmyForm57, TmyForm58, TmyForm59, TmyForm60,
TmyForm61, TmyForm62, TmyForm63, TmyForm64, TmyForm65,
TmyForm66, TmyForm67, TmyForm68, TmyForm69, TmyForm70,
TmyForm71, TmyForm72, TmyForm73, TmyForm74, TmyForm75,
TmyForm76, TmyForm77, TmyForm78, TmyForm79, TmyForm80,
TmyForm81, TmyForm82, TmyForm83, TmyForm84, TmyForm85,
TmyForm86, TmyForm87, TmyForm88, TmyForm89, TmyForm90,
TmyForm91, TmyForm92, TmyForm93, TmyForm94, TmyForm95,
TmyForm96, TmyForm97, TmyForm98, TmyForm99 ]);
end;
procedure RemovemyFormClasses;
begin
FreeAndNIl(slmyFormClasses);
FreeAndNIl(slmyFormAssigned);
end;
function GetmyFormByDialogName(const psDialogName: string; poOwner : TComponent; peLogEvent : TGetStrProc ): TmyForm;
var
liIdx, liClassIdx : Integer;
lomyFormClass : TmyFormClass;
lsDialogName,
lsmyFormClassName : string;
begin
Result := nil;
lomyFormClass := nil;
liClassIdx := slmyFormClasses.IndexOfName(psDialogName);
if( liClassIdx < 0 )then
begin
liIdx := 0;
repeat
inc(liIdx);
lsmyFormClassName := 'TmyForm' + IntToStr(liIdx);
liClassIdx := slmyFormAssigned.IndexOfName(lsmyFormClassName);
if( liClassIdx >= 0 )then
begin
lsDialogName := slmyFormAssigned.ValueFromIndex[liClassIdx];
if( SameText( lsDialogName, psDialogName ))then
begin
lomyFormClass := TmyFormClass(GetClass(lsmyFormClassName));
end;
end
else
begin
slmyFormAssigned.Add(lsmyFormClassName + '=' + psDialogName );
slmyFormClasses.Add(psDialogName + '=' + lsmyFormClassName );
lomyFormClass := TmyFormClass(GetClass(lsmyFormClassName));
peLogEvent( psDialogName + ' assigned to ' + lsmyFormClassName +
', assigned count: ' + IntToStr(slmyFormClasses.Count) );
end;
until( liIdx >= cntMaxmyClasses)or( Assigned(lomyFormClass));
end
else
begin
lsmyFormClassName := slmyFormClasses.ValueFromIndex[liClassIdx];
lomyFormClass := TmyFormClass(GetClass(lsmyFormClassName));
end;
if( not Assigned(lomyFormClass))then
begin
peLogEvent('All ' + IntToStr(cntMaxmyClasses) + ' classes already used');
exit;
end;
Result := lomyFormClass.Create(poOwner);
Result.DialogName := psDialogName;
end;
initialization
SetupmyFormClasses;
finalization
RemovemyFormClasses;
end.
Thank you very much my friend, I solved it
