tabnotbk.pas

这是不可多得的源代码

    RegisterClasses([TTabPage]);
    Registered := True;
  end;
end;

{ Method      : Destroy
  Description : Remove all the lists before removing self. }
destructor TTabbedNotebook.Destroy;
begin
  FAccess.Free;
  FPageList.Free;
  FTabFont.Free;
  inherited  Destroy;
end;

procedure TTabbedNotebook.CreateHandle;
var
  X: Integer;
begin
  inherited CreateHandle;
  if not (csReading in ComponentState) and (Tabs.Count = 0) then
  begin
    { don't copy the objects into the Tabs list }
    for X := 0 to FAccess.Count-1 do
      Tabs.Add(FAccess[X]);
    TabIndex := FPageIndex;
  end;
end;

{ Method      : CreateParams
  Description : Make sure ClipChildren is set. }
procedure TTabbedNotebook.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

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

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

{ Method      : Loaded
  Description : Make sure only one page is visible, the one set as the
                default page. }
procedure TTabbedNotebook.Loaded;
var
  Index: Integer;
begin
  inherited Loaded;
  for Index := 0 to FPageList.Count - 1 do
    if Index <> FPageIndex then
    begin
      (TObject(FPageList[Index]) as TTabPage).Enabled := False;
      (TObject(FPageList[Index]) as TTabPage).Visible := False;
    end
    else
    begin
      (TObject(FPageList[Index]) as TTabPage).Enabled := True;
      (TObject(FPageList[Index]) as TTabPage).Visible := True;
    end;
  if HandleAllocated then
  begin
    Tabs.Clear;
    for Index := 0 to FAccess.Count-1 do
      Tabs.Add(FAccess[Index]);
    TabIndex := FPageIndex;
  end;
  Realign;
end;

{ Method      : ReadState
  Description : Don't send the button information out since it is all the
                same anyway.}
procedure TTabbedNotebook.ReadState(Reader: TReader);
begin
  FAccess.Clear;
  inherited ReadState(Reader);
  if (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
  begin
    with (TObject(FPageList[FPageIndex]) as TTabPage) do
    begin
      Enabled := True;
      BringToFront;
      Align := alClient;
    end;
  end
  else
    FPageIndex := -1;
end;

{ Method      : SetPages
  Description : }
procedure TTabbedNotebook.SetPages(Value: TStrings);
begin
  FAccess.Assign(Value);
  if FAccess.Count > 0 then
    FPageIndex := 0
  else
    FPageIndex := -1;
end;

procedure TTabbedNotebook.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;

{ Method      : SetPageIndex
  Description : Set the active page to the one specified in Value. }
procedure TTabbedNotebook.SetPageIndex(Value: Integer);
var
  AllowChange: Boolean;
  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
    if Assigned(FOnChange) then
    begin
      AllowChange := True;
      FOnChange(Self, Value, AllowChange);
      if not AllowChange then Exit;
    end;

    ParentForm := GetParentForm(Self);
    if ParentForm <> nil then
      if ContainsControl(ParentForm.ActiveControl) then
        ParentForm.ActiveControl := Self;

    if HandleAllocated then
      TabIndex := Value;

    with TTabPage(FPageList[Value]) do
    begin
      BringToFront;
      Visible := True;
      Enabled := True;
    end;

    if (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
      with TTabPage(FPageList[FPageIndex]) do
      begin
        Visible := False;
        Enabled := False;
      end;

    if (FPageIndex div FTabsPerRow) <> (Value div FTabsPerRow) then
    begin
      FPageIndex := Value;
      Realign;
    end
    else
      FPageIndex := Value;
  end;
end;


{ Method      : SetActivePage
  Description : Set the active page to the named page. }
procedure TTabbedNotebook.SetActivePage(const Value: string);
begin
  SetPageIndex(FAccess.IndexOf(Value));
end;

{ Method      : GetActivePage
  Description : Return the name of the currently active page. }
function TTabbedNotebook.GetActivePage: string;
begin
  if (FAccess.Count > 0) and (FPageIndex >= 0) then
    Result := FAccess[FPageIndex]
  else
    Result := '';
end;

{ Method      : WMGetDlgCode
  Description : Get arrow keys to manage the tab focus rect }
procedure TTabbedNotebook.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

{ Method      : CMDialogChar
  Description : Check for dialog keys in the tabs }
procedure TTabbedNotebook.CMDialogChar(var Message: TCMDialogChar);
var
  Index: Integer;
begin
  with Message do
    if FPageList <> nil then
    begin
      for Index := 0 to FPageList.Count - 1 do
      begin
        if IsAccel(CharCode, TTabPage(FPageList[Index]).Caption) then
        begin
          SetFocus;
          if Focused then
          begin
            SetPageIndex(Index);
            Click;
          end;
          Result := 1;
          Exit;
        end;
      end;
    end;
    inherited;
end;

{ Method      : KeyDown
  Description : Grab arrow keys to manage the active page. }
procedure TTabbedNotebook.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RIGHT, VK_DOWN:
      begin
        if FPageIndex >= (FPageList.Count-1) then SetPageIndex(0)
        else SetPageIndex(FPageIndex + 1);
        Click;
      end;
    VK_LEFT, VK_UP:
      begin
        if FPageIndex > 0 then SetPageIndex(FPageIndex - 1)
        else SetPageIndex(FPageList.Count - 1);
        Click;
      end;
  end;
end;

{ Method      : SetTabsPerRow
  Description : Set the number of tabs in each row.  Don't allow less than
                three. }
procedure TTabbedNotebook.SetTabsPerRow(NewTabCount: Integer);
begin
  if (NewTabCount >= 3) then
  begin
    FTabsPerRow := NewTabCount;
    Realign;
    Invalidate;
  end;
end;

{ Mathod: GetIndexForPage
  Description : Given a page name, return its index number. }
function TTabbedNotebook.GetIndexForPage(const PageName: String): Integer;
var
  Index: Integer;
begin
  Result := -1;

  if FPageList <> nil then
  begin
    For Index := 0 to FPageList.Count-1 do
    begin
      if ((TObject(FPageList[Index]) as TTabPage).Caption = PageName) then
      begin
        Result := Index;
        Exit;
      end;
    end;
  end;
end;

{ Method      : SetTabFont
  Description : Set the font for the tabs. }
procedure TTabbedNotebook.SetTabFont(Value: TFont);
begin
  FTabFont.Assign(Value);
end;

{ Method      : CMTabFontChanged
  Description : Fix the TopFont and redraw the buttons with the new font. }
procedure TTabbedNotebook.CMTabFontChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TTabbedNotebook.AlignControls(AControl: TControl; var Rect: TRect);
begin
  If (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
    inherited AlignControls(FPageList[FPageIndex], Rect);
end;

{ Method      : TabFontChanged
  Description : Send out the proper message. }
procedure TTabbedNotebook.TabFontChanged(Sender: TObject);
begin
  Perform(CM_TABFONTCHANGED, 0, 0);
end;

{ Method      : Click
  Description : Call event procedure. }
procedure TTabbedNotebook.Click;
begin
  if Assigned(FOnClick) then FOnClick(Self);
end;

procedure TTabbedNotebook.Change;
begin
  if TabIndex >= 0 then
    SetPageIndex(TabIndex);
  if FPageIndex = TabIndex then
    inherited Change
  else
    TabIndex := FPageIndex;
end;

procedure TTabbedNotebook.WMPaint(var Message: TWMPaint);
begin
  SendMessage(Handle, wm_SetFont, TabFont.Handle, 0);
  inherited;
end;


end.