unitaspages.pas

仿速达界面控件

{*******************************************************
仿速达的功能界面

By wr960204 王锐

2004/8/8
*******************************************************}
unit UnitASPages;

{$S-,W-,R-,H+,X+}
{$C PRELOAD}

interface

uses
  Messages, Windows, SysUtils, Classes, UnitASBase, UnitASUtils,
  Controls, Forms, Menus, Graphics, StdCtrls;

type
  TDrawNavigation = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
    Active: Boolean) of object;

type
  //页
  TASPage = class(TASBase)
  private

    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure ReadState(Reader: TReader); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption;
    property Height stored False;
    property TabOrder stored False;
    property Visible stored False;
    property Width stored False;

  end;
  //仿速达的功能界面
  TASPageControl = class(TASBase)
  private
    FPageList: TList;
    FAccess: TStrings;
    FPageIndex: Integer;

    FNavigation3D: Boolean;
    FNavigationWidth: Integer;
    FNavigationFont: TFont;
    FNavigationAcitveFont: TFont;
    FNavigationColor: TColor;

    FBufferBMP: TBitmap;
    FOnPageChanged: TNotifyEvent;
    FOnDrawNavigation: TDrawNavigation;
    procedure SeTASPages(Value: TStrings);
    procedure SetActivePage(const Value: string);
    function GetActivePage: string;
    procedure SeTASPageIndex(Value: Integer);
    procedure SetNavigationAcitveFont(const Value: TFont);
    procedure SetNavigationColor(const Value: TColor);
    procedure SetNavigationFont(const Value: TFont);
    function GeTASPageIndexFormPos(X, Y: Integer): Integer;
    procedure SetNavigationWidth(const Value: Integer);
    procedure SetNavigation3D(const Value: Boolean);
  protected

    procedure CreateParams(var Params: TCreateParams); override;
    function GetChildOwner: TComponent; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure ReadState(Reader: TReader); override;
    procedure ShowControl(AControl: TControl); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;

    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMLButtonDown(var Message: TWMLButtonDown);
      message WM_LBUTTONDOWN;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GeTASPageRect: TRect;
  published
    property Navigation3D: Boolean read FNavigation3D write SetNavigation3D;
    //导航的字体
    property NavigationFont: TFont read FNavigationFont write SetNavigationFont;
    //导航处于活动时的字体
    property NavigationAcitveFont: TFont read FNavigationAcitveFont write
      SetNavigationAcitveFont;
    //导航的颜色
    property NavigationColor: TColor read FNavigationColor write
      SetNavigationColor;
    //导航的宽度
    property NavigationWidth: Integer read FNavigationWidth write
      SetNavigationWidth;
    //设置当前页面
    property ActivePage: string read GetActivePage write SetActivePage stored
      False;
    property Align;
    property Anchors;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property Enabled;
    property Constraints;
    //页面索引
    property PageIndex: Integer read FPageIndex write SeTASPageIndex default
      0;
    //页面
    property Pages: TStrings read FAccess write SeTASPages stored False;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    //切换页面
    property OnPageChanged: TNotifyEvent read FOnPageChanged write
      FOnPageChanged;
    property OnDrawNavigation: TDrawNavigation read FOnDrawNavigation
      write FOnDrawNavigation;
    property OnStartDock;
    property OnStartDrag;
  end;
implementation

uses
  Consts;
//画出3D的边框

procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor:
  TColor;
  Width: Integer);

  procedure DoRect;
  var
    TopRight, BottomLeft: TPoint;
  begin
    with Canvas, Rect do
    begin
      TopRight.X := Right;
      TopRight.Y := Top;
      BottomLeft.X := Left;
      BottomLeft.Y := Bottom;
      Pen.Color := TopColor;
      PolyLine([BottomLeft, TopLeft, TopRight]);
      Pen.Color := BottomColor;
      Dec(BottomLeft.X);
      PolyLine([TopRight, BottomRight, BottomLeft]);
    end;
  end;

begin
  Canvas.Pen.Width := 1;
  Dec(Rect.Bottom);
  Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    InflateRect(Rect, -1, -1);
  end;
  Inc(Rect.Bottom);
  Inc(Rect.Right);
end;

//画出导航的切换按钮

function DrawNavigationButtonFace(Canvas: TCanvas; const Client: TRect;
  BevelWidth: Integer): TRect;
const
  IsRounded         = True;
var
  R                 : TRect;
  C1, C2            : TColor;
begin

  R := Client;
  with Canvas do
  begin
    Pen.Color := clWindowFrame;
    Brush.Style := bsSolid;
    Rectangle(R.Left, R.Top, R.Right, R.Bottom);

    if IsRounded then
    begin
      Pixels[R.Left, R.Top] := clBtnFace;
      Pixels[R.Left, R.Bottom - 1] := clBtnFace;
      Pixels[R.Right - 1, R.Top] := clBtnFace;
      Pixels[R.Right - 1, R.Bottom - 1] := clBtnFace;
    end;

    InflateRect(R, -1, -1);
    C1 := RGB(GetRValue(Brush.Color) - 5, GetRValue(Brush.Color) - 5,
      GetRValue(Brush.Color) - 5);
    C2 := RGB(GetRValue(Brush.Color) + 10, GetRValue(Brush.Color) + 10,
      GetRValue(Brush.Color) + 10);
    Frame3D(Canvas, R, C1, C2, BevelWidth);

  end;

  Result := Rect(Client.Left + 1, Client.Top + 1,
    Client.Right - 2, Client.Bottom - 2);
  OffsetRect(Result, 1, 1);
end;

{ TASPageAccess }

type
  TASPageAccess = class(TStrings)
  private
    PageList: TList;
    Notebook: TASPageControl;
  protected
    function GetCount: Integer; override;
    function Get(Index: Integer): string; override;
    function GetObject(Index: Integer): TObject; override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure Put(Index: Integer; const S: string); override;
  public
    constructor Create(APageList: TList; ANotebook: TASPageControl);
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
  end;

constructor TASPageAccess.Create(APageList: TList; ANotebook:
  TASPageControl);
begin
  inherited Create;
  PageList := APageList;
  Notebook := ANotebook;
end;

function TASPageAccess.GetCount: Integer;
begin
  Result := PageList.Count;
end;

function TASPageAccess.Get(Index: Integer): string;
begin
  Result := TASPage(PageList[Index]).Caption;
end;

procedure TASPageAccess.Put(Index: Integer; const S: string);
begin
  TASPage(PageList[Index]).Caption := S;
  Notebook.Invalidate;
end;

function TASPageAccess.GetObject(Index: Integer): TObject;
begin
  Result := PageList[Index];
end;

procedure TASPageAccess.SetUpdateState(Updating: Boolean);
begin
  { do nothing }
end;

procedure TASPageAccess.Clear;
var
  I                 : Integer;
begin
  for I := 0 to PageList.Count - 1 do
    TASPage(PageList[I]).Free;
  PageList.Clear;
end;

procedure TASPageAccess.Delete(Index: Integer);
var
  Form              : TCustomForm;
begin
  TASPage(PageList[Index]).Free;
  PageList.Delete(Index);
  NoteBook.PageIndex := 0;

  if csDesigning in NoteBook.ComponentState then
  begin
    Form := GetParentForm(NoteBook);
    if (Form <> nil) and (Form.Designer <> nil) then
      Form.Designer.Modified;
  end;
end;

procedure TASPageAccess.Insert(Index: Integer; const S: string);
var
  Page              : TASPage;
  Form              : TCustomForm;
begin
  Page := TASPage.Create(Notebook);
  with Page do
  begin
    Parent := Notebook;
    Caption := S;
  end;
  PageList.Insert(Index, Page);

  NoteBook.PageIndex := Index;

  if csDesigning in NoteBook.ComponentState then
  begin
    Form := GetParentForm(NoteBook);
    if (Form <> nil) and (Form.Designer <> nil) then
      Form.Designer.Modified;
  end;
end;

procedure TASPageAccess.Move(CurIndex, NewIndex: Integer);
var
  AObject           : TObject;
begin
  if CurIndex <> NewIndex then
  begin
    AObject := PageList[CurIndex];
    PageList[CurIndex] := PageList[NewIndex];
    PageList[NewIndex] := AObject;
    NoteBook.PageIndex := NewIndex;
  end;
end;

{ TASPage }

constructor TASPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Visible := False;
  ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible,
    csParentBackground];
end;

procedure TASPage.Paint;
begin
  inherited Paint;
  Canvas.Brush.Color := TASPageControl(Owner).Color;
  Canvas.FillRect(ClientRect);
end;

procedure TASPage.ReadState(Reader: TReader);