tabframe.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

unit TabFrame;

{*******************************************
 * brief: 一个Tab页面管理模板
 * autor: linzhenqun
 * date: 2005-11-01
 * email: [e-mail]
 * blog: http://blog.csdn.net/linzhengqun
 * 功能简介：
 *     定义一个页框架类
 *     定义一个页框架管理类
********************************************}

interface

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

type
  TFrameTab = class(TFrame)   // 页基本框架
    TabSet: TTabSet;          // 页集合
    procedure TabSetChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure TabSetMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TabSetDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TabSetDragDrop(Sender, Source: TObject; X, Y: Integer);
    //procedure WinControlForm_3Create(Sender: TObject);

  private
    OldTabSetProc: TWndMethod;

    (* TabSet新的处理过程 *)
    procedure NewTabSetProc(var message: TMessage);
  public
    constructor CreateEx(Aowner: TComponent);
    (* 检查该Tab名是否存在 *)
    function IsTabNameExist(TabName: string): Boolean;
    procedure getLangRes;
  end;

  TTabManager = class
  private
    FFrameTab: TFrameTab;                             // 页框架                 
    function GetActiveTab: Integer;                   // 当前活动页索引
    function GetTabCount: Integer;                    // 页数量
    function IsValidIndex(Index: Integer): boolean;   // 是否有效索引 ,非 则异常
    function GetTabItem(Index: Integer): TFrame;      // 取指定页对象
    function GetTabName(Index: Integer): string;      // 取指定页名称
    procedure SetActiveTab(const Value: Integer);     // 设置当前页
  public
    constructor Create(AParent: TWinControl);
    destructor Destroy; override;

    (* 增加一个页 *)
    function AddTab(AFrame: TFrame; ATabName: string):Integer;
    (* 删除某个页 *)
    function DelTab(AIndex: Integer): Boolean;
    (* 删除当前页 *)
    function DelIndexTab: Boolean;

    function IsTabNameExist(TabName :string):Boolean;

    property TabItems[Index: Integer]: TFrame read GetTabItem;
    property TabNames[Index: Integer]: string read GetTabName;
    property TabCount: Integer read GetTabCount;
    property ActiveTab: Integer read GetActiveTab write SetActiveTab;
  end;

implementation
uses
  RenameFrm, CommonUtils ;//, gnugettext;
{$R *.dfm}

{ TFrameTab 框架页 }

procedure TFrameTab.NewTabSetProc(var message: TMessage);
var
  i: Integer;
begin
  if message.Msg = WM_LBUTTONDBLCLK then  // 鼠标左键双击
    with TWMMOUSE(message) do
    begin
      i := TabSet.ItemAtPos(Point(XPos, YPos));
      if i >= 0 then
        with TFrmRename.Create(nil) do    // 重命名
        try
          TheName := TabSet.Tabs[i];
          if Execute and not IsTabNameExist(TheName) then
            TabSet.Tabs[i] := TheName;
        finally
          Free;
        end;
      Result :=1;
    end;
  OldTabSetProc(message);
end;

constructor TFrameTab.CreateEx(Aowner: TComponent);
begin
  inherited Create(Aowner);
//ToDo:  TranslateComponent(self);         处理多语言
  getLangRes;
  OldTabSetProc := TabSet.WindowProc;   // 转换 页集合的消息处理
  TabSet.WindowProc := NewTabSetProc;     
end;

procedure TFrameTab.TabSetChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  // 让选择的页对象显示在最前
  TFrame(TabSet.Tabs.Objects[NewTab]).BringToFront;
end;

function TFrameTab.IsTabNameExist(TabName: string): Boolean;
begin
  Result := TabSet.Tabs.IndexOf(TabName)<>-1;   //TODo: 不知是否有效
  if Result then
    MessageBox(Handle, PChar(pubGet('Err_NameExist')), 
      PChar(pubGet(1)), MB_OK + MB_ICONERROR);
end;

procedure TFrameTab.TabSetMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssCtrl in Shift) and (Button = mbLeft) then
    if TabSet.ItemAtPos(Point(X, Y)) >= 0 then
      TabSet.BeginDrag(False);
end;

procedure TFrameTab.TabSetDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  Pos: Integer;
begin
  Accept := False;
  if Source = TabSet then
  begin
    Pos := TabSet.ItemAtPos(Point(X, Y));
    if  (Pos >= 0) and (Pos <> TabSet.TabIndex) then
      Accept := True;
  end;
end;

procedure TFrameTab.TabSetDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  NewPos: Integer;
begin
  if Source = TabSet then
  begin
    NewPos := TabSet.ItemAtPos(Point(X, Y));
    if NewPos >= 0 then
    begin
      TabSet.Tabs.Move(TabSet.TabIndex, NewPos);
      TabSet.TabIndex := NewPos;
    end;
  end
end;

{ TTabManager }

constructor TTabManager.Create(AParent: TWinControl);
begin
  FFrameTab := TFrameTab.CreateEx(AParent);
  with FFrameTab do
  begin
    Parent := AParent;
    Align := alClient;
  end;
end;

destructor TTabManager.Destroy;
begin
  FFrameTab.Free;
  inherited;
end;

function TTabManager.GetActiveTab: Integer;
begin
  Result := FFrameTab.TabSet.TabIndex;
end;

function TTabManager.GetTabCount: Integer;
begin
  Result := FFrameTab.TabSet.Tabs.Count;
end;

function TTabManager.IsValidIndex(Index: Integer): boolean;
begin
  Result := Not ((GetTabCount=0) or
    ((Index < 0) and (Index > GetTabCount - 1)));
  if Not Result then
    raise Exception.Create(pubGet('Err_IndexOutOfBound'));
end;

function TTabManager.IsTabNameExist(TabName :string): Boolean;
begin
  Result := FFrameTab.IsTabNameExist(TabName);
end;

function TTabManager.AddTab(AFrame: TFrame; ATabName: string):integer;
begin
  Result := -1;
  with FFrameTab.TabSet do
  begin
    AFrame.Parent := FFrameTab;
    AFrame.Align := alClient;
    if TabIndex < 0 then
    begin
      Tabs.InsertObject(0, ATabName, AFrame);
      TabIndex := 0;
    end
    else begin
      Tabs.InsertObject(TabIndex + 1, ATabName, AFrame);
      TabIndex  := TabIndex + 1;
    end;
    Result := TabIndex;
  end;
  //AFrame.BringToFront; // 是否 TabSet 的 TabChange 事件发生了呢？
  //  设置 TabIndex时
end;

function TTabManager.DelTab(AIndex: Integer): Boolean;
begin
  Result := False;
  with FFrameTab.TabSet.Tabs do
  begin
    if Count =0 then Exit;
    if (AIndex >= 0) and (AIndex <= Count - 1) then
    begin
      Objects[AIndex].Free;
      Delete(AIndex);
      Result := True;
    end;
  end;
end;

function TTabManager.DelIndexTab: Boolean;
begin
  Result := DelTab(GetActiveTab);
end;

function TTabManager.GetTabItem(Index: Integer): TFrame;
begin
  if IsValidIndex(Index) then
    Result := TFrame(FFrameTab.TabSet.Tabs.Objects[Index]);
end;

function TTabManager.GetTabName(Index: Integer): string;
begin
  if IsValidIndex(Index) then
    Result := FFrameTab.TabSet.Tabs[Index];
end;

procedure TTabManager.SetActiveTab(const Value: Integer);
begin
  if IsValidIndex(Value) then
    FFrameTab.TabSet.TabIndex := Value;
end;      

procedure TFrameTab.getLangRes;
begin
  TabSet.Hint := pubGet(512);
//  双击可以重命名
//按Ctrl + 鼠标左键 拖动
end;


end.