⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cxpcpainters.pas

📁 PageControl 2.0 与1.0兼营版控件 ,TPageControl的扩展。增强了一些功能。
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   )
  );

  FlatPainterButtonSize = 13;
  FlatPainterButtonsDistance = 4;
  FlatPainterButtonsRegionAdditionalFreeSpaceWidth = 2;
  FlatPainterDefaultTabNormalHeight = 17;
  FlatPainterDefaultTabNormalHTextOffset = 2;
  FlatPainterDefaultTabNormalWidth = 0;
  FlatPainterDefaultTabNormalWTextOffset = 5;
  FlatPainterDrawImageOffsetA: array [Boolean] of TRect = (
    (Left: 2; Top: 0; Right: 0; Bottom: 0),
    (Left: 3; Top: 0; Right: 0; Bottom: 0)
  );
  FlatPainterDrawTextOffsetA: array [Boolean] of TRect = (
    (Left: 5; Top: 2; Right: 3; Bottom: -1),
    (Left: 6; Top: 2; Right: 3; Bottom: -1)
  );
  FlatPainterImageTextDistance = 6;
  FlatPainterMainTabBorderWidth = 1;
  FlatPainterMainTabRectCorrection: TcxPCRectCorrection = (
    dLeft: -1; dTop: -1; dRight: 1; dBottom: 1
  );
  FlatPainterTabContentWOffset: array [Boolean] of TcxPCWOffset = (
    (Left: 2; Right: 2),
    (Left: 3; Right: 3)
  );
  FlatPainterTabSideOffset = 6;
  FlatPainterTabsNormalDistance: TcxPCDistance = (dw: 1; dh: 6);
  FlatPainterTooNarrowTabContentWOffset: array [Boolean] of TcxPCWOffset = (
    (Left: 2; Right: 2),
    (Left: 3; Right: 3)
  );
  FlatPainterWDistanceBetweenImageBorderAndText = 0;

  ButtonedPainterDistanceBetweenTabsAndClientRects = 2;

  MinTabSelectionDistance: TcxPCDistance = (dw: 4; dh: 4);
  EmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);

  cxPCDarkEdgeColor = clBtnShadow;
  cxPCDarkestEdgeColor = {$IFDEF VCL}cl3DDkShadow{$ELSE}clShadow{$ENDIF};
  cxPCTabBodyColor = clBtnFace;
  cxPCLightEdgeColor = cl3DLight;
  cxPCLightestEdgeColor = clBtnHighlight;

  cxPCLightBrushColorDelta = 20;

  cxPCArrowConvertionA: array [nbTopLeft .. nbBottomRight, Boolean] of TcxPCArrow = (
    (aLeft, aTop),
    (aRight, aBottom)
  );
  cxPCArrowSizeA: array [TcxPCNavigatorButton] of Integer = (5, 5, 4);

type
  TcxCustomTabControlAccess = class(TcxCustomTabControl);
  TcxTabAccess = class(TcxTab);
  TWinControlAccess = class(TWinControl);

procedure CalculateLightBrushColor;
var
  R, G, B: Integer;
  Color: Integer;
begin
  Color := ColorToRGB(clBtnFace);
  R := GetRValue(Color) + cxPCLightBrushColorDelta;
  if R > 255 then R := 255;
  G := GetGValue(Color) + cxPCLightBrushColorDelta;
  if G > 255 then G := 255;
  B := GetBValue(Color) + cxPCLightBrushColorDelta;
  if B > 255 then B := 255;
//{$IFDEF VCL}
  cxPCLightBrushColor := RGB(R, G, B);
//{$ELSE}
//  cxPCLightBrushColor := RGB(B, G, R);
//{$ENDIF}
end;

function GetControlRect(Control: TControl): TRect;
begin
  with Result do
  begin
    Left := 0;
    Top := 0;
    Right := Control.Width;
    Bottom := Control.Height;
  end;
end;

{$IFDEF VCL}
function GetNativeFrameSizeCorrection(ATabControl: TcxCustomTabControl): TcxPCRectCorrection;
var
  ADC: HDC;
  ATheme: TTheme;
  R, R1: TRect;
begin
  ATheme := OpenTheme(totTab);
  R := Rect(0, 0, MaxInt, MaxInt);
  ADC := GetWindowDC(ATabControl.Handle);
  GetThemeBackgroundContentRect(ATheme, ADC, TABP_PANE, 0, @R, R1);
  ReleaseDC(ATabControl.Handle, ADC);
  Result.dLeft := R1.Left;
  Result.dTop := R1.Top;
  Result.dRight := R1.Right - MaxInt;
  Result.dBottom := R1.Bottom - MaxInt;
end;
{$ENDIF}

function Size(cx, cy: Integer): TSize;
begin
  Result.cx := cx;
  Result.cy := cy;
end;

procedure TcxPCTabsPainter.CorrectTabRect(TabVisibleIndex: Integer;
  var TabRectCorrection: TcxPCRectCorrection);
const
  TabRectCorrectionA: array[TcxPCTabPaintingPosition] of TcxPCRectCorrection = (
    (dLeft: -2; dTop: -2; dRight: 2; dBottom: 1),
    (dLeft: -2; dTop: -1; dRight: 2; dBottom: 2),
    (dLeft: -2; dTop: -2; dRight: 1; dBottom: 2),
    (dLeft: -1; dTop: -2; dRight: 2; dBottom: 2)
  );
begin
  inherited;
  with ParentInfo.VisibleTabs[TabVisibleIndex] do
    if ParentInfo.MainTabVisibleIndex = TabVisibleIndex then
      TabRectCorrection := TabRectCorrectionA[PaintingPosition];
end;

function TcxPCTabsPainter.GetButtonHeight: Integer;
begin
  if not IsNativePainting then
    Result := inherited GetButtonHeight
  else
    Result := StandardNativePainterButtonHeight;
end;

function TcxPCTabsPainter.GetButtonWidth(Button: TcxPCNavigatorButton): Integer;
{$IFDEF VCL}
var
  ASize: TSize;
  ATheme: TTheme;
{$ENDIF}
begin
{$IFDEF VCL}
  if IsNativePainting then
  begin
    Result := StandardNativePainterButtonWidth;
    if Button = nbGoDialog then
    begin
      ATheme := OpenTheme(totSpin);
      if GetThemePartSize(ATheme, ParentInfo.Canvas.Handle, SPNP_DOWN, DNS_NORMAL,
          nil, TS_TRUE, @ASize) = S_OK then
        Result := ASize.cx;
    end;
  end
  else
{$ENDIF}
    Result := inherited GetButtonWidth(Button);
end;

function TcxPCTabsPainter.GetClientRect: TRect;
{$IFDEF VCL}
var
  ACorrection: TcxPCRectCorrection;
{$ENDIF}
begin
  Result := inherited GetClientRect;
{$IFDEF VCL}
  if IsNativePainting then
  begin
    InflateRect(Result, StandardPainterTabControlFrameBorderWidth,
      StandardPainterTabControlFrameBorderWidth);
    ACorrection := GetNativeFrameSizeCorrection(ParentControl);
    CorrectRect(Result, ACorrection);
  end;
{$ENDIF}
end;

function TcxPCTabsPainter.GetDisplayRect: TRect;
var
  IsY: Boolean;
  Border: Integer;
begin
  Result := GetControlRect(ParentControl);
  InflateRect(Result, -StandardPainterTabControlFrameBorderWidth,
    -StandardPainterTabControlFrameBorderWidth);
  with ParentInfo, Result do
    if not HideTabs then
    begin
      IsY := TabPosition in [tpTop, tpBottom];

      if TopOrLeftPartRowCount <> RowCount then
      begin
        Border := PointGetter(ExtendedBottomOrRightTabsRect.TopLeft, IsY);
        PointSetter(Result.BottomRight, IsY, Border);
        case TabPosition of
          tpTop:
            Dec(Bottom, 2);
          tpBottom:
            Dec(Bottom, 1);
          tpLeft:
            Dec(Right, 2);
          tpRight:
            Dec(Right, 1);
        end;
      end;

      if TopOrLeftPartRowCount <> 0 then
      begin
        Border := PointGetter(ExtendedTopOrLeftTabsRect.BottomRight, IsY);
        PointSetter(Result.TopLeft, IsY, Border);
        case TabPosition of
          tpTop:
            Inc(Top, 1);
          tpBottom:
            Inc(Top, 2);
          tpLeft:
            Inc(Left, 1);
          tpRight:
            Inc(Left, 2);
        end;
      end;
    end;
  ValidateRect(Result);
end;

function TcxPCTabsPainter.GetDrawTextOffset(TabVisibleIndex: Integer): TRect;
begin
  Result := inherited GetDrawTextOffset(TabVisibleIndex);
  with ParentInfo do
    if VisibleTabs[TabVisibleIndex].IsMainTab and (GetTabRotatedImageSize.cx = 0) then
      Inc(Result.Left, 2);
end;

{ TcxPCTabsPainter }

class function TcxPCTabsPainter.GetStandardStyle: TcxPCStandardStyle;
begin
  Result := tsTabs;
end;

class function TcxPCTabsPainter.GetStyleID: TcxPCStyleID;
begin
  Result := cxPCTabsStyle;
end;

class function TcxPCTabsPainter.GetStyleName: TCaption;
begin
  Result := 'Tabs';
end;

class function TcxPCTabsPainter.HasLookAndFeel(ALookAndFeel: TcxLookAndFeel): Boolean;
begin
  Result := ALookAndFeel.Kind = lfStandard;
end;

class function TcxPCTabsPainter.IsDefault(ALookAndFeel: TcxLookAndFeel): Boolean;
begin
  Result := ALookAndFeel.NativeStyle;
end;

function TcxPCTabsPainter.GetTabBodyColor(
  TabVisibleIndex: Integer): TColor;
var
  Tab: TcxTab;
  IsTabEnabled: Boolean;
begin
  Tab := ParentInfo.VisibleTabs[TabVisibleIndex];
  IsTabEnabled := Tab.RealEnabled;
  if (not IsTabEnabled) or (not Tab.Highlighted) then
    Result := cxPCTabBodyColor
  else
    Result := HighlightedTabBodyColor;
end;

procedure TcxPCTabsPainter.GetTabClipRect(TabVisibleIndex: Integer;
  var ClipR: TRect; var IntersectClipRectWithCurrentClipRegion: Boolean);
var
  Tab: TcxTab;
  MainTab: Boolean;
begin
  Tab := ParentInfo.VisibleTabs[TabVisibleIndex];
  MainTab := Tab.IsMainTab;

  ClipR := Tab.VisibleRect;
  if MainTab(* and not IsNativePainting*) then
    with ClipR do
      case Tab.PaintingPosition of
        tppTop:
          Inc(Bottom);
        tppBottom:
          Dec(Top);
        tppLeft:
          Inc(Right);
        tppRight:
          Dec(Left);
      end;

  IntersectClipRectWithCurrentClipRegion := not MainTab;
end;

{$IFDEF VCL}
procedure TcxPCTabsPainter.GetTabNativePartAndState(ATabVisibleIndex: Integer;
  var PartId, StateId: Integer);
type
  TcxTabPositionWithinRow = (tprLeftMost, tprMiddle, tprRightMost);
  TcxTabState = (tsDisabled, tsHot, tsNormal, tsSelected);
const
  ATabNativePartA: array[Boolean, TcxTabPositionWithinRow] of Integer = (
    (TABP_TABITEMLEFTEDGE, TABP_TABITEM, TABP_TABITEMRIGHTEDGE),
    (TABP_TOPTABITEMLEFTEDGE, TABP_TOPTABITEM, TABP_TOPTABITEMRIGHTEDGE)
  );
  ATabNativeStateA: array[Boolean, TcxTabPositionWithinRow, TcxTabState] of Integer = (
    (
      (TILES_DISABLED, TILES_HOT, TILES_NORMAL, TILES_SELECTED),
      (TIS_DISABLED, TIS_HOT, TIS_NORMAL, TIS_SELECTED),
      (TIRES_DISABLED, TIRES_HOT, TIRES_NORMAL, TIRES_SELECTED)
    ),
    (
      (TTILES_DISABLED, TTILES_HOT, TTILES_NORMAL, TTILES_SELECTED),
      (TTIS_DISABLED, TTIS_HOT, TTIS_NORMAL, TTIS_SELECTED),
      (TTIRES_DISABLED, TTIRES_HOT, TTIRES_NORMAL, TTIRES_SELECTED)
    )
  );
var
  ALineIndexBoundsA: TcxPCLineIndexBoundsArray;
  ATab: TcxTab;
  ATabPositionWithinRow: TcxTabPositionWithinRow;
  ATabState: TcxTabState;
begin
  ATab := ParentInfo.VisibleTabs[ATabVisibleIndex];
  InitializeLineBoundsArray(ParentControl, ALineIndexBoundsA);

  if ParentInfo.MultiLine and not TcxCustomTabControlAccess(ParentControl).RaggedRight then
  begin
    if ALineIndexBoundsA[ATab.VisibleRow].Left = ATab.VisibleIndex then
      ATabPositionWithinRow := tprLeftMost
    else
      if (ALineIndexBoundsA[ATab.VisibleRow].Right = ATab.VisibleIndex) then
        ATabPositionWithinRow := tprRightMost
      else
        ATabPositionWithinRow := tprMiddle;
  end
  else
    if ALineIndexBoundsA[ATab.VisibleRow].Left = ATab.VisibleIndex then
      ATabPositionWithinRow := tprLeftMost
    else
      if ATab.VisibleIndex = TcxCustomTabControlAccess(ParentControl).Tabs.VisibleTabsCount - 1 then
        ATabPositionWithinRow := tprRightMost
      else
        ATabPositionWithinRow := tprMiddle;

//  if (Length(FButtonsQueue) = 0) and (ALineIndexBoundsA[ATab.VisibleRow].Right = ATabVisibleIndex) then
(*  if ATab.FullRect.Right = ParentInfo.Width then
    PartId := TABP_TABITEMRIGHTEDGE
  else
    PartId := TABP_TABITEM;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -