📄 gdipclasses.pas
字号:
FGPPen := nil;
end;
end;
function TDgrPen.GPPen: TGPPen;
begin
if FGPPen = nil then
CreateGPPen;
result := FGPPen;
end;
procedure TDgrPen.SetTransparency(const Value: integer);
begin
if FTransparency <> Value then
begin
FTransparency := Value;
Change;
end;
end;
procedure TDgrPen.SetColor(const Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Change;
end;
end;
procedure TDgrPen.SetWidth(const Value: single);
begin
if FWidth <> Value then
begin
FWidth := Value;
Change;
end;
end;
function TDgrPen.GetAlpha: byte;
begin
result := round((100 - Transparency) * 2.55);
end;
procedure TDgrPen.SetDashStyle(const Value: TDashStyle);
begin
if FDashStyle <> Value then
begin
FDashStyle := Value;
Change;
end;
end;
{ TDgrBrush }
procedure TDgrBrush.Assign(Source: TPersistent);
begin
if Source is TDgrBrush then
begin
FColor := TDgrBrush(Source).Color;
FTransparency := TDgrBrush(Source).Transparency;
FHatchStyle := TDgrBrush(Source).HatchStyle;
FBrushMode := TDgrBrush(Source).BrushMode;
FColor2 := TDgrBrush(Source).Color2;
FGradientMode := TDgrBrush(Source).GradientMode;
FTexture.Assign(TDgrBrush(Source).FTexture);
Change;
end else
if Source is TBrush then
begin
FColor := TBrush(Source).Color;
FTransp2 := 100;
FBrushMode := bmHatch;
Case TBrush(Source).Style of
bsSolid: FBrushMode := bmSolid;
bsClear: FBrushMode := bmClear;
bsHorizontal: FHatchStyle := HatchStyleHorizontal;
bsVertical: FHatchStyle := HatchStyleVertical;
bsFDiagonal: FHatchStyle := HatchStyleForwardDiagonal;
bsBDiagonal: FHatchStyle := HatchStyleBackwardDiagonal;
bsCross: FHatchStyle := HatchStyleCross;
bsDiagCross: FHatchStyle := HatchStyleDiagonalCross;
end;
Change;
end else
inherited Assign(Source);
end;
procedure TDgrBrush.Change;
begin
DestroyGPBrush;
inherited;
end;
constructor TDgrBrush.Create;
begin
FBrushMode := bmSolid;
FColor := clWhite;
FTransparency := 0;
FHatchStyle := HatchStyleHorizontal;
FTexture := TDgrPicture.Create;
FTexture.OnChange := ItemChange;
FRotMatrix := TGPMatrix.Create;
end;
procedure TDgrBrush.CreateGPBrush;
var
path: TGPGraphicsPath;
colorcount: integer;
AMatrix: TGPMatrix;
const
BlendFactors: array[0..2] of single = (0.0, 1.0, 0.0);
BlendPositions: array[0..2] of single = (0.0, 0.5, 1.0);
Colors: array[0..0] of Cardinal = (0);
begin
Case FBrushMode of
bmClear:
FGPBrush := TGPSolidBrush.Create(0);
bmHatch:
FGPBrush := TGPHatchBrush.Create(FHatchStyle, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2));
bmTexture:
begin
FGPBrush := TGPTextureBrush.Create(FTexture.GPImage);
with TGPTextureBrush(FGPBrush) do
begin
SetTransform(FRotMatrix);
TranslateTransform(FGradientRect.X, FGradientRect.Y);
end;
end;
bmGradient:
begin
Case FGradientMode of
gmTopBottom:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeVertical);
gmBottomTop:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeVertical);
gmLeftRight:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeHorizontal);
gmRightLeft:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeHorizontal);
gmLeftTop:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeForwardDiagonal);
gmRightTop:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeBackwardDiagonal);
gmLeftBottom:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeBackwardDiagonal);
gmRightBottom:
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeForwardDiagonal);
gmInOut:
begin
path := TGPGraphicsPath.Create;
try
path.AddRectangle(FGradientRect);
FGPBrush := TGPPathGradientBrush.Create(path);
TGPPathGradientBrush(FGPBrush).SetCenterColor(ColorToARGB(FColor, GetAlpha1));
Colors[0] := ColorToARGB(FColor2, GetAlpha2);
colorcount := 1;
TGPPathGradientBrush(FGPBrush).SetSurroundColors(@Colors[0], colorcount);
finally
path.Free;
end;
end;
gmOutIn:
begin
path := TGPGraphicsPath.Create;
try
path.AddRectangle(FGradientRect);
FGPBrush := TGPPathGradientBrush.Create(path);
TGPPathGradientBrush(FGPBrush).SetCenterColor(ColorToARGB(FColor2, GetAlpha2));
Colors[0] := ColorToARGB(FColor, GetAlpha1);
colorcount := 1;
TGPPathGradientBrush(FGPBrush).SetSurroundColors(@Colors[0], colorcount);
finally
path.Free;
end;
end;
gmHorzInOut:
begin
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeVertical);
TGPLinearGradientBrush(FGPBrush).SetBlend(@BlendFactors[0], @BlendPositions[0], 3);
end;
gmHorzOutIn:
begin
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeVertical);
TGPLinearGradientBrush(FGPBrush).SetBlend(@BlendFactors[0], @BlendPositions[0], 3);
end;
gmVertInOut:
begin
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor2, GetAlpha2), ColorToARGB(FColor, GetAlpha1), LinearGradientModeHorizontal);
TGPLinearGradientBrush(FGPBrush).SetBlend(@BlendFactors[0], @BlendPositions[0], 3);
end;
gmVertOutIn:
begin
FGPBrush := TGPLinearGradientBrush.Create(
FGradientRect, ColorToARGB(FColor, GetAlpha1), ColorToARGB(FColor2, GetAlpha2), LinearGradientModeHorizontal);
TGPLinearGradientBrush(FGPBrush).SetBlend(@BlendFactors[0], @BlendPositions[0], 3);
end;
end;
AMatrix := TGPMatrix.Create;
try
if FGPBrush is TGPLinearGradientBrush then
begin
TGPLinearGradientBrush(FGPBrush).GetTransform(AMatrix);
AMatrix.Multiply(FRotMatrix, MatrixOrderAppend);
TGPLinearGradientBrush(FGPBrush).SetTransform(AMatrix);
end
else
if FGPBrush is TGPPathGradientBrush then
begin
TGPPathGradientBrush(FGPBrush).GetTransform(AMatrix);
AMatrix.Multiply(FRotMatrix, MatrixOrderAppend);
TGPPathGradientBrush(FGPBrush).SetTransform(AMatrix);
end;
finally
AMatrix.Free;
end;
end;
else
//bmSolid
FGPBrush := TGPSolidBrush.Create(ColorToARGB(FColor, GetAlpha1));
end;
end;
destructor TDgrBrush.Destroy;
begin
DestroyGPBrush;
FTexture.Free;
FRotMatrix.Free;
inherited;
end;
procedure TDgrBrush.DestroyGPBrush;
begin
if FGPBrush <> nil then
begin
FGPBrush.Free;
FGPBrush := nil;
end;
end;
function TDgrBrush.GPBrush: TGPBrush;
begin
if FGPBrush = nil then
CreateGPBrush;
result := FGPBrush;
end;
procedure TDgrBrush.SetTransparency(const Value: integer);
begin
if FTransparency <> Value then
begin
FTransparency := Value;
Change;
end;
FTransp1 := -1;
FTransp2 := -1;
end;
procedure TDgrBrush.SetColor(const Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Change;
end;
FTransp1 := -1;
end;
procedure TDgrBrush.SetHatchStyle(const Value: THatchStyle);
begin
if FHatchStyle <> Value then
begin
FHatchStyle := Value;
Change;
end;
end;
function TDgrBrush.GetAlpha1: byte;
begin
if FTransp1 = -1 then
result := round((100 - Transparency) * 2.55)
else
result := round((100 - FTransp1) * 2.55)
end;
function TDgrBrush.GetAlpha2: byte;
begin
if FTransp2 = -1 then
result := round((100 - Transparency) * 2.55)
else
result := round((100 - FTransp2) * 2.55)
end;
procedure TDgrBrush.SetBrushMode(const Value: TDgrBrushMode);
begin
if FBrushMode <> Value then
begin
FBrushMode := Value;
Change;
end;
end;
procedure TDgrBrush.SetColor2(const Value: TColor);
begin
if FColor2 <> Value then
begin
FColor2 := Value;
Change;
end;
FTransp2 := -1;
end;
procedure TDgrBrush.UpdateBrushPosition(ARect: TRectX; AAngle: single; ARotCenter: TPointX);
begin
FGradientRect := RectGP(ARect);
FRotMatrix.Reset;
if AAngle <> 0 then
FRotMatrix.RotateAt(AAngle, MakePoint(ARotCenter.X, ARotCenter.Y), MatrixOrderAppend);
Change;
end;
procedure TDgrBrush.SetGradientMode(const Value: TDgrGradientMode);
begin
if FGradientMode <> Value then
begin
FGradientMode := Value;
Change;
end;
end;
procedure TDgrBrush.SetTexture(const Value: TDgrPicture);
begin
FTexture.Assign(Value);
end;
procedure TDgrBrush.ItemChange(Sender: TObject);
begin
Change;
end;
{ TDgrGraphicsObject }
procedure TDgrGraphicsObject.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
{ TGPBlockDrawer }
constructor TGPBlockDrawer.Create;
begin
FGPCanvas := TGPCanvas.Create;
//FGPCanvas.TranslateRects := true;
//FMatrix := TGPMatrix.Create;
end;
destructor TGPBlockDrawer.Destroy;
begin
//FMatrix.Free;
FGPCanvas.Free;
inherited;
end;
function TGPBlockDrawer.GetDestRect: TRectX;
begin
result := FGPCanvas.DestRect;
end;
function TGPBlockDrawer.GetSourceRect: TRectX;
begin
result := FGPCanvas.SourceRect;
end;
procedure TGPBlockDrawer.RotatePath(APath: TGPGraphicsPath);
var
AMatrix: TGPMatrix;
{Rotate at the rotation point}
begin
if Angle <> 0 then
begin
AMatrix := TGPMatrix.Create;
try
AMatrix.RotateAt(Angle, MakePoint(RotationCenter.X, RotationCenter.Y), MatrixOrderAppend);
APath.Transform(AMatrix);
finally
AMatrix.Free;
end;
end;
end;
procedure TGPBlockDrawer.SetDestRect(const Value: TRectX);
begin
FGPCanvas.DestRect := Value;
end;
procedure TGPBlockDrawer.SetDeviceContext(AHandle: HDC);
begin
FGPCanvas.Handle := AHandle;
end;
procedure TGPBlockDrawer.SetGraphics(AGraphics: TGPGraphics);
begin
FGPCanvas.SetGraphics(AGraphics);
end;
procedure TGPBlockDrawer.SetSourceRect(const Value: TRectX);
begin
FGPCanvas.SourceRect := Value;
end;
procedure TGPBlockDrawer.TranslateRectsPath(APath: TGPGraphicsPath);
begin
APath.Transform(GPCanvas.FTransMatrix);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -