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 + -
显示快捷键?