gmcanvas.pas

GmPrintSuite 2.96.7] a

procedure TGmCanvas.Line(X, Y, X2, Y2: Extended; Measurement: TGmMeasurement);
var
  AObject: TGmLineObject;
begin
  AObject := TGmLineObject.Create(FResourceTable);
  AObject.Pen := FResourceTable.PenList.AddPen(AsGmPen);
  AObject.Coords[gmInches]  := ConvertGmRect(GmRect(X, Y, X2, Y2), Measurement, gmInches);
  FLastObject := AddObjectToPage(AObject);
end;

procedure TGmCanvas.LineTo(x, y: Extended; Measurement: TGmMeasurement);
var
  EndPos: TGmPoint;
begin
  EndPos := ConvertGmPoint(GmPoint(x, y), Measurement, gmInches);
  Line(FPenPos.X, FPenPos.Y, EndPos.X, EndPos.Y, gmInches);
  FPenPos := EndPos;
end;

procedure TGmCanvas.MoveTo(x, y: Extended; Measurement: TGmMeasurement);
var
  NewPos: TGmPoint;
begin
  NewPos := GmPoint(x, y);
  FPenPos := ConvertGmPoint(NewPos, Measurement, gmInches);
end;

{$IFDEF D4+}

procedure TGmCanvas.Line(x, y, x2, y2: Extended);
begin
  Line(x, y, x2, y2, FDefaultMeasurement);
end;

procedure TGmCanvas.LineTo(x, y: Extended);
begin
  LineTo(x, y, FDefaultMeasurement);
end;

procedure TGmCanvas.MoveTo(x, y: Extended);
begin
  MoveTo(x, y, FDefaultMeasurement);
end;
  
{$ENDIF}

procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended; Measurement: TGmMeasurement);
var
  AObject: TGmEllipseShape;
begin
  AObject := TGmEllipseShape.Create(FResourceTable);
  AObject.Brush := FResourceTable.BrushList.AddBrush(AsGmBrush);
  AObject.Pen   := FResourceTable.PenList.AddPen(AsGmPen);
  AObject.Coords[gmInches]  := ConvertGmRect(GmRect(X, Y, X2, Y2), Measurement, gmInches);
  FLastObject := AddObjectToPage(AObject);
end;

procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended; Measurement: TGmMeasurement);
var
  AObject: TGmRectangleShape;
begin
  AObject := TGmRectangleShape.Create(FResourceTable);
  AObject.Brush := FResourceTable.BrushList.AddBrush(AsGmBrush);
  AObject.Pen   := FResourceTable.PenList.AddPen(AsGmPen);
  AObject.Coords[gmInches]  := ConvertGmRect(GmRect(X, Y, X2, Y2), Measurement, gmInches);
  FLastObject := AddObjectToPage(AObject);
end;

procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended; Measurement: TGmMeasurement);
var
  AObject: TGmRoundRectShape;
begin
  AObject := TGmRoundRectShape.Create(FResourceTable);
  AObject.Brush := FResourceTable.BrushList.AddBrush(AsGmBrush);
  AObject.Pen   := FResourceTable.PenList.AddPen(AsGmPen);
  AObject.Coords[gmInches]  := ConvertGmRect(GmRect(X, Y, X2, Y2), Measurement, gmInches);
  AObject.X3[gmInches] := ConvertValue(x3, Measurement, gmInches);
  AObject.Y3[gmInches] := ConvertValue(y3, Measurement, gmInches);
  FLastObject := AddObjectToPage(AObject);
end;

{$IFDEF D4+}

procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended);
begin
  Ellipse(x, y, x2, y2, FDefaultMeasurement);
end;

procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended);
begin
  Rectangle(x, y, x2, y2, FDefaultMeasurement);
end;

procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended);
begin
  RoundRect(x, y, x2, y2, x3, y3, FDefaultMeasurement);
end;

{$ENDIF}

function TGmCanvas.AddObjectToPage(AObject: TGmBaseObject): TGmBaseObject;
begin
  Result := TGmPageList(FPageList).AddObject(AObject, FCoordsRelativeTo);
  if (AObject is TGmVisibleObject) then
    (AObject as TGmVisibleObject).AllowDrag := FAllowDrag;

end;

function TGmCanvas.AsGmBrush: TGmBrush;
begin
  Result := FGmBrush;
  FGmBrush.Assign(FBrush);
end;

function TGmCanvas.AsGmFont: TGmFont;
begin
  Result := FGmFont;
  FGmFont.Assign(FFont);
  FGmFont.Angle := FFontAngle;
end;

function TGmCanvas.AsGmPen: TGmPen;
begin
  Result := FGmPen;
  FGmPen.Assign(FPen);
end;

function TGmCanvas.GetCompareImages: Boolean;
begin
  Result := FResourceTable.GraphicList.GraphicCompare;
end;

function TGmCanvas.GetPenPos(Measurement: TGmMeasurement): TGmPoint;
begin
  Result := ConvertGmPoint(FPenPos, gmInches, Measurement);
end;

procedure TGmCanvas.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TGmCanvas.SetCompareImages(Value: Boolean);
begin
  FResourceTable.GraphicList.GraphicCompare := Value;
end;

procedure TGmCanvas.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TGmCanvas.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TGmCanvas.SetTextBoxPadding(Value: TGmValue);
begin
  FTextBoxPadding.Assign(Value);
end;

function TGmCanvas.TextBoxHeightExt(AWidth, Padding: Extended; AText: string; Measurement: TGmMeasurement): Extended;
var
  CalcRect: TRect;
  AsPixels: integer;
  PaddInch: Extended;
  Ppi: integer;
begin
  Ppi := CALC_PPI;
  CalcRect.Left   := 0;
  CalcRect.Top    := 0;
  CalcRect.Right  := Round(ConvertValue(AWidth - (2 * Padding), Measurement, GmInches) * Ppi) ;
  PaddInch := ConvertValue(Padding, Measurement, gmInches);
  GmFontMapper.WrapText := FWordWrap;
  AsPixels := Round(GmFontMapper.TextBoxHeight(FFont, CalcRect, AText) * Ppi);
  Result := ConvertValue((AsPixels / Ppi)+(2*PaddInch), gmInches, Measurement);
end;

procedure TGmCanvas.TextOutExt(X, Y, Angle: Extended; AClipRect: PGmRect; AText: string; Measurement: TGmMeasurement);
var
  AObject: TGmTextObject;
begin
  AObject := TGmTextObject.Create(FResourceTable);
  AObject.X[Measurement] := X;
  AObject.Y[Measurement] := Y;
  AObject.Caption := AText;
  if AClipRect <> nil then
    AObject.ClipRect[Measurement] := AClipRect^
  else
    AObject.ClipRect[gmInches] := GmRect(-1, -1, -1, -1);
  FFontAngle := Angle;
  try
    AObject.Font  := FResourceTable.FontList.AddFont(AsGmFont);
  finally
    FFontAngle := 0;
  end;
  AObject.Brush := FResourceTable.BrushList.AddBrush(AsGmBrush);
  AObject.Pen   := FResourceTable.PenList.AddPen(AsGmPen);
  FLastObject := AddObjectToPage(AObject);
end;

procedure TGmCanvas.FloatOut(x, y, Value: Extended; Format: string; Measurement: TGmMeasurement);
var
  AStrValue: string;
begin
  // draw a float value to the page with a specific format...
  AStrValue := FormatFloat(Format, Value);
  TextOutRight(x, y, AStrValue, Measurement);
end;

procedure TGmCanvas.RotateOut(X, Y, Angle: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextOutExt(X, Y, Angle, nil, AText, Measurement);
end;

procedure TGmCanvas.TextClipped(x, y: Extended; AText: string; AWidth: Extended; Alignment: TAlignment; Measurement: TGmMeasurement);
var
  tmpRect: TgmRect;
begin
  tmpRect.Top := y;
  tmpRect.Bottom := y + TextHeight(AText).AsGmValue[Measurement];
  if Alignment = taLeftJustify then
  begin
    tmpRect.Left := x;
    tmpRect.Right := x + AWidth;
  end
  else
  if Alignment = taRightJustify then
  begin
    tmpRect.Left := x - AWidth;
    tmpRect.Right := x;
    x := x - TextWidth(AText).AsGmValue[Measurement];
  end
  else
  begin
    x := x - (TextWidth(AText).AsGmValue[Measurement] / 2);
    tmpRect.Left := x + ((TextWidth(AText).AsGmValue[Measurement] - AWidth) / 2);
    tmpRect.Right := tmpRect.Left + AWidth;
  end;
  TextOutExt(x, y, 0, @tmpRect, AText, Measurement);
end;

procedure TGmCanvas.TextOut(X, Y: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextOutExt(X, Y, 0, nil, AText, Measurement);
end;

procedure TGmCanvas.TextOutCenter(x, y: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextOut(x-(TextWidth(AText).AsGmValue[Measurement] / 2), y, AText, Measurement);
end;

procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextOut(x-TextWidth(AText).AsGmValue[Measurement], y, AText, Measurement);
end;

procedure TGmCanvas.TextRect(ARect: TGmRect; x, y: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextOutExt(x, y, 0, @ARect, AText, Measurement);
end;

{$IFDEF D4+}

procedure TGmCanvas.FloatOut(x, y, Value: Extended; Format: string);
begin
  FloatOut(x, y, Value, Format, FDefaultMeasurement);
end;

procedure TGmCanvas.RotateOut(x, y, Angle: Extended; AText: string);
begin
  RotateOut(x, y, Angle, AText, FDefaultMeasurement);
end;

procedure TGmCanvas.TextOut(x, y: Extended; AText: string);
begin
  TextOut(x, y, AText, FDefaultMeasurement);
end;

procedure TGmCanvas.TextOutCenter(x, y: Extended; AText: string);
begin
  TextOutCenter(x, y, AText, FDefaultMeasurement);
end;

procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string);
begin
  TextOutRight(x, y, AText, FDefaultMeasurement);
end;

{$ENDIF}

procedure TGmCanvas.TextBox(x, y, x2, y2: Extended; AText: string; Measurement: TGmMeasurement);
begin
  TextBoxExt(x, y, x2, y2, FTextBoxPadding.AsGmValue[Measurement], AText,
    FDefaultAlignment, FDefaultVertAlignment, Measurement);
end;

procedure TGmCanvas.TextBoxExt(x, y, x2, y2, Padding: Extended; AText: string;
      Alignment: TAlignment; VertAlignment: TGmVertAlignment; Measurement: TGmMeasurement);
var
  ATextBox: TGmTextBoxObject;
  ATextHeight: Extended;
  PaddingInch: Extended;
begin
  // create a textbox object and set its values...
  ATextBox := TGmTextBoxObject.Create(FResourceTable);
  ATextBox.X[Measurement] := x;
  ATextBox.Y[Measurement] := y;
  ATextBox.X2[Measurement] := x2;

  PaddingInch := ConvertValue(Padding, Measurement, gmInches);

  if (Y2 = 0) or (VertAlignment <> gmTop) then
  begin
    ATextHeight := TextBoxHeightExt((ATextBox.X2[gmInches] - ATextBox.X[gmInches]),
                                    PaddingInch,
                                    AText,
                                    gmInches);
    if Y2 = 0 then
      ATextBox.Y2[gmInches] := ATextBox.Y[gmInches] + ATextHeight
    else
      ATextBox.Y2[Measurement] := y2;
  end
  else
  begin
    ATextBox.Y2[Measurement] := y2;
    ATextHeight := ATextBox.Y2[gmInches] - ATextBox.Y[gmInches];
  end;

  ATextBox.Padding := PaddingInch;
  ATextBox.TextHeight := ATextHeight;
  ATextBox.Alignment := Alignment;
  ATextBox.VertAlignment := VertAlignment;
  ATextBox.Brush := FResourceTable.BrushList.AddBrush(AsGmBrush);
  ATextBox.Font  := FResourceTable.FontList.AddFont(AsGmFont);
  ATextBox.Pen   := FResourceTable.PenList.AddPen(AsGmPen);
  ATextBox.Caption := AText;
  ATextBox.WordBreak := FWordWrap;
  FLastObject := AddObjectToPage(ATextBox);
end;