PDA

Просмотр полной версии : Super TFrame :)))



demar
17.09.2013, 08:07
может кто-то сталкивался с глобальными переменными TFrame

в виде string запроса TFrameClass,

дело в том, что FindClass and GetClass являются локальными для MainForm in Appl-n, или ...?



unit Unit1;
interface

uses
...

type
TFrameClass = class of TFrame;

type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

private
fFrame: TFrame;

function StrShowFrame(FrameClassName: String;
ParentPanel: TWinControl): Boolean;

public

{ Private declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses Base1Frame, Base2Frame, Base3Frame;


function TForm1.StrShowFrame(FrameClassName: String;
ParentPanel: TWinControl): Boolean;
var
FrameClass: TClass;
// E: Exception;

FrameName // Current Frame (FrameName)
: string;

begin
Result:= False;




?????
FrameClass := GetClass(FrameClassName);




if FrameClass = nil then // если такой тип фрейма незарегистрирован
begin

ShowMessageFmt('Class %s not registered',[FrameClassName]);
Result:= False;
Exit;
end;

// запретить прорисовку контейнера фреймов
try

BEGIN // не будем перерисовывать подложку, чтобы не было мерцаний

LockWindowUpdate(ParentPanel.Handle);
//если фрейм не пуст, очистим его

if Assigned(fFrame) then
if fFrame.ClassType = FrameClass then
begin
Result:= true;
Exit; //если мы пытамся пересоздать текущий фрейм ним же, то выход
end
else
fFrame.Destroy; // del previus FrameClass

// создать фрейм по указанному FrameClassName
try
fFrame := TFrameClass(FrameClass).Create(nil);

except on E:Exception do begin
Result:= true;
E.Create(E.Message);
fFrame := nil;
Exit;
end;

end;

FrameName:= FrameClassName;
Delete(FrameName,1,1); // T-...

fFrame.Name := Concat( FrameName, '1');
fFrame.Parent := ParentPanel;
fFrame.Align := alClient;

END;

finally
LockWindowUpdate(0); //разрешить прорисовку контейнера фреймов
end;

Result:= True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
StrShowFrame('TFr_Base', Panel1);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
if fFrame <> nil then fFrame.Free
else ShowMessage('Class not activ');
except
end;
end;
end.

Заранее благодарен за ответ.