cxpcpainters.pas

PageControl 2.0 与1.0兼营版控件 ,TPageControl的扩展。增强了一些功能。

  if not ATab.RealEnabled then
    StateId := TIS_DISABLED
  else
    if ATab.IsMainTab then
      StateId := TIS_SELECTED
    else
      if ATab.HotTrack then
        StateId := TIS_HOT
      else
        StateId := TIS_NORMAL;*)
  if ATab.IsMainTab then
    ATabState := tsSelected
  else if ATab.HotTrack then
    ATabState := tsHot
  else
    ATabState := tsNormal;

  // to work like standard PageControl
  if not ParentInfo.MultiLine or TcxCustomTabControlAccess(ParentControl).RaggedRight then
    if (ATabState = tsSelected) and (ATabPositionWithinRow = tprRightMost) then
      ATabPositionWithinRow := tprMiddle;

  PartId := ATabNativePartA[ATab.IsMainTab, ATabPositionWithinRow];
  StateId := ATabNativeStateA[ATab.IsMainTab, ATabPositionWithinRow, ATabState];
end;
{$ENDIF}

function TcxPCTabsPainter.GetTabsPosition(
  NavigatorButtons: TcxPCNavigatorButtons): TcxPCTabsPosition;
const
  NormalTabsRectCorrectionA: array[TcxTabPosition] of TcxPCRectCorrection = (
    (dLeft:  0; dTop:  2; dRight:  0; dBottom:  0),
    (dLeft:  0; dTop:  0; dRight:  0; dBottom: -2),
    (dLeft:  2; dTop:  0; dRight:  0; dBottom:  0),
    (dLeft:  0; dTop:  0; dRight: -2; dBottom:  0)
  );
var
  NormalTabsRectCorrection: TcxPCRectCorrection;

  procedure DoHardCalculation;
  var
    ButtonsWidth: Integer;
  begin
    ButtonsWidth := CalculateButtonsWidth(NavigatorButtons);
    NormalTabsRectCorrection := NormalTabsRectCorrectionA[ParentInfo.TabPosition];
    with ParentInfo, NormalTabsRectCorrection, Result.ExtendedTabsRect do
    begin

      if TabPosition in [tpTop, tpBottom] then
        if MultiLine then
        begin
          Result.NormalRowWidth := Width - 4;
          dLeft := 2;
          dRight := -2;
        end else
        begin
          if IsRightToLeftAlignment(ParentControl) then dLeft := 0 else dLeft := 2;
          if NavigatorPosition in [npLeftTop, npLeftBottom] then
          begin
            Inc(dLeft, ButtonsWidth);
            Left := ButtonsWidth;
          end
          else Dec(Right, ButtonsWidth);
          Result.NormalRowWidth := Width - ButtonsWidth - 2;
          dRight := -(Width - Result.NormalRowWidth - dLeft);
        end
      else

      begin
        if MultiLine then
        begin
          Result.NormalRowWidth := Height - 4;
          dTop := 2;
          dBottom := -2;
        end else
        begin
          if IsBottomToTopAlignment(ParentControl) then dTop := 0 else dTop := 2;
          if NavigatorPosition in [npLeftTop, npRightTop] then
          begin
            Inc(dTop, ButtonsWidth);
            Top := ButtonsWidth;
          end
          else Dec(Bottom, ButtonsWidth);
          Result.NormalRowWidth := Height - ButtonsWidth - 2;
          dBottom := -(Height - Result.NormalRowWidth - dTop);
        end;
      end;
    end;
  end;

begin
  with Result do
  begin
    ExtendedTabsRect := GetControlRect(ParentControl);
    NormalTabsRect := ExtendedTabsRect;

    DoHardCalculation;

    CorrectRect(NormalTabsRect, NormalTabsRectCorrection);
    ExtendedTopOrLeftTabsRectBottomOrRightBorderOffset := 0;
    ExtendedBottomOrRightTabsRectTopOrLeftBorderOffset := 0;
    if ParentInfo.TabPosition in [tpTop, tpLeft] then
      ExtendedTopOrLeftTabsRectBottomOrRightBorderOffset := 1
    else
      ExtendedBottomOrRightTabsRectTopOrLeftBorderOffset := -1;
    MinDistanceBetweenTopOrLeftAndBottomOrRightExtendedTabsRects := 0;
  end;

  CalculateButtonsRegion(NavigatorButtons);
end;

function TcxPCTabsPainter.InternalCalculateTabNormalHeight: Integer;
begin
  Result := inherited InternalCalculateTabNormalHeight - 3;
end;

function TcxPCTabsPainter.IsNativePainting: Boolean;
begin
  if csDestroying in ParentControl.ComponentState then
    Result := False
  else
{$IFDEF VCL}
    Result := TcxCustomTabControlAccess(ParentControl).LookAndFeel.NativeStyle and
      AreVisualStylesAvailable and (OpenTheme(totTab) <> TC_NONE);
{$ELSE}
    Result := False;
{$ENDIF}
end;

function TcxPCTabsPainter.IsOverTab(TabVisibleIndex: Integer; X, Y: Integer): Boolean;
begin
  // TODO
  Result := True;
end;

procedure TcxPCTabsPainter.Paint;

{$IFDEF VCL}
  procedure PrepareBackgroundBitmap;
  var
    ATempCanvas: TCanvas;
    R: TRect;
  begin
    R := GetControlRect(ParentControl);
    DrawThemeParentBackground(ParentControl.Handle, FMDC, @R);

    ATempCanvas := TCanvas.Create;
    try
      ATempCanvas.Handle := FMDC;
      InternalPaintFrame(ATempCanvas);
    finally
      ATempCanvas.Free;
    end;
  end;
{$ENDIF}

begin
{$IFDEF VCL}
  if IsNativePainting then
  begin
    FMDC := 0;
    FPrevMDCBitmap := 0;
    try
      FMDC := CreateCompatibleDC(ParentInfo.Canvas.Handle);
      FPrevMDCBitmap := SelectObject(FMDC,
        CreateCompatibleBitmap(ParentInfo.Canvas.Handle, ParentControl.Width,
        ParentControl.Height));

      PrepareBackgroundBitmap;
      inherited Paint;
    finally
      if FPrevMDCBitmap <> 0 then
        DeleteObject(SelectObject(FMDC, FPrevMDCBitmap));
      if FMDC <> 0 then
        DeleteDC(FMDC);
    end;
  end
  else
{$ENDIF}
    inherited Paint;
end;

procedure TcxPCTabsPainter.PaintButton(Button: TcxPCNavigatorButton; ButtonRect: TRect);
{$IFDEF VCL}
const
  AButtonPartIdMap: array [TcxPCArrow] of Integer = (SPNP_UP, SPNP_DOWN,
    SPNP_DOWNHORZ, SPNP_UPHORZ);
  AButtonStateIdMap: array [TcxPCArrow, TcxPCNavigatorButtonState] of Integer = (
    (UPS_NORMAL, UPS_PRESSED, UPS_HOT, UPS_DISABLED),
    (DNS_NORMAL, DNS_PRESSED, DNS_HOT, DNS_DISABLED),
    (DNHZS_NORMAL, DNHZS_PRESSED, DNHZS_HOT, DNHZS_DISABLED),
    (UPHZS_NORMAL, UPHZS_PRESSED, UPHZS_HOT, UPHZS_DISABLED)
  );
var
  AArrow: TcxPCArrow;
  APartId, AStateId: Integer;
  ATheme: TTheme;
{$ENDIF}
begin
{$IFDEF VCL}
  if IsNativePainting then
  begin
    ATheme := OpenTheme(totSpin);
    AArrow := GetButtonArrow(Button);
    APartId := AButtonPartIdMap[AArrow];
    AStateId := AButtonStateIdMap[AArrow, ParentInfo.NavigatorButtonsState[Button]];
    if IsThemeBackgroundPartiallyTransparent(ATheme, APartId, AStateId) then
      DrawThemeParentBackground(ParentControl.Handle, ParentInfo.Canvas.Handle,
        @ButtonRect);
    DrawThemeBackground(ATheme, ParentInfo.Canvas.Handle, APartId, AStateId,
      @ButtonRect);
  end
  else
{$ENDIF}
    inherited PaintButton(Button, ButtonRect);
end;

procedure TcxPCTabsPainter.PaintFrame;
begin
{$IFDEF VCL}
  if IsNativePainting then
    InternalPaintFrame(ParentInfo.Canvas.Canvas)
  else
{$ENDIF}
    inherited PaintFrame;
end;

procedure TcxPCTabsPainter.PaintTabFrame(TabVisibleIndex: Integer);
const
  RRectCorrectionA: array[TcxPCTabPaintingPosition] of TcxPCRectCorrection = (
    (dLeft:  0; dTop:  0; dRight: 0; dBottom: StandardPainterTabBorderWidth),
    (dLeft:  0; dTop: -StandardPainterTabBorderWidth; dRight: 0; dBottom: 0),
    (dLeft:  0; dTop:  0; dRight: StandardPainterTabBorderWidth; dBottom: 0),
    (dLeft: -StandardPainterTabBorderWidth; dTop:  0; dRight: 0; dBottom: 0)
  );
  RRectNativePaintingCorrectionA: array[TcxPCTabPaintingPosition] of TcxPCRectCorrection = (
    (dLeft: 0; dTop: 0; dRight: 0; dBottom: 1),
    (dLeft: 0; dTop: -1; dRight: 0; dBottom: 0),
    (dLeft: 0; dTop: 0; dRight: 1; dBottom: 0),
    (dLeft: -1; dTop: 0; dRight: 0; dBottom: 0)
  );
var
  ANativePainting: Boolean;
  Tab: TcxTab;
  MainTab: Boolean;
  AFocusRect, FullRect, R: TRect;
  TabPaintingPosition: TcxPCTabPaintingPosition;
  ALineIndexBoundsA: TcxPCLineIndexBoundsArray;
{$IFDEF VCL}
  ABitmap: TBitmap;
  R1: TRect;
{$ENDIF}
begin
  Tab := ParentInfo.VisibleTabs[TabVisibleIndex];
  MainTab := Tab.IsMainTab;
  InitializeLineBoundsArray(ParentControl, ALineIndexBoundsA);

  FullRect := Tab.FullRect;
  TabPaintingPosition := Tab.PaintingPosition;
  with ParentInfo.Canvas do
  begin
    ANativePainting := IsNativePainting;
    R := FullRect;
    if ANativePainting then
    begin
      if MainTab then
        CorrectRect(R, RRectNativePaintingCorrectionA[TabPaintingPosition]);
    end else
    begin
      InflateRect(R, -StandardPainterTabBorderWidth, -StandardPainterTabBorderWidth);
      if MainTab then
        CorrectRect(R, RRectCorrectionA[TabPaintingPosition]);
    end;

{$IFDEF VCL}
    if ANativePainting then
    begin
      ABitmap := TcxTabAccess(Tab).PaintBitmap;
      case Tab.PaintingPositionIndex of
        2, 4, 7, 11:
          RotateBitmap(ABitmap, raPlus90);
        3, 5, 8, 12:
          RotateBitmap(ABitmap, raMinus90);
      end;
      R1 := Rect(0, 0, ABitmap.Width, ABitmap.Height);
      CopyRect(R, ABitmap.Canvas, R1);

      R := FullRect;
      InflateRect(R, -StandardPainterTabBorderWidth, -StandardPainterTabBorderWidth);
      if MainTab then
        CorrectRect(R, RRectNativePaintingCorrectionA[TabPaintingPosition]);
      InternalDrawFocusRect(TabVisibleIndex, R);
      TcxTabAccess(Tab).ResetPaintBitmap;
      Exit;
    end;
{$ENDIF}

    Brush.Style := bsSolid;
    Brush.Color := GetTabBodyColor(TabVisibleIndex);
    FillRect(R);

    if MainTab then
    begin
      AFocusRect := R;
      case TabPaintingPosition of
        tppLeft:
          Dec(AFocusRect.Right);
        tppTop:
          Dec(AFocusRect.Bottom);
        tppRight:
          Inc(AFocusRect.Left);
        tppBottom:
          Inc(AFocusRect.Top);
      end;
      InternalDrawFocusRect(TabVisibleIndex, AFocusRect);
    end;

    if not MainTab then
    begin
      with R do
        case TabPaintingPosition of
          tppTop:
            begin
              Top := Bottom;
              Bottom := Top + StandardPainterTabBorderWidth;
            end;
          tppBottom:
            begin
              Bottom := Top;
              Top := Bottom - StandardPainterTabBorderWidth;
            end;
          tppLeft:
            begin
              Left := Right;
              Right := Left + StandardPainterTabBorderWidth;
            end;
          tppRight:
            begin
              Right := Left;
              Left := Right - StandardPainterTabBorderWidth;
            end;
        end;
      Brush.Color := ParentInfo.Color;
      FillRect(R);
    end;
  end;

//    FullRect := Tab.FullRect;
    with FullRect do
    begin
      case TabPaintingPosition of
        tppTop:
          begin
            InternalPolyLine([Point(Left, Bottom - 1), Point(Left, Top + 2), Point(Left + 2, Top), Point(Right - 3, Top)], cxPCLightestEdgeColor);
            InternalPolyLine([Point(Left + 1, Bottom - 1), Point(Left + 1, Top + 2), Point(Left + 2, Top + 1), Point(Right - 3, Top + 1)], cxPCLightEdgeColor);
            InternalPolyLine([Point(Right - 1, Bottom - 1), Point(Right - 1, Top + 2), Point(Right - 2, Top + 1)], cxPCDarkestEdgeColor);
            InternalPolyLine([Point(Right - 2, Bottom - 1), Point(Right - 2, Top + 2)], cxPCDarkEdgeColor);

            if MainTab then