gmpagelist.pas

GmPrintSuite 2.96.7] a

  Result := FObjects.Count;
end;

function TGmPage.GetGmObject(index: integer): TGmBaseObject;
begin
  Result := FObjects.GmObject[index];
end;

function TGmPage.GetPageNum: integer;
begin
  Result := 0;
  if Assigned(FPageList) then Result := FPageList.IndexOf(Self)+1;
end;

function TGmPage.GetPageSize(Measurement: TGmMeasurement): TGmSize;
begin
  Result := ConvertGmSize(FPageSizeInch, gmInches, Measurement);
end;

procedure TGmPage.Clear;
begin
  FObjects.Clear;
  Changed(Self);
end;

procedure TGmPage.DeleteGmObject(AObject: TGmBaseObject);
var
  ObjectIndex: integer;
begin
  ObjectIndex := FObjects.IndexOf(AObject);
  if ObjectIndex > -1 then
    FObjects.Delete(ObjectIndex);
  Changed(Self);
end;

procedure TGmPage.DeleteLastGmObject;
begin
  DeleteGmObject(FObjects.GmObject[FObjects.Count-1]);
end;

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

procedure TGmPage.DrawRichText(ACanvas: TCanvas; PpiX, PpiY: integer; WrapRichText: Boolean);
var
  Range: TFormatRange;
  TextLenEx: TGetTextLengthEx;
  Mf: TMetafile;
  Mfc: TMetafileCanvas;
begin
  if not Assigned(FRtfInfo) then Exit;
  if not Assigned(FRtfInfo.RichEdit) then Exit;
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Range do
  begin
    hdc := ACanvas.Handle;
    hdcTarget := FPageList.FPrinter.Handle;
    rc.Left := 0;
    rc.Top := 0;
    rcPage.Right := Round(FPageSizeInch.Width * 1440);
    rcPage.Bottom := Round(FPageSizeInch.Height * 1440);
    rc := rcPage;
    rc.Left := FRtfInfo.Margins.Left.AsTwips;
    rc.Top := FRtfInfo.Margins.Top.AsTwips;
    rc.Right := FRtfInfo.Margins.Right.AsTwips;
    rc.Bottom := FRtfInfo.Margins.Bottom.AsTwips+1;
    chrg.cpMax := -1;

    if not WrapRichText then rc.Right := (rc.Right * 10);
    
    with TextLenEx do
    begin
      flags := GTL_DEFAULT;
      codepage := CP_ACP;
    end;
    chrg.cpMin := FRtfInfo.Offset.X;
    chrg.cpMax := FRtfInfo.Offset.Y;

    if not IsPrinterCanvas(ACanvas) then
    begin
      Mf := TMetafile.Create;
      try
        Mfc := TMetafileCanvas.Create(Mf, FPageList.FPrinter.Handle);
        try
          hdc := Mfc.Handle;
          Mfc.Font.PixelsPerInch := PpiX;
          SetMapMode(Mfc.Handle, MM_ANISOTROPIC);
          SetWindowExtEx(Mfc.Handle, rcPage.Right, rcPage.Bottom, nil);
          SetViewPortExtEx(Mfc.Handle, rcPage.Right, rcPage.Bottom, nil);
          ScaleViewportExtEx(Mfc.Handle,
                             PpiX,
                             FPageList.FPrinter.PrinterInfo.PpiX,
                             PpiY,
                             FPageList.FPrinter.PrinterInfo.PpiY,
                             nil);
          SendMessage(FRtfInfo.RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));

        finally
          Mfc.Free;
        end;
        ACanvas.Draw(0,0,Mf);
      finally
        Mf.Free;
      end;
    end
    else
      SendMessage(FRtfInfo.RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  end;
end;

procedure TGmPage.SetOrientation(Value: TGmOrientation);
var
  NewW, NewH: Extended;
begin
  if Value = gmPortrait then
  begin
    NewW := MinFloat(FPageSizeInch.Width, FPageSizeInch.Height);
    NewH := MaxFloat(FPageSizeInch.Width, FPageSizeInch.Height);
  end
  else
  begin
    NewW := MaxFloat(FPageSizeInch.Width, FPageSizeInch.Height);
    NewH := MinFloat(FPageSizeInch.Width, FPageSizeInch.Height);
  end;
  FPageSizeInch := GmSize(NewW, NewH);
  FOrientation := Value;
  //Changed(Self);
  if Assigned(FOnChangeOrientation) then FOnChangeOrientation(Self);
end;

procedure TGmPage.DrawToCanvas(ACanvas: TCanvas; PpiX, PpiY: integer; FastDraw: Boolean);
var
  ICount: integer;
  AObject: TGmBaseObject;
  DrawData: TGmObjectDrawData;
begin
  DrawRichText(ACanvas, PpiX, PpiY, FRtfInfo.WrapText);
  DrawData.PpiX := PpiX;
  DrawData.PpiY := PpiY;
  DrawData.Page := PageNum;
  DrawData.FastDraw := FastDraw;
  DrawData.NumPages := FPageList.Count;
  for ICount := 0 to FObjects.Count-1 do
  begin
    AObject := FObjects.GmObject[ICount];
    AObject.Draw(ACanvas, DrawData);
  end;
  with FPageList do
  begin
    if FShowHeader then Header.DrawToCanvas(ACanvas, Margins, FPageSizeInch, PpiX, PpiY, PageNum, Count);
    if FShowFooter then Footer.DrawToCanvas(ACanvas, Margins, FPageSizeInch, PpiX, PpiY, PageNum, Count);
  end;
end;

procedure TGmPage.LoadFromStream(Stream: TStream);
var
  AValues: TGmValueList;
  ICount, NumObjects: integer;
  ObjectID: integer;
  NewObject: TGmBaseObject;
begin
  AValues := TGmValueList.Create;
  try
    AValues.LoadFromStream(Stream);
    FRtfInfo.LoadFromValueList(AValues);
    FOrientation         := TGmOrientation(AValues.ReadIntValue(C_O, 0));
    FPageSizeInch.Width  := AValues.ReadExtValue(C_PW, 8.26);
    FPageSizeInch.Height := AValues.ReadExtValue(C_PH, 11.69);
    NumObjects           := AValues.ReadIntValue(C_NO, 0);
    FShowHeader          := AValues.ReadBoolValue(C_SH, True);
    FShowFooter          := AValues.ReadBoolValue(C_SF, True);
    for ICount := 1 to NumObjects do
    begin
      Stream.ReadBuffer(ObjectID, SizeOf(ObjectID));
      NewObject := CreateGmObject(ObjectID);
      if Assigned(NewObject) then
      begin
        NewObject.LoadFromStream(Stream);
        AddObject(NewObject);
      end
      else
        AValues.LoadFromStream(Stream);
    end;
  finally
    AValues.Free;
  end;
end;

procedure TGmPage.SaveToStream(Stream: TStream);
var
  AValues: TGmValueList;
  ICount: integer;
begin
  AValues := TGmValueList.Create;
  try
    FRtfInfo.SaveToValueList(AValues);
    AValues.WriteIntValue(C_O, Ord(FOrientation));
    AValues.WriteExtValue(C_PW, FPageSizeInch.Width);
    AValues.WriteExtValue(C_PH, FPageSizeInch.Height);
    AValues.WriteIntValue(C_NO, Count);
    if FShowHeader = False then AValues.WriteBoolValue(C_SH, False);
    if FShowFooter = False then AValues.WriteBoolValue(C_SF, False);
    AValues.SaveToStream(Stream);
  finally
    AValues.Free;
  end;
  for ICount := 0 to Count-1 do
    GmObject[ICount].SaveToStream(Stream);
end;

procedure TGmPage.SetPageSize(AWidth, AHeight: Extended);
begin
  FPageSizeInch.Width := AWidth;
  FPageSizeInch.Height := AHeight;
  Changed(Self);
end;

procedure TGmPage.SetShowFooter(Value: Boolean);
begin
  if FShowFooter = Value then Exit;
  FShowFooter := Value;
  Changed(Self);
end;

procedure TGmPage.SetShowHeader(Value: Boolean);
begin
  if FShowHeader = Value then Exit;
  FShowHeader := Value;
  Changed(Self);
end;

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

// *** TGmPageList ***

constructor TGmPageList.Create;
begin
  inherited Create;
  FResourceTable := TGmResourceTable.Create;
  FCanvas := TGmCanvas.Create(Self);
  FFooter := TGmFooter.Create(HeaderFooterChanged);
  FHeader := TGmHeader.Create(HeaderFooterChanged);
  FPrinter := TGmPrinter.Create;
  FMargins := TGmMargins.Create(FPrinter);
  FValueSize := TGmValueSize.Create;
  FValueRect := TGmValueRect.Create;
  FPaperSize := A4;
  FOrientation := gmPortrait;
  FPagesPerSheet := gmOnePage;
  FResourceTable.CustomMemoList.OnNeedRichEdit := NeedRichEdit;
  FMargins.OnChange := PageMarginsChanged;
end;

destructor TGmPageList.Destroy;
begin
  Clear;
  FResourceTable.Free;
  FCanvas.Free;
  FFooter.Free;
  FHeader.Free;
  FMargins.Free;
  FPrinter.Free;
  FValueSize.Free;
  FValueRect.Free;
  inherited Destroy;
end;

function TGmPageList.AddObject(AObject: TGmBaseObject; AOrigin: TGmCoordsRelative): TGmBaseObject;
var
  APrintMargins: TGmRect;
begin
  case AOrigin of
    gmFromPrinterMargins:
    begin
      APrintMargins := FPrinter.PrinterInfo.MarginsInches[FOrientation];
      AObject.OffsetObject(APrintMargins.Left,
                           APrintMargins.Top,
                           gmInches);

    end;
    gmFromUserMargins:
    begin
      AObject.OffsetObject(Margins.Left.AsInches,
                           Margins.Top.AsInches,
                           gmInches);
    end;
    gmFromHeaderLine:
    begin
      AObject.OffsetObject(Margins.Left.AsInches,
                           Margins.Top.AsInches + FHeader.Height[gmInches],
                           gmInches);
    end;
  end;
  Result := Page[FCurrentPage].AddObject(AObject);
  if (AObject is TGmVisibleObject) then
    (Result as TGmVisibleObject).OnLevelChange := ChangeObjectLevel;
end;

function TGmPageList.AddPage: TGmPage;
begin
  Result := InsertPage(-1);
end;

function TGmPageList.InsertPage(index: integer): TGmPage;
begin
  Result := TGmPage.Create(Self);
  Result.Orientation := FOrientation;
  InitPaperSize;
  Result.SetPageSize(FPaperSizeInch.Width, FPaperSizeInch.Height);
  Result.OnChange := PageChanged;
  Result.OnChangeOrientation := PageChanged;
  if index = -1 then
    Add(Result)
  else
    Insert(index, Result);
  PageCountChanged(Self);
  PageChanged(Self);
  CurrentPage := Count;
  if Assigned(FOnNewPage) then FOnNewPage(Self);
end;

function TGmPageList.AvailablePageRect: TGmValueRect;
var
  APage: TGmPage;
begin
  Result := FValueRect;
  APage := Page[CurrentPage];
  if Margins.UsePrinterMargins then
  begin
    Result.Left.AsInches   := FPrinter.PrinterInfo.MarginsInches[APage.Orientation].Left;
    Result.Top.AsInches    := FPrinter.PrinterInfo.MarginsInches[APage.Orientation].Top + FHeader.Height[gmInches];
    Result.Right.AsInches  := APage.PageSize[gmInches].Width - FPrinter.PrinterInfo.MarginsInches[APage.Orientation].Right;
    Result.Bottom.AsInches := APage.PageSize[gmInches].Height - (FPrinter.PrinterInfo.MarginsInches[APage.Orientation].Bottom + FFooter.Height[gmInches]);
  end
  else
  begin
    Result.Left.AsInches   := FMargins.Left.AsInches;
    Result.Top.AsInches    := FMargins.Top.AsInches + FHeader.Height[gmInches];
    Result.Right.AsInches  := APage.PageSize[gmInches].Width - FMargins.Right.AsInches;
    Result.Bottom.AsInches := APage.PageSize[gmInches].Height - (FMargins.Bottom.AsInches + FFooter.Height[gmInches]);
  end;
end;

function TGmPageList.FooterRect: TGmValueRect;
var
  APage: TGmPage;
begin
  Result := FValueRect;
  APage := Page[CurrentPage];
  Result.Left.AsInches   := FMargins.Left.AsInches;
  Result.Bottom.AsInches := APage.PageSize[gmInches].Height - FMargins.Bottom.AsInches;
  Result.Right.AsInches  := APage.PageSize[gmInches].Width - FMargins.Right.AsInches;
  Result.Top.AsInches    := Result.Bottom.AsInches - FFooter.Height[gmInches];
end;

function TGmPageList.HeaderRect: TGmValueRect;
var
  APage: TGmPage;
begin
  Result := FValueRect;
  APage := Page[CurrentPage];
  Result.Left.AsInches   := FMargins.Left.AsInches;
  Result.Top.AsInches    := FMargins.Top.AsInches;
  Result.Right.AsInches  := APage.PageSize[gmInches].Width - FMargins.Right.AsInches;
  Result.Bottom.AsInches := FMargins.Top.AsInches + FHeader.Height[gmInches];
end;

procedure TGmPageList.BeginUpdate;
begin