acnotebook.pas

Alpha Controls 界面控件包

unit acNoteBook;

interface

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

type
{$IFNDEF NOTFORHELP}
  TsNotebook = class;

  TsPage = class(TCustomControl)
  private
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMEraseBkGnd(var Message: TWMPaint); message WM_ERASEBKGND;
  protected
    FOwner : TsNotebook;
    procedure ReadState(Reader: TReader); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure WndProc (var Message: TMessage); override;
  published
    property Caption;
    property Height stored False;
    property TabOrder stored False;
    property Visible stored False;
    property Width stored False;
  end;
{$ENDIF}

  TsNotebook = class(TCustomControl)
{$IFNDEF NOTFORHELP}
  private
    FPageList: TList;
    FAccess: TStrings;
    FPageIndex: Integer;
    FOnPageChanged: TNotifyEvent;
    FCommonData: TsCommonData;
    procedure SetPages(Value: TStrings);
    procedure SetActivePage(const Value: string);
    function GetActivePage: string;
    procedure SetPageIndex(Value: Integer);
  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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
  published
    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 SetPageIndex default 0;
    property Pages: TStrings read FAccess write SetPages 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 OnStartDock;
    property OnStartDrag;
{$ENDIF}
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

uses Consts, sConst, sMessages, sVclUtils, sGraphUtils, sAlphaGraph, sStyleSimply;

{ TsPageAccess }

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

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

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

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

procedure TsPageAccess.Put(Index: Integer; const S: string);
begin
  TsPage(PageList[Index]).Caption := S;
end;

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

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

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

procedure TsPageAccess.Delete(Index: Integer);
var
  Form: TCustomForm;
begin
  TsPage(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 TsPageAccess.Insert(Index: Integer; const S: string);
var
  Page: TsPage;
  Form: TCustomForm;
begin
  Page := TsPage.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 TsPageAccess.Move(CurIndex, NewIndex: Integer);
var
  AObject: TObject;
begin
  if CurIndex <> NewIndex then begin
    AObject := PageList[CurIndex];
    PageList[CurIndex] := PageList[NewIndex];
    PageList[NewIndex] := AObject;
  end;
end;

{ TsPage }

constructor TsPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := TsNotebook(AOwner);
  Visible := False;
  ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
  Align := alClient;
end;

procedure TsPage.Paint;
var
  CI : TCacheInfo;
begin
  if FOwner = nil then Exit;
  if (csDestroying in ComponentState) or
       (csCreating in Parent.ControlState) or
         not Assigned(FOwner.FCommonData) or not FOwner.FCommonData.Skinned or not FOwner.FCommonData.SkinManager.SkinData.Active then begin
    inherited Paint;
    if csDesigning in ComponentState then with Canvas do begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  end
  else begin
    FOwner.FCommonData.Updating := FOwner.FCommonData.Updating;
    if not FOwner.FCommonData.Updating then begin
      // If transparent and form resizing processed
      b := FOwner.FCommonData.HalfVisible or FOwner.FCommonData.BGChanged;// or GetBoolMsg(Parent.Handle, AC_GETHALFVISIBLE);

      if FOwner.FCommonData.RepaintIfMoved then begin
        FOwner.FCommonData.HalfVisible := not (PtInRect(Parent.ClientRect, Point(Left + 1, Top + 1)));
        FOwner.FCommonData.HalfVisible := FOwner.FCommonData.HalfVisible or not PtInRect(Parent.ClientRect, Point(Left + Width - 1, Top + Height - 1));
      end
      else FOwner.FCommonData.HalfVisible := False;

      if b and not FOwner.FCommonData.UrgentPainting then begin
        FOwner.FCommonData.InitCacheBmp;
        CI := GetParentCache(FOwner.FCommonData);
        PaintItem(FOwner.FCommonData, CI, False, 0, Rect(0, 0, width, Height), Point(FOwner.Left, FOwner.Top), FOwner.FCommonData.FCacheBMP, False);

        FOwner.FCommonData.BGChanged := False;
      end;
      UpdateCorners(FOwner.FCommonData, 0);
      CopyWinControlCache(Self, FOwner.FCommonData, Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), Canvas.Handle, True);

      sVCLUtils.PaintControls(Canvas.Handle, Self, b and FOwner.SkinData.RepaintIfMoved, Point(0, 0)); // Painting of the skinned TGraphControls !!!!!!!
      SetParentUpdated(Self);
    end;
  end;
end;

procedure TsPage.ReadState(Reader: TReader);
begin
  if Reader.Parent is TsNotebook then TsNotebook(Reader.Parent).FPageList.Add(Self);
  inherited ReadState(Reader);
end;

procedure TsPage.WMEraseBkGnd(var Message: TWMPaint);
begin
  if not FOwner.SkinData.Skinned then inherited;
end;

procedure TsPage.WMNCHitTest(var Message: TWMNCHitTest);
begin
  if not (csDesigning in ComponentState) then Message.Result := HTTRANSPARENT else inherited;
end;

procedure TsPage.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_GETCACHE : if FOwner.SkinData.Skinned then begin
      SendAMessage(FOwner, AC_GETCACHE);
      GlobalCacheInfo.X := 0;
      GlobalCacheInfo.Y := 0;
    end;
    AC_GETCONTROLCOLOR : if FOwner.SkinData.Skinned then begin
      SendMessage(FOwner.Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0)
    end;
    AC_PREPARING : if FOwner.SkinData.Skinned then begin
      Message.LParam := integer(GetBoolMsg(FOwner, AC_PREPARING));
      Exit;
    end;
    AC_CHILDCHANGED : if FOwner.SkinData.Skinned then begin
      Message.LParam := integer((FOwner.SkinData.SkinManager.gd[FOwner.SkinData.SkinIndex].GradientPercent +
                        FOwner.SkinData.SkinManager.gd[FOwner.SkinData.SkinIndex].ImagePercent > 0) or
                        FOwner.SkinData.RepaintIfMoved);
    end;
  end;
  inherited;
end;

{ TsNotebook }

var
  Registered: Boolean = False;

constructor TsNotebook.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsPanel;
  Width := 150;
  Height := 150;
  FPageList := TList.Create;
  FAccess := TsPageAccess.Create(FPageList, Self);
  FPageIndex := -1;
  FAccess.Add(SDefault);
  PageIndex := 0;
  Exclude(FComponentStyle, csInheritable);
  if not Registered then begin
    Classes.RegisterClasses([TsPage]);
    Registered := True;
  end;
end;

destructor TsNotebook.Destroy;
begin
  FAccess.Free;
  FPageList.Free;
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsNotebook.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := Style or WS_CLIPCHILDREN;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

function TsNotebook.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TsNotebook.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
begin
  for I := 0 to FPageList.Count - 1 do Proc(TControl(FPageList[I]));
end;

procedure TsNotebook.ReadState(Reader: TReader);
begin
  Pages.Clear;
  inherited ReadState(Reader);
  if (FPageIndex <> -1) and (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then with TsPage(FPageList[FPageIndex]) do begin
    BringToFront;
    Visible := True;
    Align := alClient;
  end
  else FPageIndex := -1;
end;

procedure TsNotebook.ShowControl(AControl: TControl);
var
  I: Integer;
begin
  for I := 0 to FPageList.Count - 1 do if FPageList[I] = AControl then begin
    SetPageIndex(I);
    Exit;
  end;
  inherited ShowControl(AControl);
end;

procedure TsNotebook.SetPages(Value: TStrings);
begin
  FAccess.Assign(Value);
end;

procedure TsNotebook.SetPageIndex(Value: Integer);
var
  ParentForm: TCustomForm;
begin
  if csLoading in ComponentState then begin
    FPageIndex := Value;
    Exit;
  end;
  if (Value <> FPageIndex) and (Value >= 0) and (Value < FPageList.Count) then begin
    ParentForm := GetParentForm(Self);
    if ParentForm <> nil then if ContainsControl(ParentForm.ActiveControl) then ParentForm.ActiveControl := Self;
    with TsPage(FPageList[Value]) do begin
      BringToFront;
      Visible := True;
      Align := alClient;
    end;
    if (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then TsPage(FPageList[FPageIndex]).Visible := False;
    FPageIndex := Value;
    if ParentForm <> nil then if ParentForm.ActiveControl = Self then SelectFirst;
    if Assigned(FOnPageChanged) then FOnPageChanged(Self);
  end;
end;

procedure TsNotebook.SetActivePage(const Value: string);
begin
  SetPageIndex(FAccess.IndexOf(Value));
end;

function TsNotebook.GetActivePage: string;
begin
  Result := FAccess[FPageIndex];
end;

procedure TsNotebook.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsNotebook.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsNotebook.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_ALLCHILDREN);
      end;
      AlphaBroadCast(Self, Message);
      exit
    end;
    AC_SETNEWSKIN : begin
      AlphaBroadCast(Self, Message);
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
      end;
      exit
    end;
    AC_REFRESH : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        AlphaBroadCast(Self, Message);
        RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_ALLCHILDREN);
      end
      else AlphaBroadCast(Self, Message);
      exit
    end;
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_ENDPARENTUPDATE : begin
        FCommonData.Updating := False;
        RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_ALLCHILDREN);
      end;
      AC_PREPARING       : begin
        Message.LParam := integer(FCommonData.BGChanged or FCommonData.Updating);
      end;
      AC_URGENTPAINT : begin 
        CommonWndProc(Message, FCommonData);
        if FCommonData.UrgentPainting then begin
          FCommonData.InitCacheBmp;
          FCommonData.BGChanged := False;
        end;
      end
      else CommonMessage(Message, FCommonData);
    end
    else begin
      CommonWndProc(Message, FCommonData);
      inherited;
    end;
  end;
end;

end.