unitmodulebase.pas

此代码是关于mapgis的在

unit UnitModuleBase;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, mis_AppStruct, mis_Right;

type
  TForm_Base = class;
  
  TAppFormModule = class(TAppModule)
  private
    FForm: TForm_Base;
  public
    constructor Create;override;
    procedure CreateViewModule(AParent:TWinControl);override;
    procedure ShowViewModule;override;
    procedure UnViewModule;override;
    property Form:TForm_Base read FForm write FForm;
  end;
  
  TForm_Base = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FManager: TAppModule;
    FInDesigning: Boolean;
    FModuleRight: TModuleRight;
    procedure SetManager(const Value: TAppModule);
    procedure SetModuleRight(const Value: TModuleRight);
    procedure SetInDesigning(const Value: Boolean);
  protected
    procedure ApplayFunctions;virtual;abstract;
    {实例化时使用自己的TAppModule，处于设计状态时，使用外部的TAppModule}
    property Manager:TAppModule read FManager write SetManager;
  public
    { Public declarations }
    class function GetModuleID:DWORD;virtual;abstract;
    procedure CheckState;
    procedure CheckUser;
    property InDesigning:Boolean read FInDesigning write SetInDesigning;
    property ModuleRight:TModuleRight read FModuleRight write SetModuleRight;
  end;

var
  Form_Base: TForm_Base;

implementation

{$R *.dfm}

{ TForm_ModuleBase }

procedure TForm_Base.CheckState;
begin
  if FInDesigning then Abort;
end;

procedure TForm_Base.CheckUser;
begin
  if FInDesigning then Abort;  
end;

procedure TForm_Base.FormCreate(Sender: TObject);
begin
  FInDesigning:=False;
end;

procedure TForm_Base.SetInDesigning(const Value: Boolean);
begin
  FInDesigning := Value;
  if FInDesigning then FModuleRight:=nil;
end;

procedure TForm_Base.SetManager(const Value: TAppModule);
begin
  if not FInDesigning then
    raise Exception.Create('can not set manager in run-time.');
  FManager := Value;
end;

procedure TForm_Base.SetModuleRight(const Value: TModuleRight);
begin
  if FInDesigning then
    raise Exception.Create('can not set ModuleRight in design-time.');
  FModuleRight := Value;
  if FModuleRight=nil then
    FManager:=nil
  else
    FManager:=FModuleRight.ModuleObj;
end;

{ TAppFormModule }

constructor TAppFormModule.Create;
begin
  inherited Create;
end;

procedure TAppFormModule.CreateViewModule(AParent: TWinControl);
var
  AModuleForm:TForm_Base;
begin
  inherited CreateViewModule(AParent);
  if ModuleClass<>nil then
  begin
    AModuleForm:=TForm_Base(ModuleClass.NewInstance);
    AModuleForm.Create(nil);
    ViewModule:=AModuleForm;
    AModuleForm.InDesigning:=True;
    AModuleForm.Parent:=AParent;
    AModuleForm.SetBounds(0, 0, ViewModule.Width, ViewModule.Height);
    AModuleForm.Show;
  end;
end;


procedure TAppFormModule.UnViewModule;
begin
  if ViewModule<>nil then
  begin
    try
      ViewModule.Free;
      ViewModule:=nil;
    except
      ViewModule:=nil;
    end;
  end;
end;

procedure TAppFormModule.ShowViewModule;
begin
  if (ViewModule<>nil) and (not ViewModule.Visible) then
  begin
    ViewModule.SetBounds(0, 0, ViewModule.Width, ViewModule.Height);
    ViewModule.Show;
  end;
end;

procedure TForm_Base.FormShow(Sender: TObject);
begin
  if not FInDesigning then ApplayFunctions;
end;

end.