Super TFrame :)))

VCL, KOL, CLX и др. Свои компоненты
Ответить
demar
Сообщения: 1
Зарегистрирован: 17 сен 2013, 07:24

17 сен 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.
Заранее благодарен за ответ.
Ответить