gmobjects.pas

GmPrintSuite 2.96.7] a

begin
  X[index]  := ConvertValue(Value.X, index, gmInches);
  Y[index]  := ConvertValue(Value.Y, index, gmInches);
  X2[index] := ConvertValue(Value.X2, index, gmInches);
  Y2[index] := ConvertValue(Value.Y2, index, gmInches);
  X3[index] := ConvertValue(Value.X3, index, gmInches);
  Y3[index] := ConvertValue(Value.Y3, index, gmInches);
  X4[index] := ConvertValue(Value.X4, index, gmInches);
  Y4[index] := ConvertValue(Value.Y4, index, gmInches);
end;

procedure TGmComplexShape.SetX4(index: TGmMeasurement; const Value: Extended);
var
  NewX4: Extended;
begin
  NewX4 := ConvertValue(Value, index, gmInches);
  if FX4 = NewX4 then Exit;
  FX4 := NewX4;
  Changed;
end;

procedure TGmComplexShape.SetY4(index: TGmMeasurement; const Value: Extended);
var
  NewY4: Extended;
begin
  NewY4 := ConvertValue(Value, index, gmInches);
  if FY4 = NewY4 then Exit;
  FY4 := NewY4;
  Changed;
end;

procedure TGmComplexShape.OffsetObject(x, y: Extended; Measurement: TGmMeasurement);
var
  InchOffsetX: Extended;
  InchOffsetY: Extended;
begin
  InchOffsetX := ConvertValue(x, Measurement, gmInches);
  InchOffsetY := ConvertValue(y, Measurement, gmInches);
  FX3 := FX3 + InchOffsetX;
  FY3 := FY3 + InchOffsetY;
  inherited OffsetObject(x, y, Measurement);
end;

procedure TGmComplexShape.LoadFromValueList(Values: TGmValueList);
var
  XY4: TGmPoint;
begin
  inherited LoadFromValueList(Values);
  XY4 := Values.ReadGmPointValue(C_XY3, GmPoint(0,0));
  FX4 := XY4.X;
  FY4 := XY4.Y;
end;

procedure TGmComplexShape.SaveToValueList(Values: TGmValueList);
var
  XY4: TGmPoint;
begin
  inherited SaveToValueList(Values);
  XY4 := GmPoint(FX4, FY4);
  Values.WriteGmPointValue(C_XY4, XY4);
end;

//------------------------------------------------------------------------------

// *** TGmArcShape ***

function TGmArcShape.GetObjectID: integer;
begin
  Result := GM_ARC_ID;
end;

procedure TGmArcShape.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ACoords: TGmComplexCoords;
begin
  inherited DrawToCanvas(ACanvas, Data);
  ACoords := Coords[gmInches];
  ACanvas.Arc(Round(ACoords.X  * Data.PpiX),
              Round(ACoords.Y  * Data.PpiY),
              Round(ACoords.X2 * Data.PpiX),
              Round(ACoords.Y2 * Data.PpiY),
              Round(ACoords.X3 * Data.PpiX),
              Round(ACoords.Y3 * Data.PpiY),
              Round(ACoords.X4 * Data.PpiX),
              Round(ACoords.Y4 * Data.PpiY));
end;

//------------------------------------------------------------------------------

// *** TGmChordShape ***

function TGmChordShape.GetObjectID: integer;
begin
  Result := GM_CHORD_ID;
end;

procedure TGmChordShape.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ACoords: TGmComplexCoords;
begin
  inherited DrawToCanvas(ACanvas, Data);
  ACoords := Coords[gmInches];
  ACanvas.Chord(Round(ACoords.X  * Data.PpiX),
                Round(ACoords.Y  * Data.PpiY),
                Round(ACoords.X2 * Data.PpiX),
                Round(ACoords.Y2 * Data.PpiY),
                Round(ACoords.X3 * Data.PpiX),
                Round(ACoords.Y3 * Data.PpiY),
                Round(ACoords.X4 * Data.PpiX),
                Round(ACoords.Y4 * Data.PpiY));
end;

//------------------------------------------------------------------------------

// *** TGmPieShape ***

function TGmPieShape.GetObjectID: integer;
begin
  Result := GM_PIE_ID;
end;

procedure TGmPieShape.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ACoords: TGmComplexCoords;
begin
  inherited DrawToCanvas(ACanvas, Data);
  ACoords := Coords[gmInches];
  ACanvas.Pie(Round(ACoords.X  * Data.PpiX),
              Round(ACoords.Y  * Data.PpiY),
              Round(ACoords.X2 * Data.PpiX),
              Round(ACoords.Y2 * Data.PpiY),
              Round(ACoords.X3 * Data.PpiX),
              Round(ACoords.Y3 * Data.PpiY),
              Round(ACoords.X4 * Data.PpiX),
              Round(ACoords.Y4 * Data.PpiY));
end;

//------------------------------------------------------------------------------

// *** TGmPolyBaseObject ***

function TGmPolyBaseObject.GetPoints(Measurement: TGmMeasurement): TGmPolyPoints;
begin
  Result := FPoints;
  ConvertGmPolyPoints(Result, gmInches, Measurement);
end;

procedure TGmPolyBaseObject.SetPoints(Measurement: TGmMeasurement; Value: TGmPolyPoints);
var
  NewPoints: TGmPolyPoints;
begin
  NewPoints := Value;
  ConvertGmPolyPoints(NewPoints, Measurement, gmInches);
  FPoints := NewPoints;
  Changed;
end;

procedure TGmPolyBaseObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
//type
//  PPoints = ^TPoints;
//  TPoints = array[0..0] of TPoint;
var
  PixelPoints: array of TPoint;
  ICount: integer;
begin
  inherited DrawToCanvas(ACanvas, Data);
  SetLength(PixelPoints, High(FPoints)+1);
  for ICount := 0 to High(FPoints) do
  begin
    PixelPoints[ICount].X := Round(FPoints[ICount].X * Data.PpiX);
    PixelPoints[ICount].Y := Round(FPoints[ICount].Y * Data.PpiY);
  end;
  GmDrawPolyShape(ObjectID, ACanvas, PixelPoints);
end;

procedure TGmPolyBaseObject.LoadFromValueList(Values: TGmValueList);
var
  ICount: integer;
  NumPoints: integer;
begin
  inherited LoadFromValueList(Values);
  NumPoints := Values.ReadIntValue(C_SZ, 0);
  SetLength(FPoints, NumPoints);
  for ICount := 0 to NumPoints-1 do
    FPoints[ICount] := Values.ReadGmPointValue(C_XY+IntToStr(ICount), GmPoint(0, 0));
end;

procedure TGmPolyBaseObject.SaveToValueList(Values: TGmValueList);
var
  ICount,
  NumPoints: integer;
begin
  inherited SaveToValueList(Values);
  NumPoints := High(FPoints)+1;
  Values.WriteIntValue(C_SZ, NumPoints);
  for ICount := 0 to NumPoints-1 do
  begin
    Values.WriteGmPointValue(C_XY+IntToStr(ICount), FPoints[ICount]);
  end;
end;

procedure TGmPolyBaseObject.OffsetObject(x, y: Extended; Measurement: TGmMeasurement);
var
  OffsetX: Extended;
  OffsetY: Extended;
  ICount: integer;
begin
  OffsetX := ConvertValue(x, Measurement, gmInches);
  OffsetY := ConvertValue(y, Measurement, gmInches);
  for ICount := 0 to High(FPoints) do
    OffsetGmPoint(FPoints[ICount], OffsetX, OffsetY);
end;

//------------------------------------------------------------------------------

// *** TGmPolygonObject ***

function TGmPolygonObject.GetObjectID: integer;
begin
  Result := GM_POLYGON_OBJECT_ID;
end;

//------------------------------------------------------------------------------

// *** TGmPolyline ***

function TGmPolylineObject.GetObjectID: integer;
begin
  Result := GM_POLYLINE_OBJECT_ID;
end;

//------------------------------------------------------------------------------

// *** TGmPolyBezierObject ***

function TGmPolyBezierObject.GetObjectID: integer;
begin
  Result := GM_POLYBEZIER_OBJECT_ID;
end;

//------------------------------------------------------------------------------

// *** TGmPolylineToObject ***

function TGmPolylineToObject.GetObjectID: integer;
begin
  Result := GM_POLYLINETO_OBJECT_ID;
end;

//------------------------------------------------------------------------------

// *** TGmPolyBezierToObject ***

function TGmPolyBezierToObject.GetObjectID: integer;
begin
  Result := GM_POLYBEZIERTO_OBJECT_ID;
end;

//------------------------------------------------------------------------------

// *** TGmPathObject ***

function TGmPathObject.GetObjectID: integer;
begin
  Result := GM_PATH_OBJECT_ID;
end;

procedure TGmPathObject.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FObjectType := TGmPathObjectType(Values.ReadIntValue(C_PT, Ord(gmEndPath)));
end;

procedure TGmPathObject.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  Values.WriteIntValue(C_PT, Ord(FObjectType));
end;

procedure TGmPathObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
begin
  inherited DrawToCanvas(ACanvas, Data);
  case FObjectType of
    gmBeginPath        : BeginPath(ACanvas.Handle);
    gmEndPath          : EndPath(ACanvas.Handle);
    gmFillPath         : FillPath(ACanvas.Handle);
    gmStrokePath       : StrokePath(ACanvas.Handle);
    gmStrokeAndFillPath: StrokeAndFillPath(ACanvas.Handle);
    gmCloseFigure      : CloseFigure(ACanvas.Handle);
  end;
end;

//------------------------------------------------------------------------------

// *** TGmRemoveClipObject ***

function TGmRemoveClipObject.GetObjectID: integer;
begin
  Result := GM_REMOVE_CLIP_OBJECT_ID;
end;

procedure TGmRemoveClipObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
begin
  SelectClipRgn(ACanvas.Handle, 0);
end;

//------------------------------------------------------------------------------

// *** TGmBaseClipObject ***

procedure TGmBaseClipObject.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  Values.WriteGmRectValue(C_XY, FClipRect);
end;

procedure TGmBaseClipObject.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  FClipRect := Values.ReadGmRectValue(C_XY, GmRect(0, 0, 0, 0));
end;

//------------------------------------------------------------------------------

// *** TGmClipEllipseObject ***

function TGmClipEllipseObject.GetObjectID: integer;
begin
  Result := GM_CLIPELLIPSE_OBJECT_ID;
end;

procedure TGmClipEllipseObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ClipRgn: HRGN;
  ARect: TRect;
begin
  ARect.Left   := Round(FClipRect.Left * Data.PpiX);
  ARect.Top    := Round(FClipRect.Top * Data.PpiY);
  ARect.Right  := Round(FClipRect.Right * Data.PpiX);
  ARect.Bottom := Round(FClipRect.Bottom * Data.PpiY);
  BeginPath(ACanvas.Handle);
  GmDrawEllipse(ACanvas, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  EndPath(ACanvas.Handle);
  ClipRgn := PathToRegion(ACanvas.Handle);
  try
    SelectClipRgn(ACanvas.Handle, ClipRgn);
  finally
    DeleteObject(ClipRgn);
  end;
end;

//------------------------------------------------------------------------------

// *** TGmClipRectObject ***

function TGmClipRectObject.GetObjectID: integer;
begin
  Result := GM_CLIPRECT_OBJECT_ID;
end;

procedure TGmClipRectObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ClipRgn: HRGN;
  ARect: TRect;
begin
  ARect.Left   := Round(FClipRect.Left * Data.PpiX);
  ARect.Top    := Round(FClipRect.Top * Data.PpiY);
  ARect.Right  := Round(FClipRect.Right * Data.PpiX);
  ARect.Bottom := Round(FClipRect.Bottom * Data.PpiY);
  BeginPath(ACanvas.Handle);
  GmDrawRect(ACanvas, ARect);
  EndPath(ACanvas.Handle);
  ClipRgn := PathToRegion(ACanvas.Handle);
  try
    SelectClipRgn(ACanvas.Handle, ClipRgn);
  finally
    DeleteObject(ClipRgn);
  end;
end;

//------------------------------------------------------------------------------

// *** TGmClipRoundRectObject ***

function TGmClipRoundRectObject.GetObjectID: integer;
begin
  Result := GM_CLIPROUNDRECT_OBJECT_ID;
end;

procedure TGmClipRoundRectObject.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FCorners := Values.ReadGmPointValue(C_XY3, GmPoint(0,0));
end;

procedure TGmClipRoundRectObject.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  Values.WriteGmPointValue(C_XY3, FCorners);
end;

procedure TGmClipRoundRectObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  ClipRgn: HRGN;
  ARect: TRect;
  ACorners: TPoint;
begin
  ARect.Left   := Round(FClipRect.Left * Data.PpiX);
  ARect.Top    := Round(FClipRect.Top * Data.PpiY);
  ARect.Right  := Round(FClipRect.Right * Data.PpiX);
  ARect.Bottom := Round(FClipRect.Bottom * Data.PpiY);
  ACorners.X   := Round(FCorners.X * Data.PpiX);
  ACorners.Y   := Round(FCorners.Y * Data.PpiY);
  BeginPath(ACanvas.Handle);
  GmDrawRoundRect(ACanvas, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ACorners.X, ACorners.Y);
  EndPath(ACanvas.Handle);
  ClipRgn := PathToRegion(ACanvas.Handle);
  try
    SelectClipRgn(ACanvas.Handle, ClipRgn);
  finally
    DeleteObject(ClipRgn);
  end;
end;

end.