gdipclasses.pas

Workflow Studio是一款专为商业进程管理（BPM）设计的Delphi VCL框架。通过Workflow Studio你可以轻易地将工作流与BPM功能添加到你的应用程序里。这样能使你或你的最

end;

function TGPCanvas.GetHandle: HDC;
begin
  if (FInternalGraphics <> nil) and (FInternalGraphics.GetHDC <> 0) then
    result := FInternalGraphics.GetHDC
  else
    result := 0;
end;

procedure TGPCanvas.SetHandle(const Value: HDC);
begin
  if Handle <> Value then
  begin
    DestroyGraphics;
    if Value <> 0 then
      FInternalGraphics := TGPGraphics.Create(Value);
  end;
end;

procedure TGPCanvas.RequiredState(ReqState: TCanvasState);
var
  NeededState: TCanvasState;
begin
  NeededState := ReqState - State;
  if NeededState <> [] then
  begin
    {if csHandleValid in NeededState then
    begin
      CreateHandle;
      if FHandle = 0 then
        raise EInvalidOperation.CreateRes(@SNoCanvasHandle);
    end;}
    //if csFontValid in NeededState then CreateFont;
    //if csPenValid in NeededState then CreatePen;
    //if csBrushValid in NeededState then CreateBrush;
    State := State + NeededState;
  end;
end;

procedure TGPCanvas.Polygon(const Points: TPointFDynArray);
var
  c: integer;
  APts: TPointFDynArray;
begin
  Changing;
  RequiredState([csHandleValid, csPenValid, csBrushValid]);

  {Optimization}
  if not MustTranslateRects then
  begin
    GPGraphics.FillPolygon(Brush.GPBrush, PGPPointF(Points), Length(Points));
    GPGraphics.DrawPolygon(Pen.GPPen, PGPPointF(Points), Length(Points));
  end else
  begin
    SetLength(APts, Length(Points));
    for c := Low(Points) to High(Points) do
      APts[c] := PP(Points[c]);
    GPGraphics.FillPolygon(Brush.GPBrush, PGPPointF(APts), Length(APts));
    GPGraphics.DrawPolygon(Pen.GPPen, PGPPointF(APts), Length(APts));
  end;
  Changed;
end;

{procedure TGPCanvas.Polygon(const Points: TPointArray);
begin
  Polygon(TPointDynArray(Points));
end;}

procedure TGPCanvas.AddRoundRectPath(APath: TGPGraphicsPath; X1, Y1, X2, Y2, X3, Y3: single);
begin
  APath.StartFigure;
  APath.AddArc(x2 - x3, y1, x3, y3, 270, 90);
  APath.AddArc(x2 - x3, y2 - y3, x3, y3, 0, 90);
  APath.AddArc(x1, y2 - y3, x3, y3, 90, 90);
  APath.AddArc(x1, y1, x3, y3, 180, 90);
  APath.CloseFigure;
end;

procedure TGPCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: single);
var
  path: TGPGraphicsPath;
begin
  Changing;
  RequiredState([csHandleValid, csBrushValid, csPenValid]);
  X1 := PX(X1); Y1 := PY(Y1); X2 := PX(X2); Y2 := PY(Y2); X3 := SX(X3); Y3 := SY(Y3);

  path := TGPGraphicsPath.Create;
  try
    AddRoundRectPath(path, x1, y1, x2, y2, x3, y3);
    //path.CloseFigure;
    GPGraphics.FillPath(Brush.GPBrush, path);
    GPGraphics.DrawPath(Pen.GPPen, path);
  finally
    path.Free;
  end;
  Changed;
end;

procedure TGPCanvas.Changed;
begin
end;

procedure TGPCanvas.Changing;
begin
end;

procedure TGPCanvas.SetPen(const Value: TDgrPen);
begin
  FPen.Assign(Value);
end;

procedure TGPCanvas.SetBrush(const Value: TDgrBrush);
begin
  FBrush.Assign(Value);
end;

procedure TGPCanvas.Ellipse(X1, Y1, X2, Y2: single);
begin
  Changing;
  RequiredState([csHandleValid, csPenValid, csBrushValid]);
  X1 := PX(X1); Y1 := PY(Y1); X2 := PX(X2); Y2 := PY(Y2);
  GPGraphics.FillEllipse(Brush.GPBrush, x1, y1, x2 - x1, y2 - y1);
  GPGraphics.DrawEllipse(Pen.GPPen, x1, y1, x2 - x1, y2 - y1);
  Changed;
end;


procedure TGPCanvas.Rectangle(X1, Y1, X2, Y2: single);
begin
  Changing;
  RequiredState([csHandleValid, csPenValid, csBrushValid]);
  X1 := PX(X1); Y1 := PY(Y1); X2 := PX(X2); Y2 := PY(Y2);
  GPGraphics.FillRectangle(Brush.GPBrush, x1, y1, x2 - x1, y2 - y1);
  GPGraphics.DrawRectangle(Pen.GPPen, x1, y1, x2 - x1, y2 - y1);
  Changed;
end;

procedure TGPCanvas.SetDestRect(const Value: TRectX);
begin
  FDestRect := Value;
  UpdateFactors;
end;

procedure TGPCanvas.SetSourceRect(const Value: TRectX);
begin
  FSourceRect := Value;
  UpdateFactors;
end;

function TGPCanvas.PX(X: single): single;
begin
  if MustTranslateRects then
    result := (X - FSourceRect.Left) * FScaleX + FDestRect.Left
  else
    result := X;
end;

function TGPCanvas.PY(Y: single): single;
begin
  if MustTranslateRects then
    result := (Y - FSourceRect.Top) * FScaleY + FDestRect.Top
  else
    result := Y;
end;

function TGPCanvas.SX(X: single): single;
begin
  if MustTranslateRects then
    result := X * FScaleX
  else
    result := X;
end;

function TGPCanvas.SY(Y: single): single;
begin
  if MustTranslateRects then
    result := Y * FScaleY
  else
    result := Y;
end;
                          
function TGPCanvas.PP(R: TRectX): TRectX;
begin
  result.Left := PX(R.Left);
  result.Top := PY(R.Top);
  result.Right := PX(R.Right);
  result.Bottom := PY(R.Bottom);
end;

function TGPCanvas.PP(P: TGPPointF): TGPPointF;
begin
  result.X := PX(P.X);
  result.Y := PY(P.Y);
end;

procedure TGPCanvas.UpdateFactors;
begin
  FValidRects :=
    (FSourceRect.Right > FSourceRect.Left) and (FSourceRect.Bottom > FSourceRect.Top)
    and
    (FDestRect.Right > FDestRect.Left) and (FDestRect.Bottom > FDestRect.Top);
  if FValidRects then
  begin
    FScaleX := (FDestRect.Right - FDestRect.Left) / (FSourceRect.Right - FSourceRect.Left);
    FScaleY := (FDestRect.Bottom - FDestRect.Top) / (FSourceRect.Bottom - FSourceRect.Top);

    with FTransMatrix do
    begin
      Reset;
      Translate(-(FSourceRect.Right + FSourceRect.Left) / 2, -(FSourceRect.Top + FSourceRect.Bottom) / 2, MatrixOrderAppend);
      Scale(FScaleX, FScaleY, MatrixOrderAppend);
      Translate((FDestRect.Right + FDestRect.Left) / 2, (FDestRect.Top + FDestRect.Bottom) / 2, MatrixOrderAppend);
    end;
  end;
  FBrush.UpdateBrushPosition(FDestRect, FAngle, FRotCenter);
end;

(*procedure TGPCanvas.SetTranslateRects(const Value: boolean);
begin
  FTranslateRects := Value;
  //UpdateFactors; don't need it.
end;*)

function TGPCanvas.MustTranslateRects: boolean;
begin
  result := FValidRects and FTranslateRects;
end;

procedure TGPCanvas.Path(APath: TGPGraphicsPath);
begin
  Changing;
  RequiredState([csHandleValid, csPenValid, csBrushValid]);
  if MustTranslateRects then
    APath.Transform(FTransMatrix);
  GPGraphics.FillPath(Brush.GPBrush, APath);
  GPGraphics.DrawPath(Pen.GPPen, APath);
  Changed;
end;

procedure TGPCanvas.DrawPath(APath: TGPGraphicsPath);
begin
  Changing;
  RequiredState([csHandleValid, csPenValid, csBrushValid]);
  if MustTranslateRects then
    APath.Transform(FTransMatrix);
  GPGraphics.DrawPath(Pen.GPPen, APath);
  Changed;
end;

procedure TGPCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic; ATransparency: integer = 0);
begin
  StretchDraw(RectX(Rect), Graphic, ATransparency);
end;

procedure TGPCanvas.StretchDraw(const Rect: TRectX; Graphic: TGraphic;
  ATransparency: integer = 0);
var
  AGraphic: TDgrGraphic;
begin
  if Graphic is TDgrGraphic then
    StretchDraw(Rect, TDgrGraphic(Graphic).GPImage, ATransparency, Graphic.Transparent)
  else
  begin
    {this is not optimized, since for each stretch draw, a new graphic is assigned in order
     to get the gpimage handle. But for diagram, this code should will never be called, because
     the diagram blocks have some internal TDgrGraphic classes for optimization purposes} 
    AGraphic := TDgrGraphic.Create;
    try
      AGraphic.Assign(Graphic);
      StretchDraw(Rect, AGraphic.GPImage, ATransparency, Graphic.Transparent);
    finally
      AGraphic.Free;
    end;
  end;
end;

procedure TGPCanvas.StretchDraw(const Rect: TRectX; AGPImage: TGPImage; ATransparency: integer = 0;
  ABitmapTransparent: boolean = false);
var
  imgatt: TGPImageAttributes;
  imgWidth, imgHeight: integer;
  ColorMap: TColorMap;
const
  // Initialize the color matrix.
  // Notice the value 0.8 in row 4, column 4.
  ColorMatrix: TColorMatrix =
   ((1.0, 0.0, 0.0, 0.0, 0.0),
    (0.0, 1.0, 0.0, 0.0, 0.0),
    (0.0, 0.0, 1.0, 0.0, 0.0),
    (0.0, 0.0, 0.0, 0.5, 0.0),
    (0.0, 0.0, 0.0, 0.0, 1.0));
begin
  if AGPImage <> nil then
  begin
    Changing;
    RequiredState([csHandleValid, csFontValid, csPenValid, csBrushValid]);

    {create image attributes to be used with image}
    imgAtt := TGPImageAttributes.Create;
    try
      imgWidth := AGPImage.GetWidth;
      imgHeight := AGPImage.GetHeight;

      {set transparency}
      ColorMatrix[3, 3] := (100 - ATransparency) / 100;
      imgAtt.SetColorMatrix(colorMatrix, ColorMatrixFlagsDefault, ColorAdjustTypeBitmap);

      {set specific bitmap transparency}
      if ABitmapTransparent and (AGPImage.GetType = ImageTypeBitmap)  then
      begin
        TGPBitmap(AGPImage).GetPixel(0, imgHeight - 1, ColorMap.oldColor);
        ColorMap.NewColor := 0;
        imgAtt.SetRemapTable(1, @ColorMap, ColorAdjustTypeBitmap);
      end;

      GPGraphics.DrawImage(AGPImage,
        RectGP(PP(Rect)),
        0, 0, imgWidth, imgHeight,
        UnitPixel,
        imgAtt);
    finally
      imgAtt.Free;
    end;

    Changed;
  end;
end;

procedure TGPCanvas.SetGraphics(AGraphics: TGPGraphics);
begin
  FTempGraphics := AGraphics;
end;

function TGPCanvas.GetGraphics: TGPGraphics;
begin
  if FTempGraphics <> nil then
    result := FTempGraphics
  else
    result := FInternalGraphics;
end;

procedure TGPCanvas.SetRotCenter(const Value: TPointX);
begin
  FRotCenter := Value;
  UpdateFactors;
end;

procedure TGPCanvas.SetAngle(const Value: single);
begin
  FAngle := Value;
  UpdateFactors;
end;

procedure TGPCanvas.DrawLine(X1, Y1, X2, Y2: single);
begin
  Changing;
  RequiredState([csHandleValid, csPenValid]);
  X1 := PX(X1); Y1 := PY(Y1); X2 := PX(X2); Y2 := PY(Y2);
  GPGraphics.DrawLine(Pen.GPPen, X1, Y1, X2, Y2);
  Changed;
end;

{ TDgrPen }

procedure TDgrPen.Assign(Source: TPersistent);
begin
  if Source is TDgrPen then
  begin
    FColor := TDgrPen(Source).Color;
    FWidth := TDgrPen(Source).Width;
    FTransparency := TDgrPen(Source).Transparency;
    FDashStyle := TDgrPen(Source).FDashStyle;
    Change;
  end else
  if Source is TPen then
  begin
    FColor := TPen(Source).Color;
    FWidth := TPen(Source).Width;
    Case TPen(Source).Style of
      psSolid: FDashStyle := DashStyleSolid;
      psDash: FDashStyle := DashStyleDash;
      psDot: FDashStyle := DashStyleDot;
      psDashDot: FDashStyle := DashStyleDashDot;
      psDashDotDot: FDashStyle := DashStyleDashDotDot;
      psClear: FTransparency := 100;
    else
      FDashStyle := DashStyleSolid;
    end;
    Change;
  end else
    inherited Assign(Source);
end;

procedure TDgrPen.Change;
begin
  DestroyGPPen;
  inherited;
end;

constructor TDgrPen.Create;
begin
  FColor := clBlack;
  FWidth := 0.24;
  FTransparency := 0;
  FDashStyle := DashStyleSolid;
end;

procedure TDgrPen.CreateGPPen;
begin
  FGPPen := TGPPen.Create(ColorToARGB(FColor, GetAlpha), FWidth);
  FGPPen.SetDashStyle(FDashStyle);
end;

destructor TDgrPen.Destroy;
begin
  DestroyGPPen;
  inherited;
end;

procedure TDgrPen.DestroyGPPen;
begin
  if FGPPen <> nil then
  begin
    FGPPen.Free;