unitaspages.pas

仿速达界面控件

begin
  if Reader.Parent is TASPageControl then
    TASPageControl(Reader.Parent).FPageList.Add(Self);
  inherited ReadState(Reader);
end;

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

{ TASPageControl }

var
  Registered        : Boolean = False;

constructor TASPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 150;
  Height := 150;
  FNavigationWidth := 100;
  FPageList := TList.Create;
  FAccess := TASPageAccess.Create(FPageList, Self);
  FPageIndex := -1;
  //
  FAccess.Add('默认页面');
  PageIndex := 0;
  //
  Exclude(FComponentStyle, csInheritable);
  //
  FNavigation3D := True;
  FNavigationFont := TFont.Create;
  FNavigationFont.Color := clWhite;
  FNavigationFont.Style := [fsBold];
  FNavigationAcitveFont := TFont.Create;
  FNavigationAcitveFont.Color := clBlack;
  FNavigationAcitveFont.Style := [fsBold];
  //
  Self.Color := $00BEE9EB;
  FNavigationColor := $00408000;
  DoubleBuffered := True;
  FBufferBMP := TBitmap.Create;
  //
  ControlStyle := ControlStyle + [csParentBackground];
  if not Registered then
  begin
    Classes.RegisterClasses([TASPage]);
    Registered := True;
  end;
end;

destructor TASPageControl.Destroy;
begin
  FBufferBMP.Free;
  FAccess.Free;
  FPageList.Free;
  inherited Destroy;
end;

procedure TASPageControl.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 TASPageControl.GetChildOwner: TComponent;
begin
  Result := Self;
end;

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

procedure TASPageControl.ReadState(Reader: TReader);
begin
  Pages.Clear;
  inherited ReadState(Reader);
  if (FPageIndex <> -1) and (FPageIndex >= 0) and (FPageIndex < FPageList.Count)
    then
    with TASPage(FPageList[FPageIndex]) do
    begin
      BringToFront;
      Visible := True;
      Left := FNavigationWidth;
      Width := Self.Width - FNavigationWidth;
      Top := 0;
      Height := Self.Height;
    end
  else
    FPageIndex := -1;
end;

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

procedure TASPageControl.SeTASPages(Value: TStrings);
begin
  FAccess.Assign(Value);
end;

procedure TASPageControl.SeTASPageIndex(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 TASPage(FPageList[Value]) do
    begin
      BringToFront;
      Visible := True;
      Left := FNavigationWidth;
      Width := Self.Width - FNavigationWidth;
      Top := 0;
      Height := Self.Height;
    end;
    if (FPageIndex >= 0) and (FPageIndex < FPageList.Count) then
      TASPage(FPageList[FPageIndex]).Visible := False;
    FPageIndex := Value;
    if ParentForm <> nil then
      if ParentForm.ActiveControl = Self then
        SelectFirst;
    if Assigned(FOnPageChanged) then
      FOnPageChanged(Self);
  end;
  Invalidate;
end;

procedure TASPageControl.SetActivePage(const Value: string);
begin
  SeTASPageIndex(FAccess.IndexOf(Value));
end;

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

procedure TASPageControl.SetNavigationAcitveFont(const Value: TFont);
begin
  FNavigationAcitveFont.Assign(Value);
  Invalidate;
end;

procedure TASPageControl.SetNavigationColor(const Value: TColor);
begin
  FNavigationColor := Value;
  Invalidate;
end;

procedure TASPageControl.SetNavigationFont(const Value: TFont);
begin
  FNavigationFont.Assign(Value);
  Invalidate;
end;

procedure TASPageControl.Paint;
var
  ACanvas           : TCanvas;
  ARect             : TRect;
  NavigationHeight  : Integer;
  I                 : Integer;

  procedure DrawNavigationText(AText: string; Font: TFont; ARect: TRect);
  var
    oldFont         : TFont;
  begin
    OldFont := TFont.Create;
    try
      OldFont.Assign(ACanvas.Font);
      ACanvas.Font := Font;
      DrawText(ACanvas, AText, ARect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
      ACanvas.Font := oldFont;
    finally
      OldFont.Free;
    end;
  end;
var
  L, R              : Integer;
  NRect, BRect      : TRect;
begin
  inherited Paint();
  //
  FBufferBMP.Width := 0;
  FBufferBMP.Height := 0;
  FBufferBMP.Width := FNavigationWidth;
  FBufferBMP.Height := Self.Height;
  //
  ACanvas := FBufferBMP.Canvas;
  ACanvas.Lock;
  try
    ARect := Rect(0, 0, FNavigationWidth, Self.Height);
    ACanvas.Brush.Color := Color;
    ACanvas.FillRect(ARect);
    if FAccess.Count = 0 then
      Exit;
    NavigationHeight := Self.Height div FAccess.Count;
    ACanvas.Brush.Color := FNavigationColor;
    for I := 0 to FAccess.Count - 1 do
    begin
      ARect := Rect(0, I * NavigationHeight, FNavigationWidth,
        (I + 1) * NavigationHeight + 1);
      if I = FPageIndex then
      begin
        ACanvas.Brush.Color := Color;
        ACanvas.FillRect(ARect);
        DrawNavigationText(FAccess[I], FNavigationAcitveFont, ARect);
        ACanvas.Brush.Color := FNavigationColor;
      end
      else
      begin
        if FNavigation3D then
        begin
          DrawNavigationButtonFace(ACanvas, ARect, 1);
        end
        else
        begin
          ACanvas.FillRect(ARect);
          ACanvas.Rectangle(ARect);
        end;
        DrawNavigationText(FAccess[I], FNavigationFont, ARect);
      end;
      if Assigned(FOnDrawNavigation) then
        FOnDrawNavigation(Self, ACanvas, ARect, I = FPageIndex);
    end;

    NRect := Rect(0, 0, FNavigationWidth, Self.ClientHeight);
    BRect := Rect(0, 0, FBufferBMP.Width, FBufferBMP.Height);
    Self.Canvas.CopyRect(NRect, ACanvas, BRect);
  finally
    ACanvas.Unlock;
  end;
end;

procedure TASPageControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  PageIndex := GeTASPageIndexFormPos(X, Y);
  Invalidate;
end;

function TASPageControl.GeTASPageIndexFormPos(X, Y: Integer): Integer;
var
  I                 : Integer;
  ARect             : TRect;
  NavigationHeight  : Integer;
begin
  Result := FPageIndex;
  if FAccess.Count = 0 then
    Exit;
  NavigationHeight := Self.Height div FAccess.Count;
  for I := 0 to FAccess.Count - 1 do
  begin
    ARect := Rect(0, I * NavigationHeight, FNavigationWidth - 1,
      (I + 1) * NavigationHeight);
    if (X > ARect.Left) and (X < ARect.Right) and
      (Y > ARect.Top) and (Y < ARect.Bottom) then
    begin
      Result := I;
      Exit;
    end;
  end;
end;

procedure TASPageControl.WMSize(var Message: TWMSize);
begin
  inherited;
  if csLoading in ComponentState then
    Exit;
  if FPageList.Count > 0 then
  begin
    TASPage(FPageList[FPageIndex]).Left := FNavigationWidth;
    TASPage(FPageList[FPageIndex]).Width := Width - FNavigationWidth;
    TASPage(FPageList[FPageIndex]).Height := Height;
    TASPage(FPageList[FPageIndex]).Top := 0;
    Invalidate;
  end;
end;

function TASPageControl.GeTASPageRect: TRect;
begin
  Result := REct(TASPage(FPageList[PageIndex]).Left,
    TASPage(FPageList[PageIndex]).Top,
    TASPage(FPageList[PageIndex]).Left +
    TASPage(FPageList[PageIndex]).Width,
    TASPage(FPageList[PageIndex]).Top +
    TASPage(FPageList[PageIndex]).Height);
end;

procedure TASPageControl.SetNavigationWidth(const Value: Integer);
begin
  if FNavigationWidth <> Value then
  begin
    FNavigationWidth := Value;
    if csLoading in ComponentState then
      Exit;
    TASPage(FPageList[PageIndex]).Left := Value;
    TASPage(FPageList[PageIndex]).Width := Width - Value;
    TASPage(FPageList[PageIndex]).Top := 0;
    TASPage(FPageList[PageIndex]).Height := Height;
    Invalidate;
  end;
end;

procedure TASPageControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if (csDesigning in ComponentState) then
  begin
    PageIndex := GeTASPageIndexFormPos(Message.XPos, Message.YPos);
    Invalidate;
  end
  else
  begin
    inherited;
  end;
end;

procedure TASPageControl.SetNavigation3D(const Value: Boolean);
begin
  if FNavigation3D <> Value then
  begin
    FNavigation3D := Value;
    Invalidate;
  end;
end;

end.