gmobjects.pas

GmPrintSuite 2.96.7] a

  // *** TGmPathObject ***

  TGmPathObject = class(TGmBaseObject)
  private
    FObjectType: TGmPathObjectType;
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    property ObjectType: TGmPathObjectType read FObjectType write FObjectType;
  end;

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

  // *** TGmRemoveClipObject ***

  TGmRemoveClipObject = class(TGmBaseObject)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmBaseClipObject ***

  TGmBaseClipObject = class(TGmBaseObject)
  private
    FClipRect: TGmRect;
  protected
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    property ClipRect: TGmRect read FClipRect write FClipRect;
  end;

  //----------------------------------------------------------------------------
  // *** TGmClipEllipseObject ***

  TGmClipEllipseObject = class(TGmBaseClipObject)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmClipRectObject ***

  TGmClipRectObject = class(TGmBaseClipObject)
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
  end;

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

  // *** TGmClipRoundRectObject ***

  TGmClipRoundRectObject = class(TGmClipRectObject)
  private
    FCorners: TGmPoint;
  protected
    function GetObjectID: integer; override;
    procedure DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData); override;
    procedure LoadFromValueList(Values: TGmValueList); override;
    procedure SaveToValueList(Values: TGmValueList); override;
  public
    property CornerRadius: TGmPoint read FCorners write FCorners;
  end;

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

implementation

uses GmFuncs, GmConst, Jpeg, sysutils;

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

// *** TGmOutlineShape ***

destructor TGmOutlineShape.Destroy;
begin
  if Assigned(FSavePen) then FSavePen.Free;
  inherited Destroy;
end;

function TGmOutlineShape.GetPen: TGmPen;
begin
  if not Assigned(FSavePen) then
    FSavePen := TGmPen.Create;
  FSavePen.OnChange := nil;
  FSavePen.Assign(FPen);
  FSavePen.OnChange := PenChanged;
  Result := FSavePen;
end;

procedure TGmOutlineShape.PenChanged(Sender: TObject);
begin
  ResourceTable.PenList.DeleteResource(FPen);
  FPen := ResourceTable.PenList.AddPen(FSavePen);
  FSavePen.Free;
  FSavePen := nil;
  Changed;
end;

procedure TGmOutlineShape.SetPen(Value: TGmPen);
begin
  if FPen = nil then
  begin
    FPen := Value;
    Exit;
  end;
  FSavePen := GetPen;
  FSavePen.Assign(Value);
  PenChanged(Self);
end;

procedure TGmOutlineShape.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
begin
  inherited DrawToCanvas(ACanvas, Data);
  if Assigned(FPen) then FPen.AssignToCanvas(ACanvas, Data.PpiX);
end;


procedure TGmOutlineShape.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FPen     := ResourceTable.PenList.Pen[Values.ReadIntValue(C_P, -1)];
end;

procedure TGmOutlineShape.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  if Assigned(FPen) then
    Values.WriteIntValue(C_P, ResourceTable.PenList.IndexOf(FPen));
end;

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

// *** TGmSolidShape ***

destructor TGmSolidShape.Destroy;
begin
  if Assigned(FSaveBrush) then FSaveBrush.Free;
  inherited Destroy;
end;

procedure TGmSolidShape.BrushChanged(Sender: TObject);
begin
  ResourceTable.BrushList.DeleteResource(FBrush);
  FBrush := ResourceTable.BrushList.AddBrush(FSaveBrush);
  FSaveBrush.Free;
  FSaveBrush := nil;
  Changed;
end;

function TGmSolidShape.GetBrush: TGmBrush;
begin
  if not Assigned(FSaveBrush) then
    FSaveBrush := TGmBrush.Create;
  FSaveBrush.OnChange := nil;
  FSaveBrush.Assign(FBrush);
  FSaveBrush.OnChange := BrushChanged;
  Result := FSaveBrush;
end;

procedure TGmSolidShape.SetBrush(Value: TGmBrush);
begin
  if FBrush = nil then
  begin
    FBrush := Value;
    Exit;
  end;
  FSaveBrush := GetBrush;
  FSaveBrush.Assign(Value);
  BrushChanged(Self);
end;

procedure TGmSolidShape.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
begin
  inherited DrawToCanvas(ACanvas, Data);
  if Assigned(FBrush) then FBrush.AssignToCanvas(ACanvas);
end;

procedure TGmSolidShape.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FBrush   := ResourceTable.BrushList.Brush[Values.ReadIntValue(C_B, -1)];
end;

procedure TGmSolidShape.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  if Assigned(FBrush) then
    Values.WriteIntValue(C_B, ResourceTable.BrushList.IndexOf(FBrush));
end;

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

// *** TGmBaseSolidShape ***

function TGmBaseSolidShape.GetX(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FCoords.Left, gmInches, Measurement);
end;

function TGmBaseSolidShape.GetY(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FCoords.Top, gmInches, Measurement);
end;

function TGmBaseSolidShape.GetX2(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FCoords.Right, gmInches, Measurement);
end;

function TGmBaseSolidShape.GetY2(Measurement: TGmMeasurement): Extended;
begin
  Result := ConvertValue(FCoords.Bottom, gmInches, Measurement);
end;

function TGmBaseSolidShape.GetCoords(Measurement: TGmMeasurement): TGmRect;
begin
  Result := ConvertGmRect(FCoords, gmInches, Measurement);
end;

procedure TGmBaseSolidShape.SetCoords(Measurement: TGmMeasurement; Value: TGmRect);
begin
  FCoords := ConvertGmRect(Value, Measurement, gmInches);
end;

procedure TGmBaseSolidShape.SetX(Measurement: TGmMeasurement; Value: Extended);
begin
  FCoords.Left := ConvertValue(Value, Measurement, gmInches);
end;

procedure TGmBaseSolidShape.SetY(Measurement: TGmMeasurement; Value: Extended);
begin
  FCoords.Top := ConvertValue(Value, Measurement, gmInches);
end;

procedure TGmBaseSolidShape.SetX2(Measurement: TGmMeasurement; Value: Extended);
begin
  FCoords.Right := ConvertValue(Value, Measurement, gmInches);
end;

procedure TGmBaseSolidShape.SetY2(Measurement: TGmMeasurement; Value: Extended);
begin
  FCoords.Bottom := ConvertValue(Value, Measurement, gmInches);
end;

function TGmBaseSolidShape.CoordsAsPixels(PpiX, PpiY: integer): TRect;
begin
  Result.Left   := Round(FCoords.Left * PpiX);
  Result.Top    := Round(FCoords.Top * PpiY);
  Result.Right  := Round(FCoords.Right * PpiX);
  Result.Bottom := Round(FCoords.Bottom * PpiY);
end;

procedure TGmBaseSolidShape.OffsetObject(x, y: Extended; Measurement: TGmMeasurement);
var
  InchOffsetX: Extended;
  InchOffsetY: Extended;
begin
  InchOffsetX := ConvertValue(x, Measurement, gmInches);
  InchOffsetY := ConvertValue(y, Measurement, gmInches);
  OffsetGmRect(FCoords, InchOffsetX, InchOffsetY);
  Changed;
end;

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

// *** TGmSimpleSolidShape ***

procedure TGmSimpleSolidShape.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FCoords := Values.ReadGmRectValue(C_XY, GmRect(0,0,0,0));
end;

procedure TGmSimpleSolidShape.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  Values.WriteGmRectValue(C_XY, FCoords);
end;

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

// *** TGmBaseTextObject ***

destructor TGmBaseTextObject.Destroy;
begin
  if Assigned(FSaveFont) then FSaveFont.Free;
  inherited;
end;

procedure TGmBaseTextObject.FontChanged(Sender: TObject);
begin
  ResourceTable.FontList.DeleteResource(FFont);
  FFont := ResourceTable.FontList.AddFont(FSaveFont);
  FSaveFont.Free;
  FSaveFont := nil;
  Changed;
end;

function TGmBaseTextObject.GetClipRect(Measurement: TGmMeasurement): TGmRect;
begin
  Result := ConvertGmRect(FClipRect, gmInches, Measurement);
end;

function TGmBaseTextObject.GetFont: TGmFont;
begin
  if not Assigned(FSaveFont) then
    FSaveFont := TGmFont.Create;
  FSaveFont.OnChange := nil;
  FSaveFont.Assign(FFont);
  FSaveFont.OnChange := FontChanged;
  Result := FSaveFont;
end;

procedure TGmBaseTextObject.SetCaption(Value: string);
begin
  if FCaption = Value then Exit;
  FCaption := Value;
  Changed;
end;

procedure TGmBaseTextObject.SetClipRect(Measurement: TGmMeasurement; Value: TGmRect);
var
  NewClipRect: TGmRect;
begin
  NewClipRect := ConvertGmRect(Value, Measurement, gmInches);
  if EqualGmRects(NewClipRect, FClipRect) then Exit;
  FClipRect := NewClipRect;
  Changed;
end;

procedure TGmBaseTextObject.SetFont(Value: TGmFont);
begin
  if FFont = nil then
  begin
    FFont := Value;
    Exit;
  end;
  FSaveFont := GetFont;
  FSaveFont.Assign(Value);
  FontChanged(Self);
end;

procedure TGmBaseTextObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
begin
  inherited DrawToCanvas(ACanvas, Data);
  if Assigned(FFont) then
  begin
    ACanvas.Font.PixelsPerInch := Data.PpiX;
    FFont.AssignToCanvas(ACanvas);
  end;
end;

procedure TGmBaseTextObject.LoadFromValueList(Values: TGmValueList);
begin
  inherited LoadFromValueList(Values);
  FCaption        := Values.ReadStringValue(C_T, '');
  FClipRect       := Values.ReadGmRectValue(C_CR, GmRect(-1, -1, -1, -1));
  FCoords.TopLeft := Values.ReadGmPointValue(C_XY, GmPoint(0,0));
  FFont           := ResourceTable.FontList.Font[Values.ReadIntValue(C_F, -1)];
end;

procedure TGmBaseTextObject.SaveToValueList(Values: TGmValueList);
begin
  inherited SaveToValueList(Values);
  Values.WriteStringValue(C_T, FCaption);
  Values.WriteGmRectValue(C_CR, FClipRect);
  Values.WriteGmPointValue(C_XY, FCoords.TopLeft);
  if Assigned(FFont) then
    Values.WriteIntValue(C_F, ResourceTable.FontList.IndexOf(FFont));
end;

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

// *** TGmTextObject ***

function TGmTextObject.BoundingRect(Data: TGmObjectDrawData): TGmRectPoints;
var
  ARect: TRect;
  Mf: TMetafile;
  Mfc: TMetafileCanvas;
  Rgn: HRGN;
  Ppi: integer;
begin
  Ppi := Data.PpiX;
  Mf := TMetafile.Create;
  Mfc := TMetafileCanvas.Create(Mf, 0);
  BeginPath(Mfc.Handle);

  try
    Mfc.Font.PixelsPerInch := Ppi;
    FBrush.AssignToCanvas(Mfc);
    FFont.AssignToCanvas(Mfc);
    Mfc.TextOut(Round(X[gmInches] * Ppi),
                Round(Y[gmInches] * Ppi),
                FCaption);
  finally
    EndPath(Mfc.Handle);
    Rgn := PathToRegion(Mfc.Handle);
    GetRgnBox(Rgn, ARect);
    DeleteObject(Rgn);
    Result := RectToGmRectPoints(ARect);
    Mfc.Free;
  end;
  Mf.Free;
end;

function TGmTextObject.GetObjectID: integer;
begin
  Result := GM_TEXT_OBJECT_ID;
end;

procedure TGmTextObject.DrawToCanvas(ACanvas: TCanvas; var Data: TGmObjectDrawData);
var
  TokenizedText: string;
  xy: TPoint;