cxpcpainters.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,694 行 · 第 1/5 页

PAS
1,694
字号
  cxPCTabBodyColor = clBtnFace;
  cxPCLightEdgeColor = {clNavy}cl3DLight;
  cxPCLightestEdgeColor = clBtnHighlight;

  cxPCLightBrushColorDelta = 20;

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

  UltraFlatPainterButtonWidthA: array[TcxPCNavigatorButton] of Integer =
    (15, 15, 11, 14);
  UltraFlatPainterButtonHeight = 15;

  FlatPainterButtonBorderWidth = 1;

  SlantedPainterButtonWidthA: array[TcxPCNavigatorButton] of Integer =
    (17, 17, 13, 16);
  SlantedPainterButtonHeight = 17;

  CutCornerSize = 6;
  SlantedPainterTabStateMarkWidth = 3;
  OneNotePainterTabFrameWidth = 2;

  CloseButtonCrossSize = 9;

type
  TWinControlAccess = class(TWinControl);

  { TcxPaletteChangedNotifier }

  TcxPaletteChangedNotifier = class(TcxSystemPaletteChangedNotifier)
  protected
    procedure DoChanged; override;
  end;

var
  FPaletteChangedNotifier: TcxPaletteChangedNotifier;
  OneNoteMainTabBorderColor: COLORREF;
  OneNoteTabBorderColor: COLORREF;
  OneNoteMainTabInnerBorderColor: COLORREF;
  OneNoteTabHotBorderColor: COLORREF;
  OneNoteTabInnerBorderColor1: COLORREF;
  OneNoteTabInnerBorderColor2: COLORREF;

procedure AddPoints(var APoints: TPoints; const ANewPoints: array of TPoint;
  var ALinePositions: TLinePositions; const ANewLinePositions: array of TLinePosition);
var
  I, AArrayLength: Integer;
begin
  AArrayLength := Length(APoints);
  SetLength(APoints, AArrayLength + Length(ANewPoints));
  for I := 0 to Length(ANewPoints) - 1 do
    APoints[AArrayLength + I] := ANewPoints[I];

  AArrayLength := Length(ALinePositions);
  SetLength(ALinePositions, AArrayLength + Length(ANewLinePositions));
  for I := 0 to Length(ANewLinePositions) - 1 do
    ALinePositions[AArrayLength + I] := ANewLinePositions[I];
end;
  
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;
  cxPCLightBrushColor := RGB(R, G, B);
end;

procedure DrawBorder(ACanvas: TcxCanvas; var ARect: TRect; ASides: array of TcxBorder; AColors: array of TColor; AExcludeBorder: Boolean = False);
var
  I: Integer;
  ARegion: TcxRegion;
  AInitialRect: TRect;
begin
  AInitialRect := ARect;
  for I := 0 to High(ASides) do
  begin
    ACanvas.Pen.Color := AColors[I];
    case ASides[I] of
      bLeft:
        begin
          ACanvas.Polyline([ARect.TopLeft, Point(ARect.Left, ARect.Bottom)]);
          Inc(ARect.Left);
        end;
      bTop:
        begin
          ACanvas.Polyline([ARect.TopLeft, Point(ARect.Right, ARect.Top)]);
          Inc(ARect.Top);
        end;
      bRight:
        begin
          ACanvas.Polyline([Point(ARect.Right - 1, ARect.Top), Point(ARect.Right - 1, ARect.Bottom)]);
          Dec(ARect.Right);
        end;
      bBottom:
        begin
          ACanvas.Polyline([Point(ARect.Left, ARect.Bottom - 1), Point(ARect.Right, ARect.Bottom - 1)]);
          Dec(ARect.Bottom);
        end;
    end;
  end;
  if AExcludeBorder then
  begin
    ARegion := TcxRegion.Create(AInitialRect);
    ARegion.Combine(TcxRegion.Create(ARect), roSubtract);
    ACanvas.SetClipRegion(ARegion, roSubtract);
  end;
end;

procedure ExchangeValues(var AValue1, AValue2);
var
  ATempValue: DWORD;
begin
  ATempValue := DWORD(AValue1);
  DWORD(AValue1) := DWORD(AValue2);
  DWORD(AValue2) := ATempValue;
end;

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

function GetFigureRegion(APoints: array of TPoint;
  const ALinePositions: array of TLinePosition; AForContent: Boolean): TcxRegion;

  function ThereIsLine(ALinePosition: TLinePosition): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to High(ALinePositions) do
      if ALinePositions[I] = ALinePosition then
      begin
        Result := True;
        Break;
      end;
  end;

var
  I: Integer;
  P1, P2: TPoint;
begin
  for I := 0 to High(APoints) - 1 do
  begin
    P1 := APoints[I];
    P2 := APoints[I + 1];
    if AForContent then
    begin
      case ALinePositions[I] of
        lpL:
          begin
            Inc(P1.X);
            Inc(P2.X);
            if ThereIsLine(lpLB) then
              Inc(P1.Y);
            if ThereIsLine(lpLT) then
              Dec(P2.Y);
          end;
        lpLT:
          begin
            if ThereIsLine(lpL) then
              Inc(P1.Y)
            else
              Inc(P1.X);
            if ThereIsLine(lpT) then
              Inc(P2.X)
            else
              Inc(P2.Y);
          end;
        lpLB:
          begin
            if ThereIsLine(lpB) then
              Inc(P1.X)
            else
              Dec(P1.Y);
            if ThereIsLine(lpL) then
              Dec(P2.Y)
            else
              Inc(P2.X);
          end;
        lpT:
          begin
            Inc(P1.Y);
            Inc(P2.Y);
            if ThereIsLine(lpLT) then
              Dec(P1.X);
            if ThereIsLine(lpRT) then
              Inc(P2.X);
          end;
      end;
    end
    else
      case ALinePositions[I] of
        lpRT:
          begin
            if ThereIsLine(lpT) then
              Inc(P1.X)
            else
              Dec(P1.Y);
            if ThereIsLine(lpR) then
              Dec(P2.Y)
            else
              Inc(P2.X);
          end;
        lpR:
          begin
            Inc(P1.X);
            Inc(P2.X);
            if ThereIsLine(lpRT) then
              Inc(P1.Y);
            if ThereIsLine(lpRB) then
              Dec(P2.Y);
          end;
        lpRB:
          begin
            if ThereIsLine(lpR) then
              Inc(P1.Y)
            else
              Inc(P1.X);
            if ThereIsLine(lpB) then
              Inc(P2.X)
            else
              Inc(P2.Y);
          end;
        lpB:
          begin
            Inc(P1.Y);
            Inc(P2.Y);
            if ThereIsLine(lpRB) then
              Dec(P1.X);
            if ThereIsLine(lpLB) then
              Inc(P2.X);
          end;
      end;
    APoints[I] := P1;
    APoints[I + 1] := P2;
  end;
  Result := TcxRegion.Create(CreatePolygonRgn(APoints, Length(APoints), WINDING));
end;

procedure GetRectSize(const R: TRect; AIsHorizontal: Boolean;
  out ARWidth, ARHeight: Integer);
begin
  if AIsHorizontal then
  begin
    ARWidth := R.Right - R.Left;
    ARHeight := R.Bottom - R.Top;
  end
  else
  begin
    ARWidth := R.Bottom - R.Top;
    ARHeight := R.Right - R.Left;
  end;
end;

function HSBToRGB(AHue, ASaturation, ABrightness: Extended): TColor;

  procedure GetRGB(out R, G, B: Integer);
  var
    AMinColorComponent, AMaxColorComponent: Extended;
  begin
    if ABrightness = 0 then
    begin
      R := 0;
      G := 0;
      B := 0;
      Exit;
    end;
    AMaxColorComponent := ABrightness * 255 / 100;
    AMinColorComponent := AMaxColorComponent * (100 - ASaturation) / 100;
    if AHue <= 60 then
    begin
      R := Trunc(AMaxColorComponent);
      G := Trunc(AMinColorComponent + (AMaxColorComponent - AMinColorComponent) * AHue / 60);
      B := Trunc(AMinColorComponent);
    end
    else if AHue <= 120 then
    begin
      R := Trunc(AMaxColorComponent + (AMaxColorComponent - AMinColorComponent) * (60 - AHue) / 60);
      G := Trunc(AMaxColorComponent);
      B := Trunc(AMinColorComponent);
    end
    else if AHue <= 180 then
    begin
      R := Trunc(AMinColorComponent);
      G := Trunc(AMaxColorComponent);
      B := Trunc(AMinColorComponent + (AMaxColorComponent - AMinColorComponent) * (AHue - 120) / 60);
    end
    else if AHue <= 240 then
    begin
      R := Trunc(AMinColorComponent);
      G := Trunc(AMaxColorComponent + (AMaxColorComponent - AMinColorComponent) * (180 - AHue) / 60);
      B := Trunc(AMaxColorComponent);
    end
    else if AHue <= 300 then
    begin
      R := Trunc(AMinColorComponent + (AMaxColorComponent - AMinColorComponent) * (AHue - 240) / 60);
      G := Trunc(AMinColorComponent);
      B := Trunc(AMaxColorComponent);
    end
    else
    begin
      R := Trunc(AMaxColorComponent);
      G := Trunc(AMinColorComponent);
      B := Trunc(AMaxColorComponent + (AMaxColorComponent - AMinColorComponent) * (300 - AHue) / 60);
    end
  end;

var
  R, G, B: Integer;
begin
  GetRGB(R, G, B);
  Result := RGB(R, G, B);
end;

procedure RGBToHSB(ARGBColor: TColor; out Hue, Saturation, Brightness: Extended);
var
  AMinColorComponent: Integer;
  R, G, B: Integer;

  procedure PreCalculate;
  begin
    ARGBColor := ColorToRGB(ARGBColor);
    R := GetRValue(ARGBColor);
    G := GetGValue(ARGBColor);

⌨️ 快捷键说明

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