gmclasses.pas

GmPrintSuite 2.96.7] a

  Values: TGmValueList;
begin
  Stream.Write(ObjectID, SizeOf(ObjectID));
  Values := TGmValueList.Create;
  try
    SaveToValueList(Values);
    Values.SaveToStream(Stream);
  finally
    Values.Free;
  end;
end;

procedure TGmBaseObject.LoadFromValueList(Values: TGmValueList);
begin
  FTag := Values.ReadIntValue(C_UI, -1);
end;

procedure TGmBaseObject.SaveToValueList(Values: TGmValueList);
begin
  Values.Add('');
  Values.Add('');
  Values.WriteIntValue(C_ID, FObjectID);
  Values.WriteIntValue(C_UI, FTag);
end;

procedure TGmBaseObject.AssignTo(Source: TPersistent);
begin
  FPrintThisObject := (Source as TGmBaseObject).PrintThisObject;
end;

procedure TGmBaseObject.Changed;
begin
  if FUpdating then Exit;
  if Assigned(FOnChange) then FOnChange(Self);
end;

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

// *** TGmVisibleObject ***

constructor TGmVisibleObject.Create(AResourceTable: TGmResourceTable);
begin
  inherited Create(AResourceTable);
  FAllowDrag := True;
end;


procedure TGmVisibleObject.AssignTo(Source: TPersistent);
begin

end;

function TGmVisibleObject.BoundingRect(Data: TGmObjectDrawData): TGmRectPoints;
var
  Mf: TMetafile;
  Mfc: TMetafileCanvas;
  Rgn: HRGN;
  ARect: TRect;
begin
  Mf := TMetafile.Create;
  try
    Mfc := TMetafileCanvas.Create(Mf, 0);
    try
      BeginPath(Mfc.Handle);
      Draw(Mfc, Data);
      EndPath(Mfc.Handle);
      Rgn := PathToRegion(Mfc.Handle);
      GetRgnBox(Rgn, ARect);
      DeleteObject(Rgn);
    finally
      Mfc.Free;
    end;
  finally
    Mf.Free;
  end;
  Result := RectToGmRectPoints(ARect);
end;

procedure TGmVisibleObject.Arrange(ChangeLevel: TGmArrangeObject);
begin
  if Assigned(FLevelChange) then FLevelChange(Self, ChangeLevel);
end;

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

// *** TGmObjectList ***

constructor TGmBaseObjectList.Create;
begin
  inherited Create(True);
end;

procedure TGmBaseObjectList.AddObject(AObject: TGmBaseObject);
begin
  Add(AObject);
  AObject.OnChange := Changed;
  Changed(Self);
end;

procedure TGmBaseObjectList.InsertObject(Index: integer; AObject: TGmBaseObject);
begin
  if Index < 0 then Index := 0;
  if Index > Count then Index := Count;
  Insert(Index, AObject);
  AObject.OnChange := Changed;
  Changed(Self);
end;

function TGmBaseObjectList.GetObject(index: integer): TGmBaseObject;
begin
  Result := TGmBaseObject(Items[index]);
end;

procedure TGmBaseObjectList.SetObject(index: integer; AObject: TGmBaseObject);
begin
  Items[index] := AObject;
end;

procedure TGmBaseObjectList.Changed(Sender: TObject);
begin
  if Assigned(FOnChanged) then FOnChanged(Self);
end;

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

// *** TGmRtfPageInfo ***

constructor TGmPageRtfInfo.Create(AResourceTable: TObject);
begin
  inherited Create;
  FResourceTable := AResourceTable;
  FMargins := TGmValueRect.Create;
end;

destructor TGmPageRtfInfo.Destroy;
begin
  FMargins.Free;
  inherited Destroy;
end;

procedure TGmPageRtfInfo.Clear;
begin
  FOffset := Point(0,0);
  FMargins.AsInchRect := GmRect(0, 0, 0, 0);
  TGmResourceTable(FResourceTable).CustomMemoList.DeleteResource(FRichEdit);
end;

procedure TGmPageRtfInfo.LoadFromValueList(Values: TGmValueList);
var
  ResourceTable: TGmResourceTable;
begin
  ResourceTable := TGmResourceTable(FResourceTable);
  FOffset := Values.ReadPointValue(C_XY, Point(0,0));
  FRichEdit := ResourceTable.CustomMemoList.Memo[Values.ReadIntValue(C_M, -1)];
  FMargins.AsInchRect := Values.ReadGmRectValue(C_MV, GmRect(0, 0, 0, 0));
  FWrapText := Values.ReadBoolValue(C_WRT, True);
end;

procedure TGmPageRtfInfo.SaveToValueList(Values: TGmValueList);
var
  ResourceTable: TGmResourceTable;
begin
  ResourceTable := TGmResourceTable(FResourceTable);
  Values.WritePointValue(C_XY, FOffset);
  Values.WriteIntValue(C_M, ResourceTable.CustomMemoList.IndexOf(FRichEdit));
  Values.WriteGmRectValue(C_MV, FMargins.AsInchRect);
  Values.WriteBoolValue(C_WRT, FWrapText);
end;

{procedure TGmPageRtfInfo.LoadFromStream(Stream: TStream);
var
  MemoIndex: integer;
begin
  FOffset := PointFromStream(Stream);
  MemoIndex := IntFromStream(Stream);
  FRichEdit := TGmResourceTable(FResourceTable).CustomMemoList.Memo[MemoIndex];
  FMargins.LoadFromStream(Stream);
end;

procedure TGmPageRtfInfo.SaveToStream(Stream: TStream);
var
  MemoIndex: integer;
begin
  PointToStream(Stream, FOffset);
  MemoIndex := TGmResourceTable(FResourceTable).CustomMemoList.IndexOf(FRichEdit);
  IntToStream(Stream, MemoIndex);
  FMargins.SaveToStream(Stream);
end;}

procedure TGmPageRtfInfo.Changed;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TGmPageRtfInfo.SetMargins(Value: TGmValueRect);
begin
  FMargins.Assign(Value);
end;

procedure TGmPageRtfInfo.SetOffset(Value: TPoint);
begin
  FOffset := Value;
  Changed;
end;

procedure TGmPageRtfInfo.SetRichEdit(ARichEdit: TCustomMemo);
begin
  if FRichEdit = ARichEdit then Exit;
  if Assigned(FRichEdit) then
    TGmResourceTable(FResourceTable).CustomMemoList.DeleteResource(FRichEdit);
  FRichEdit := ARichEdit;
end;

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

// *** TGmMargins ***

constructor TGmMargins.Create(GmPrinter: TObject);
begin
  inherited Create;
  FPen := TPen.Create;
  FPrinterMarginPen := TPen.Create;
  FLeft := TGmValue.Create(Changed);
  FTop := TGmValue.Create(Changed);
  FRight := TGmValue.Create(Changed);
  FBottom := TGmValue.Create(Changed);
  FPrinter := GmPrinter;
  FLeft.AsInches := 0.5;
  FTop.AsInches := 0.5;
  FRight.AsInches := 0.5;
  FBottom.AsInches := 0.5;
  FValues := TGmMarginValues.Create(Self);
  FClipMargins := False;
  FPen.Color := clSilver;
  FPen.Style := psDot;
  FPrinterMarginPen.Assign(FPen);
  FVisible := False;
  FShowPrinterMargins := False;
  FUsePrinterMargins := False;
  FUpdating := False;
  FPen.OnChange := Changed;
  FPrinterMarginPen.OnChange := Changed;
end;

destructor TGmMargins.Destroy;
begin
  FLeft.Free;
  FTop.Free;
  FRight.Free;
  FBottom.Free;
  FValues.Free;
  FPen.Free;
  FPrinterMarginPen.Free;
  inherited Destroy;
end;

procedure TGmMargins.Assign(Source: TPersistent);
begin
  if (Source is TGmMargins) then
  begin
    FUpdating := True;
    FLeft.Assign((Source as TGmMargins).Left);
    FTop.Assign((Source as TGmMargins).Top);
    FRight.Assign((Source as TGmMargins).Right);
    FBottom.Assign((Source as TGmMargins).Bottom);
    FPen.Assign((Source as TGmMargins).Pen);
    FPrinterMarginPen.Assign((Source as TGmMargins).PrinterMarginPen);
    FShowPrinterMargins := (Source as TGmMargins).ShowPrinterMargins;
    FVisible := (Source as TGmMargins).Visible;
    FUpdating := False;
    Changed(Self);
  end
  else
    inherited Assign(Source);
end;

procedure TGmMargins.Clip(APageSize: TGmSize; AOrientation: TGmOrientation; ACanvas: TCanvas; Ppi: integer);
var
  ARect: TRect;
  MarginRgn: HRGN;
  APrinterInfo: TGmPrinterInfo;
begin
  FDrawPpi := Ppi;
  if FUsePrinterMargins then
  begin
    APrinterInfo := TGmPrinter(FPrinter).PrinterInfo;
    if FUsePrinterMargins then AsInches := APrinterInfo.MarginsInches[AOrientation];
    ARect := Rect(Round(APrinterInfo.MarginsInches[AOrientation].Left * Ppi),
                  Round(APrinterInfo.MarginsInches[AOrientation].Top * Ppi),
                  Round((APageSize.Width-APrinterInfo.MarginsInches[AOrientation].Right) * Ppi),
                  Round((APageSize.Height-APrinterInfo.MarginsInches[AOrientation].Bottom) * Ppi));
  end
  else
  begin
    ARect := Rect(Round((FLeft.AsInches)*Ppi),
                Round((FTop.AsInches)*Ppi),
                Round((APageSize.Width-(FRight.AsInches))*Ppi),
                Round((APageSize.Height-(FBottom.AsInches))*Ppi));
  end;
  if FClipMargins then
  begin
    if not BeginPath(ACanvas.Handle) then Exit;
    GmDrawRect(ACanvas, ARect);
    EndPath(ACanvas.Handle);
    MarginRgn := PathToRegion(ACanvas.Handle);
    try
      SelectClipRgn(ACanvas.Handle, MarginRgn);
    finally
      DeleteObject(MarginRgn);
    end;
  end;
end;

procedure TGmMargins.Draw(APageSize: TGmSize; AOrientation: TGmOrientation; ACanvas: TCanvas; Ppi: integer);
var
  ARect: TRect;
  APrinterInfo: TGmPrinterInfo;
  APrintMargins: TGmRect;
  Pw, Ph: Extended;
begin
  FDrawPpi := Ppi;
  APrinterInfo := (FPrinter as TGmPrinter).PrinterInfo;
  if FVisible then
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Pen.Assign(FPen);
    ACanvas.Pen.Style;

    if (APrinterInfo.PrinterAvailable) and (FUsePrinterMargins) then
      AsInches := APrinterInfo.MarginsInches[AOrientation];

    ARect := Rect(Round((FLeft.AsInches)*Ppi),
                  Round((FTop.AsInches)*Ppi),
                  Round((APageSize.Width-(FRight.AsInches))*Ppi),
                  Round((APageSize.Height-(FBottom.AsInches))*Ppi));
    ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);

    if (APrinterInfo.PrinterAvailable) and (FShowPrinterMargins) then
    begin
      ACanvas.Brush.Style := bsClear;
      ACanvas.Pen.Assign(FPrinterMarginPen);
      APrintMargins := APrinterInfo.MarginsInches[AOrientation];

      if AOrientation = gmPortrait then
      begin
        Pw := APrinterInfo.PhysicalSizeX;
        Ph := APrinterInfo.PhysicalSizeY;
      end
      else
      begin
        Pw := APrinterInfo.PhysicalSizeY;
        Ph := APrinterInfo.PhysicalSizeX;
      end;
      ARect := Rect(Round((APrintMargins.Left)*Ppi),
                    Round((APrintMargins.Top)*Ppi),
                    Round((Pw-APrintMargins.Right) * Ppi),
                    Round((Ph-APrintMargins.Bottom) * Ppi));
      ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    end;
  end;
end;

procedure TGmMargins.LoadFromStream(Stream: TStream);
var
  AValues: TGmValueList;
  APen: TGmPen;
begin
  AValues := TGmValueList.Create;
  try
    AValues.LoadFromStream(Stream);
    AsInches     := AValues.ReadGmRectValue(C_MV, GmRect(0,0,0,0));// GmRectFromString(AValues.ReadStringValue(C_MV, ''));
    FClipMargins := AValues.ReadBoolValue(C_CLM, False);
  finally
    AValues.Free;
  end;
  APen := TGmPen.Create;
  try
    APen.LoadFromStream(Stream);
    APen.AssignToPen(FPen);
  finally
    APen.Free;
  end;
end;

procedure TGmMargins.SaveToStream(Stream: TStream);
var
  AValues: TGmValueList;
  APen: TGmPen;
begin
  AValues := TGmValueList.Create;
  try
    AValues.WriteGmRectValue(C_MV, AsInches);
    AValues.WriteBoolValue(C_CLM, FClipMargins);
    AValues.SaveToStream(Stream);
  finally
    AValues.Free;
  end;
  APen := TGmPen.Create;
  try
    APen.Assign(FPen);
    APen.SaveToStream(Stream);
  finally
    APen.Free;
  end;
end;

function TGmMargins.GetAsInches: TGmRect;
begin
  Result.Left := FLeft.AsInches;
  Result.Top  := FTop.AsInches;
  Result.Right := FRight.AsInches;
  Result.Bottom := FBottom.AsInches;
end;

function TGmMargins.GetPrinterMargins(Measurement: TGmMeasurement; AOrientation: TGmOrientation): TGmRect;
begin
  Result := ConvertGmRect(TGmPrinter(FPrinter).PrinterInfo.MarginsInches[AOrientation], gmInches, Measurement);
end;

procedure TGmMargins.Changed(Sender: TObject);
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TGmMargins.SetAsInches(ARect: TGmRect);
begin
  FUpdating := True;
  FLeft.AsInches := ARect.Left;
  FTop.AsInches := ARect.Top;
  FRight.AsInches := ARect.Right;
  FBottom.AsInches := ARect.Bottom;
  FUpdating := False;
end;

procedure TGmMargins.SetClipMargins(Value: Boolean);
begin
  if FClipMargins = Value then Exit;
  FClipMargins := Value;
  Changed(Self);
end;

procedure TGmMargins.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
  Changed(Self);
end;

procedure TGmMargins.SetPrinterMarginPen(Value: TPen);
begin
  FPrinterMarginPen.Assign(Value);
  Changed(Self);
end;

procedure TGmMargins.SetShowPrinterMargins(Value: Boolean);
begin
  if FShowPrinterMargins = Value then Exit;
  FShowPrinterMargins := Value;
  Changed(Self);
end;

procedure TGmMargins.SetUsePrinterMargins(Value: Boolean);
begin
  if FUsePrinterMargins = Value then Exit;
  FUsePrinterMargins := Value;
  Changed(Self);
end;

procedure TGmMargins.SetVisible(Value: Boolean);
begin
  if FVisible = Value then Exit;
  FVisible := Value;
  Changed(Self);
end;

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

// *** TGmMarginValues ***

constructor TGmMarginValues.Create(AMargins: TGmMargins);
begin
  inherited Create;
  FMargins := AMargins;
  FMeasurement := gmInches;
end;

function TGmMarginValues.GetValue(index: integer): Single;
begin
  Result := 0;
  case index of
    0: Result := FMargins.Left.AsGmValue[FMeasurement];
    1: Result := FMargins.Top.AsGmValue[FMeasurement];
    2: Result := FMargins.Right.AsGmValue[FMeasurement];
    3: Result := FMargins.Bottom.AsGmValue[FMeasurement];
  end
end;

procedure TGmMarginValues.SetMeasurement(Value: TGmMeasurement);
begin
  if FMeasurement = Value then Exit;
  FMeasurement := Value;
end;

procedure TGmMarginValues.SetValue(index: integer; Value: Single);
begin