gmpagelist.pas

GmPrintSuite 2.96.7] a

  Inc(FUpdateCount);
end;

procedure TGmPageList.ClearPages(const FreeAll: Boolean = False; const FreeResources: Boolean = True);
begin
  Clear;
  if FreeResources then
    FResourceTable.Clear;
  if not FreeAll then
  begin
    FCurrentPage := 1;
    AddPage;
  end;
  if Assigned(FOnClear) then FOnClear(Self);
end;

procedure TGmPageList.DeletePage(index: integer);
begin
  if (index <0) or (index > Count-1) then Exit;
  if (index = Count-1) then Dec(FCurrentPage);
  Delete(index);
  if FCurrentPage = 0 then
  begin
    FCurrentPage := 1;
    AddPage;
  end;
  PageCountChanged(Self);
  PageChanged(Self);
end;

procedure TGmPageList.EndUpdate;
begin
  if FUpdateCount > 0 then
  begin
    Dec(FUpdateCount);
    if FUpdateCount = 0 then
    begin
      PageCountChanged(Self);
      PageChanged(Self);
    end;
  end;
end;

procedure TGmPageList.FindText(AText: string; CaseSensative: Boolean; AList: TList);

  function ObjectContainsText(AObject: TGmTextObject; AText: string; CaseSensative: Boolean): Boolean;
  begin
    if CaseSensative then
      Result := Pos(AText, AObject.Caption) <> 0
    else
      Result := Pos(LowerCase(AText), LowerCase(AObject.Caption)) <> 0
  end;

var
  ICount: Integer;
  IObjCount: integer;
  APage: TGmPage;
  AObject: TGmBaseObject;
begin
  // find any TGmTextObjects which exist in the TGmPreview and add them to the
  // AList list paramater...
  for ICount := 1 to Count do    // Iterate
  begin
    APage := Page[ICount];
    for IObjCount := 1 to APage.Count do    // Iterate
    begin
      AObject := APage.GmObject[IObjCount];
      if (AObject is TGmTextObject) or (AObject is TGmTextBoxObject) then
      begin
        if ObjectContainsText((AObject as TGmTextObject), AText, CaseSensative) then
        begin
          AList.Add(AObject);
        end;
      end;
    end;
  end;
end;

procedure TGmPageList.LoadFromStream(Stream: TStream);
var
  AValues: TGmValueList;
  AVersion: Extended;
  ICount,
  NumPages: integer;
  LoadStream: Boolean;
begin
  AValues := TGmValueList.Create;
  try
    AValues.LoadFromStream(Stream);
    LoadStream := True;
    AVersion              := AValues.ReadExtValue(C_V, 0);
    if Assigned(FBeforeLoad) then FBeforeLoad(Self, AVersion, LoadStream);
    if not LoadStream then Exit;
    FOrientation          := TGmOrientation(AValues.ReadIntValue(C_O, 0));
    FPaperSize            := StrToPaperSize(AValues.ReadStringValue(C_PS, 'A4'));
    FPaperSizeInch.Width  := AValues.ReadExtValue(C_PW, 8.26);
    FPaperSizeInch.Height := AValues.ReadExtValue(C_PH, 11.69);
    NumPages              := AValues.ReadIntValue(C_NP, 0);
  finally
    AValues.Free;
  end;
  FResourceTable.LoadFromStream(Stream);
  BeginUpdate;
  FHeader.LoadFromStream(Stream);
  FFooter.LoadFromStream(Stream);
  FMargins.LoadFromStream(Stream);
  ClearPages(True, False);
  for ICount := 1 to NumPages do
    AddPage.LoadFromStream(Stream);
  FCurrentPage := 1;
  EndUpdate;
end;

procedure TGmPageList.NeedRichEdit(Sender: TObject; var ARichEdit: TCustomMemo);
begin
  if Assigned(FOnNeedRichEdit) then FOnNeedRichEdit(Self, ARichEdit);
end;

procedure TGmPageList.Print;
begin
  PrintRange(1, Count);
end;

procedure TGmPageList.PrintPages(Pages: array of integer);
var
  ICount: integer;
  APageNum: integer;
  PpiX: integer;
  PpiY: integer;
  ClipRect: TRect;
  ClipRgn: HRGN;
begin
  FPrinter.Orientation := Page[Pages[0]].Orientation;
  FPrinter.PagesPerSheet := FPagesPerSheet;
  FPrinter.PrinterPaperSize := FPaperSize;
  FPrinter.BeginDoc('');
  if (FPrinter.Aborted) or (not FPrinter.Printing) then Exit;
  for ICount := 0 to High(Pages) do
  begin
    APageNum := Pages[ICount];
    PpiX := FPrinter.PrinterInfo.PpiX;
    PpiY := FPrinter.PrinterInfo.PpiY;

    if FMargins.ClipMargins then
    begin
      // clip the margins...
      ClipRect.Left   := FMargins.Left.AsPixels[PpiX];
      ClipRect.Top    := FMargins.Left.AsPixels[PpiY];
      ClipRect.Right  := Round((Page[APageNum].PageSize[gmInches].Width - FMargins.Right.AsInches) * PpiX);
      ClipRect.Bottom := Round((Page[APageNum].PageSize[gmInches].Height - FMargins.Bottom.AsInches) * PpiY);
    end
    else
    begin
      // Clip to the page...
      ClipRect.Left   := 0;
      ClipRect.Top    := 0;
      ClipRect.Right  := Round(Page[APageNum].PageSize[gmInches].Width * PpiX);
      ClipRect.Bottom := Round(Page[APageNum].PageSize[gmInches].Height * PpiY);
    end;
    ClipRgn := CreateRectRgnIndirect(ClipRect);
    try
      BeginPath(FPrinter.Canvas.Handle);
      with ClipRect do
        FPrinter.Canvas.Rectangle(Left, Top, Right, Bottom);
      EndPath(FPrinter.Canvas.Handle);
      ClipRgn := PathToRegion(FPrinter.Canvas.Handle);
      SelectClipRgn(FPrinter.Canvas.Handle, ClipRgn);
    finally
      DeleteObject(ClipRgn);
    end;

    Page[APageNum].DrawToCanvas(FPrinter.Canvas, PpiX, PpiY, False);
    if ICount < High(Pages) then
    begin
      FOrientation := Page[ICount+1].Orientation;
      FPrinter.NewPage;
    end;
    DoPrintProgress(ICount+1, High(Pages)+1);
    if FPrinter.Aborted then Exit;
  end;
  FPrinter.EndDoc;
end;

procedure TGmPageList.PrintRange(AFromPage, AToPage: integer);
var
  APages: array of integer;
  ICount: integer;
begin
  SetLength(APages, MaxInt(AFromPage, AToPage)-MinInt(AFromPage, AToPage)+1);
  if AFromPage < AToPage then
    for ICount := 0 to High(APages) do
      APages[ICount] := AFromPage + ICount;

  if AFromPage >= AToPage then
    for ICount := 0 to High(APages) do
      APages[ICount] := AFromPage - ICount;
  PrintPages(APages);
end;

procedure TGmPageList.PrintToFile(AFileName: string);
begin
  // to do
end;

procedure TGmPageList.SaveToStream(Stream: TStream);
var
  AValues: TGmValueList;
  ICount: integer;
begin
  AValues := TGmValueList.Create;
  try
    AValues.WriteExtValue(C_V, GMPS_VERSION);
    AValues.WriteIntValue(C_O, Ord(FOrientation));
    AValues.WriteStringValue(C_PS, PaperSizeToStr(FPaperSize));
    AValues.WriteExtValue(C_PW, FPaperSizeInch.Width);
    AValues.WriteExtValue(C_PH, FPaperSizeInch.Height);
    AValues.WriteIntValue(C_NP, Count);
    AValues.SaveToStream(Stream);
  finally
    AValues.Free;
  end;
  FResourceTable.SaveToStream(Stream);
  FHeader.SaveToStream(Stream);
  FFooter.SaveToStream(Stream);
  FMargins.SaveToStream(Stream);
  for ICount := 1 to Count do
    Page[ICount].SaveToStream(Stream);
end;

procedure TGmPageList.SetPageSize(AWidth, AHeight: Extended; Measurement: TGmMeasurement);
var
  ICount: integer;
begin
  FPaperSizeInch.Width := ConvertValue(AWidth, Measurement, gmInches);
  FPaperSizeInch.Height := ConvertValue(AHeight, Measurement, gmInches);
  FPaperSize := Custom;
  for ICount := 1 to Count do
    Page[ICount].SetPageSize(FPaperSizeInch.Width, FPaperSizeInch.Height);
  if Assigned(FOnPaperSizeChanged) then FOnPaperSizeChanged(Self);
end;

procedure TGmPageList.UsePrinterPageSize;
var
  ASize: TGmSize;
begin
  BeginUpdate;
  PaperSize := FPrinter.PrinterPaperSize;
  if PaperSize = Custom then
  begin
    ASize := FPrinter.GetPaperDimensions(gmInches);
    SetPageSize(ASize.Width, ASize.Height, gmInches);
  end;
  Orientation := FPrinter.PrinterInfo.Orientation;
  EndUpdate;
end;

function TGmPageList.GetPage(index: integer): TGmPage;
begin
  Result := TGmPage(Items[index-1]);
end;

function TGmPageList.GetUpdating: Boolean;
begin
  Result := FUpdateCount > 0;
end;

procedure TGmPageList.ChangeObjectLevel(Sender: TObject; LevelChange: TGmArrangeObject);
var
  APage: TGmPage;
  ObjectIndex: integer;
begin
  APage := Page[FCurrentPage];
  ObjectIndex := APage.FObjects.IndexOf(Sender);
  if ObjectIndex = -1 then Exit;
  APage.FObjects.Extract(Sender);
  case LevelChange of
    gmToFront:  APage.FObjects.AddObject(TGmBaseObject(Sender));
    gmForward:  APage.FObjects.InsertObject(ObjectIndex+1, TGmBaseObject(Sender));
    gmBackword: APage.FObjects.InsertObject(ObjectIndex-1, TGmBaseObject(Sender));
    gmToBack:   APage.FObjects.InsertObject(0, TGmBaseObject(Sender));
  end;
  APage.Changed(Self);
end;

procedure TGmPageList.DoPrintProgress(Printed, Total: integer);
begin
  if Assigned(FOnPrintProgress) then FOnPrintProgress(Self, Printed, Total);
end;

procedure TGmPageList.InitPaperSize;
begin
  if FPaperSize = Custom then Exit;
  FPaperSizeInch := GetPaperSizeInch(FPaperSize);
  if FOrientation = gmLandscape then
    SwapExtValues(FPaperSizeInch.Height, FPaperSizeInch.Width);
end;

procedure TGmPageList.HeaderFooterChanged(Sender: TObject);
begin
  if FUpdateCount > 0 then Exit;
  
  if Assigned(FOnHeaderFooterChanged) then FOnHeaderFooterChanged(Self);
end;

procedure TGmPageList.PageChanged(Sender: TObject);
begin
  if FUpdateCount > 0 then Exit;
  if Assigned(FOnPageChanged) then FOnPageChanged(Self);
end;

procedure TGmPageList.PageCountChanged(Sender: TObject);
begin
  if FUpdateCount > 0 then Exit;
  if Assigned(FOnPageCountChanged) then FOnPageCountChanged(Self);
end;

procedure TGmPageList.PageMarginsChanged(Sender: TObject);
begin
  if FUpdateCount > 0 then Exit;
  if Assigned(FOnPageMarginsChanged) then FOnPageMarginsChanged(Self);
end;

procedure TGmPageList.SetCurrentPage(Value: integer);
begin
  if Value = FCurrentPage then Exit;
  if (Value < 1) or (Value > Count) then Exit;
  if Assigned(FOnPageNumChanging) then FOnPageNumChanging(Self);
  FCurrentPage := Value;
  if Assigned(FOnPageNumChanged) then FOnPageNumChanged(Self);
end;

procedure TGmPageList.SetOrientation(Value: TGmOrientation);
var
  ICount: integer;
begin
  BeginUpdate;
  try
    for ICount := 1 to Count do
      Page[ICount].Orientation := Value;
    FOrientation := Value;
    FPaperSizeInch := Page[1].PageSize[gmInches];
  finally
    EndUpdate;
    if Assigned(FOnOrientationChanged) then FOnOrientationChanged(Self);
  end;
end;

procedure TGmPageList.SetPage(index: integer; APage: TGmPage);
begin
  Items[index-1] := APage;
end;

procedure TGmPageList.SetPaperSize(Value: TGmPaperSize);
var
  ICount: integer;
begin
  if FPaperSize = Value then Exit;
  BeginUpdate;
  try
    FPaperSize := Value;
    InitPaperSize;
    for ICount := 1 to Count do
      Page[ICount].SetPageSize(FPaperSizeInch.Width, FPaperSizeInch.Height);
  finally
    EndUpdate;
  end;
  if Assigned(FOnPaperSizeChanged) then FOnPaperSizeChanged(Self);
end;

end.