多标签主界面使用TRzPageControl

// Author: CXG 2010-08-07 08:22:30

unit uMain;
{.$HINTS OFF}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, RzTabs, RzSplit, RzPanel, ExtCtrls, ComCtrls, RzButton
  ,ADODB, DB, ImgList, StdCtrls, RzStatus
  ;

type
  TFormMain = class(TForm)
    MainMenu1: TMainMenu;
    RzToolBar1: TRzToolbar;
    RzPageControl1: TRzPageControl;
    RzSizePanel1: TRzSizePanel;
    TreeView1: TTreeView;
    RzToolButton1: TRzToolButton;
    ImageList1: TImageList;
    RzStatusBar1: TRzStatusBar;
    RzMarqueeStatus1: TRzMarqueeStatus;
    RzToolButton3: TRzToolButton;
    RzToolButton2: TRzToolButton;
    RzStatusPane1: TRzStatusPane;
    RzStatusPane2: TRzStatusPane;
    procedure RzPageControl1Close(Sender: TObject;
      var AllowClose: Boolean);
    procedure RzToolButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure RzPageControl1DblClick(Sender: TObject);
  private
    { Private declarations }
    function GetTabSheet(const Acaption: string): TRzTabSheet;
    procedure CloseTabsheet;
    function ActiveExistTabsheet(const Acaption: string): boolean;
    procedure MenuTreeClick(Sender: TObject);
    procedure SetTreeNodesImage;
    procedure todo(const aCaption: string);
    procedure BLMenu;
    procedure openForm(AFormClass: TFormClass; var aForm: TForm;
      aOwner: TWinControl);
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
const
  Const_Max = 20;  

implementation

uses
  uFunction
  , uDM, uDictionary, uCategory, uMenu, uOperator, uDataStruct;

{$R *.dfm}

procedure TFormMain.openForm(AFormClass: TFormClass; var aForm: TForm;
  aOwner: TWinControl);
begin
  if aOwner = nil then Exit;
  if aForm = nil then
    aForm := AFormClass.Create(aOwner);
  with aForm do
  begin
    ManualDock(aOwner);
    WindowState := wsMaximized;
    Align := alClient;
    Show;
  end;
end;

procedure TFormMain.SetTreeNodesImage;
var
  i: Integer;
begin
  if TreeView1.Items.Count <= 0 then Exit;
 
  TreeView1.Images := Imagelist1;
  for i := 0 to TreeView1.Items.Count - 1 do
  begin
    if TreeView1.Items[i].HasChildren  then
    begin
      TreeView1.Items[i].ImageIndex := 0;
      TreeView1.Items[i].SelectedIndex := 1;

    end else begin
      TreeView1.Items[i].ImageIndex := 2;
      TreeView1.Items[i].SelectedIndex := 2;
    end;
  end;
end;

procedure TFormMain.todo(const aCaption: string);
begin
  if Pos('数据字典', acaption) <> 0 then begin
    if ActiveExistTabsheet('数据字典') then Exit;
    openForm(TformDictionary, tform(formdictionary), GetTabSheet('数据字典'));
  end else if Pos('系统菜单', aCaption) <> 0 then begin
    if ActiveExistTabsheet('系统菜单') then Exit;
    openForm(Tformmenu, tform(formMenu), GetTabSheet('系统菜单'));
  end else if Pos('货品类别管理', aCaption) <> 0 then begin
    if ActiveExistTabsheet('货品类别管理') then Exit;
    openForm(TformCategory, tform(formCategory), GetTabSheet('货品类别管理'));
  end else if Pos('操作员管理', aCaption) <> 0 then begin
    if ActiveExistTabsheet('操作员管理') then Exit;
    openForm(TFormOperator, tform(FormOperator), GetTabSheet('操作员管理'));
  end;

                     
end;

procedure TFormMain.CloseTabsheet;
var
  i: Integer;  
begin
  if RzPageControl1.PageCount <= 0 then Exit;
  if RzPageControl1.ActivePage = nil then exit;
  for i := 0 to RzPageControl1.ActivePage.ControlCount - 1 do
    if RzPageControl1.ActivePage.Controls[i] is TForm then
    begin
      TForm(RzPageControl1.ActivePage.Controls[i]).Close;
      Break;
    end;
  RzPageControl1.ActivePage.PageControl := nil;
  RzPageControl1.ActivePage.Free;
  RzPageControl1.SelectNextPage(true);
end;

function TFormMain.ActiveExistTabsheet(const Acaption: string): boolean;
var
  i: Integer;
begin
  result := false;
  if RzPageControl1.PageCount <= 0 then exit;
  for i := 0 to RzPageControl1.PageCount - 1 do
  begin
    if RzPageControl1.Pages[i].Caption = Acaption then
    begin
      result := true;
      RzPageControl1.activepage := RzPageControl1.pages[i];
      Break;
    end;
  end; 
end;

function TFormMain.GetTabSheet(const Acaption: string): TRzTabSheet;
var
  tabSheet: TRzTabSheet;
begin
  Result := nil;
  if RzPageControl1.PageCount > const_max then
  begin
    showmessage('out of ' + inttostr(const_max));
    exit;
  end;
  tabSheet := TRzTabSheet.Create(RzPageControl1);
  tabSheet.PageControl := RzPageControl1;
  tabSheet.Caption := Acaption;
  RzPageControl1.ActivePage := tabSheet;
  Result := tabSheet;
end;

procedure   TFormMain.BLMenu;
    procedure   GetItems(AItem:TMenuItem);
    var
        I:integer;
    begin
        AItem.OnClick := MenuTreeClick;
        for   I:=0   to   AItem.Count-1   do   begin
            GEtItems(AItem.Items[I]);
        end;
    end;
var
    I:integer;
begin
    for   I:=0   to   MainMenu1.Items.Count-1   do   begin
        GetItems(MainMenu1.Items.Items[I]);
    end;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//  if MessageDlg('是否关闭系统',  mtConfirmation, [mbYes, mbNo], 0) = mrYes then
//  begin
//    CanClose := True;
//  end else CanClose := False;

end;

procedure TFormMain.FormShow(Sender: TObject);
var
  d: TADOQuery;
begin
  RzStatusPane2.Caption := G_Operator.name;
  d := TADOQuery.Create(nil);
  try
    with d do
    begin
      Connection := dm.ADOConnection1;
      Close;
      SQL.Clear;
      SQL.Text := 'select id, name from modules order by id';
      Open;
    end;
    uFunction.CreateTree(d, TreeView1, 'modules', 'id', 'name', false);
    uFunction.SetDataSet(d, dm.ADOConnection1, 'modules');
  finally
    d.Free;
  end;
  uFunction.TreeToMenu(TreeView1, nil, MainMenu1.Items);
  SetTreeNodesImage;
  BLMenu;
  TreeView1.OnClick := MenuTreeClick;
end;

procedure TFormMain.MenuTreeClick(Sender: TObject);
begin
  if Sender is TTreeView then
    todo(TTreeView(Sender).Selected.Text)
  else if Sender is TMenuItem then
    todo(StripHotkey(TMenuItem(Sender).Caption));
end;

procedure TFormMain.RzPageControl1Close(Sender: TObject;
  var AllowClose: Boolean);
begin
  closetabsheet;
end;

procedure TFormMain.RzPageControl1DblClick(Sender: TObject);
begin
  CloseTabsheet;
end;

procedure TFormMain.RzToolButton1Click(Sender: TObject);
begin
  Close;
end;

end.