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

📄 gdipclasses.pas

📁 Workflow Studio是一款专为商业进程管理(BPM)设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    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 + -