umakedoc.pas

PowerPdf 0.9 Full Source

    PRLabel6: TPRLabel;
    PRLabel7: TPRLabel;
    PRLabel9: TPRLabel;
    PRLabel5: TPRLabel;
    PRLabel8: TPRLabel;
    PRLabel10: TPRLabel;
    PRRect71: TPRRect;
    PRLabel11: TPRLabel;
    PRLabel1: TPRLabel;
    PRLabel22: TPRLabel;
    PRLabel23: TPRLabel;
    PRLabel24: TPRLabel;
    PRLabel25: TPRLabel;
    PRLabel26: TPRLabel;
    PRLabel27: TPRLabel;
    PRLabel28: TPRLabel;
    PRLabel29: TPRLabel;
    PRLabel30: TPRLabel;
    PRLabel31: TPRLabel;
    PRLabel32: TPRLabel;
    PRLabel33: TPRLabel;
    PRLabel34: TPRLabel;
    PRLabel35: TPRLabel;
    PRLabel36: TPRLabel;
    PRLabel21: TPRLabel;
    PRGridPanel1: TPRGridPanel;
    lblSectionNo: TPRLabel;
    lblSectionName: TPRLabel;
    PRText5: TPRText;
    PRText7: TPRText;
    PRText8: TPRText;
    PRText10: TPRText;
    PRText11: TPRText;
    TabSheet18: TTabSheet;
    PRPage6: TPRPage;
    PRLayoutPanel19: TPRLayoutPanel;
    PRRect77: TPRRect;
    PRRect78: TPRRect;
    PRRect79: TPRRect;
    PRRect80: TPRRect;
    PRText94: TPRText;
    PRText95: TPRText;
    PRText98: TPRText;
    PRText99: TPRText;
    PRText128: TPRText;
    PRText129: TPRText;
    PRText130: TPRText;
    PRText131: TPRText;
    PRText132: TPRText;
    PRText138: TPRText;
    PRText176: TPRText;
    PRText177: TPRText;
    PRText178: TPRText;
    PRLabel12: TPRLabel;
    PRLabel13: TPRLabel;
    PRLabel14: TPRLabel;
    PRLabel15: TPRLabel;
    PRText4: TPRText;
    PRText13: TPRText;
    PRLabel16: TPRLabel;
    PRLabel17: TPRLabel;
    TabSheet19: TTabSheet;
    PRPage18: TPRPage;
    PRLayoutPanel20: TPRLayoutPanel;
    PRRect81: TPRRect;
    PRRect82: TPRRect;
    PRRect83: TPRRect;
    PRRect84: TPRRect;
    PRLabel18: TPRLabel;
    PRText2_12: TPRText;
    PRText14: TPRText;
    PRText15: TPRText;
    PRText16: TPRText;
    PRText2_12_2: TPRText;
    TabSheet20: TTabSheet;
    PRPage19: TPRPage;
    PRLayoutPanel21: TPRLayoutPanel;
    PRRect85: TPRRect;
    PRRect86: TPRRect;
    PRRect87: TPRRect;
    PRRect88: TPRRect;
    PRLabel19: TPRLabel;
    PRText70: TPRText;
    PRText71: TPRText;
    PRText72: TPRText;
    PRText73: TPRText;
    PRText74: TPRText;
    PRText12: TPRText;
    PRText17: TPRText;
    PRLabel20: TPRLabel;
    PRLabel37: TPRLabel;
    PRText188: TPRText;
    PRText189: TPRText;
    PRLabel38: TPRLabel;
    PRLabel39: TPRLabel;
    PRText190: TPRText;
    PRText219: TPRText;
    PRLabel40: TPRLabel;
    PRLabel41: TPRLabel;
    PRLabel42: TPRLabel;
    PRLabel43: TPRLabel;
    PRText18: TPRText;
    PRLabel44: TPRLabel;
    PRLabel45: TPRLabel;
    PRText19: TPRText;
    PRLabel46: TPRLabel;
    PRLabel47: TPRLabel;
    PRText20: TPRText;
    PRLabel48: TPRLabel;
    PRLabel49: TPRLabel;
    PRText22: TPRText;
    PRLabel50: TPRLabel;
    PRLabel51: TPRLabel;
    PRText23: TPRText;
    PRLabel52: TPRLabel;
    PRLabel53: TPRLabel;
    PRText25: TPRText;
    PRLabel54: TPRLabel;
    PRLabel55: TPRLabel;
    PRText51: TPRText;
    PRLabel56: TPRLabel;
    PRLabel57: TPRLabel;
    PRText52: TPRText;
    PRText57: TPRText;
    PRLabel58: TPRLabel;
    PRLabel59: TPRLabel;
    PRText68: TPRText;
    PRText69: TPRText;
    PRText75: TPRText;
    PRLabel60: TPRLabel;
    PRLabel61: TPRLabel;
    PRLabel62: TPRLabel;
    PRLabel63: TPRLabel;
    PRLabel64: TPRLabel;
    PRLabel65: TPRLabel;
    PRLabel66: TPRLabel;
    PRLabel67: TPRLabel;
    PRLabel68: TPRLabel;
    PRLabel69: TPRLabel;
    PRText76: TPRText;
    PRText80: TPRText;
    PRText81: TPRText;
    PRText82: TPRText;
    PRText89: TPRText;
    PRLabel70: TPRLabel;
    PRLabel71: TPRLabel;
    procedure PRLayoutPanel2BeforePrint(Sender: TObject;
      ACanvas: TPRCanvas; Rect: TRect);
    procedure PRLayoutPanel2AfterPrint(Sender: TObject;
      ACanvas: TPRCanvas; Rect: TRect);
    procedure CreatePDF1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure PRLayoutPanelBeforePrint(Sender: TObject;
      ACanvas: TPRCanvas; Rect: TRect);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PRGridPanel1BeforePrintChild(Sender: TObject;
      ACanvas: TPRCanvas; ACol, ARow: Integer; Rect: TRect);
    procedure CoverPagePrintPage(Sender: TObject; ACanvas: TPRCanvas);
  private
    FCurrentOutline: array[0..5] of TPROutlineEntry;
    FContentsList: TList;
    FPos: integer;
    procedure CreateContentsList;
    function FindLink(AItem: TPRItem): TContentsElement;
  public
    { Public 愰尵 }
  end;

  TContentsElement = class(TObject)
  private
    FContentsIndex: string;
    FTitle: string;
    FData: TPdfDictionary;
    FTarget: TPRItem;
  public
    property ContentsIndex: string read FContentsIndex write FContentsIndex;
    property Title: string read FTitle write FTitle;
    property Data: TPdfDictionary read FData write FData;
    property Target: TPRItem read FTarget write FTarget;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.PRLayoutPanel2BeforePrint(Sender: TObject;
  ACanvas: TPRCanvas; Rect: TRect);
begin
  // change the horizontal scaling of th font.
  ACanvas.SetHorizontalScaling(80);
  PRLayoutPanelBeforePrint(Sender, ACanvas, Rect);
end;

procedure TForm1.PRLayoutPanel2AfterPrint(Sender: TObject;
  ACanvas: TPRCanvas; Rect: TRect);
begin
  // restore the horizontal scaling of th font.
  ACanvas.SetHorizontalScaling(100);
end;

procedure TForm1.CreateContentsList;
var
  APage: TPRPage;
  APanel: TPRPanel;
  AControl: TControl;
  i, j, k: integer;
  FChapterIndex: integer;
  FContentsElement: TContentsElement;
  S: string;
begin
  // clear the contents list.
  for i := FContentsList.Count - 1 downto 0 do
    TContentsElement(FContentsList.Items[i]).Free;

  // create new contents list.
  FChapterIndex := 0;
  for i := 0 to PageControl1.PageCount do
  begin
    APage := TPRPage(Self.FindComponent('PRPage' + IntToStr(i)));
    if (APage <> nil) and (APage.Controls[0] is TPRPanel) then
    begin
      APanel := TPRPanel(APage.Controls[0]);
      for j := 0 to APanel.ControlCount - 1 do
      begin
        AControl := APanel.Controls[j];
        if AControl.Tag = 2 then
        begin
          FContentsElement := TContentsElement.Create;
          with FContentsElement do
          begin
            if AControl is TPRText then
              Title := TPRText(AControl).Text
            else
            if AControl is TPRLabel then
              Title := TPRLabel(AControl).Caption
            else
              raise Exception.CreateFmt('invalid target control %s', [AControl.ClassName]);
            if (Title <> 'Contents') and (Title <> 'Copyright') then
            begin
              inc(FChapterIndex);
              FContentsList.Add(TContentsElement.Create);
              Title := 'Chapter' + IntToStr(FChapterIndex) + ' ' + Title;
              Target := TPRItem(AControl);
              FContentsList.Add(FContentsElement);
            end
            else
              FContentsElement.Free;
          end;
        end
        else
        if (AControl.Tag = 3) or (AControl.Tag = 4) then
        begin
          FContentsElement := TContentsElement.Create;
          with FContentsElement do
          begin
            if AControl is TPRText then
              S := TPRText(AControl).Text
            else
            if AControl is TPRLabel then
              S := TPRLabel(AControl).Caption
            else
              raise Exception.CreateFmt('invalid target control %s', [AControl.ClassName]);
            k := Pos(' ', S);
            if k < 1 then
              raise Exception.CreateFmt('invalid contents title text %s', [S]);
            ContentsIndex := Copy(S, 1, k);
            Title := Trim(Copy(S, k, Length(S) - k + 1));
            Target := TPRItem(AControl);
          end;
          FContentsList.Add(FContentsElement);
        end;
      end;
    end;
  end;
end;

procedure TForm1.CreatePDF1Click(Sender: TObject);
var
  APage: TPRPage;
  i: integer;
begin
  if not SaveDialog1.Execute then Exit;
  with PReport1 do
  begin
    FileName := SaveDialog1.FileName;
    BeginDoc;

    FCurrentOutline[0] := OutlineRoot;
    OutlineRoot.Opened := true;
    Print(CoverPage);

    CreateContentsList;

    // print index of contents.
    FPos := 0;
    while FPos < FContentsList.Count do
    begin
      Print(ContentsPage);
      PRText1Contents.Text := '';
      PRText1Contents.Tag := 0;
    end;

    for i := 2 to PageControl1.PageCount - 1 do
    begin
      APage := TPRPage(PageControl1.Pages[i].Controls[0]);
      if APage <> nil then
        Print(APage);
    end;
    EndDoc;

    for i := FContentsList.Count - 1 downto 0 do
      TContentsElement(FContentsList.Items[i]).Free;
    FContentsList.Clear;
  end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  ShowMessage(POWER_PDF_VERSION_STR + #13#10 + POWER_PDF_COPYRIGHT);
end;

procedure TForm1.PRLayoutPanelBeforePrint(Sender: TObject;
  ACanvas: TPRCanvas; Rect: TRect);
var
  FDestination: TPRDestination;
  i, j: integer;
  FLevel: integer;
  FControlList: TList;
  FPRText: TPRText;
  TmpYPos: integer;
  ItemIndex: integer;
  FTextWidth: Single;
  Element: TContentsElement;
begin
  // printting page number
  if PReport1.PageNumber > 1 then
    with ACanvas do
    begin
      SetFont('Times-Roman', 8);
      FTextWidth := TextWidth(IntToStr(PReport1.PageNumber - 1));
      TextOut((PageWidth - FTextWidth) / 2 + 3, 30, IntToStr(PReport1.PageNumber - 1));
    end;

  // sorting the Items of the page by Top property.
  FControlList := TList.Create;
  with (Sender as TPRPanel) do
  for i := 0 to ControlCount - 1 do
    if (Controls[i] is TPRText) and (Controls[i].Tag > 0) then
    begin
      TmpYPos := Controls[i].Top;
      ItemIndex := -1;
      for j := 0 to FControlList.Count - 1 do
        if TControl(FControlList[j]).Top > TmpYPos then
        begin
          ItemIndex := j;
          Break;
        end;
      if ItemIndex = -1 then
        FControlList.Add(Controls[i])
      else
        FControlList.Insert(ItemIndex, Controls[i]);
    end;

  for i := 0 to FControlList.Count - 1 do
    if TPRText(FControlList[i]).Tag > 0 then
    begin
      // getting outline level from the Tag property.
      FPRText := TPRText(FControlList[i]);
      FLevel := FPRText.Tag;
      if FCurrentOutline[FLevel - 1] <> nil then
      begin
        FCurrentOutline[FLevel] := FCurrentOutline[FLevel - 1].AddChild;
        with FCurrentOutline[FLevel] do
        begin
          if FLevel = 1 then
            Opened := true;
          Title := FPRText.Text;
          FDestination := PReport1.CreateDestination;
          Dest := FDestination;
        end;
        with FDestination do
        begin
          DestinationType := dtXYZ;
          Top := FPRText.Top;
          Left := FPRText.Left;
          Zoom := 0;
        end;

        // setting the destination object to the link-annotation.
        Element := FindLink(TPRText(FControlList[i]));
        if Element <> nil then
          Element.Data.AddItem('Dest', FDestination.Data.GetValue);
      end;
    end;

  FControlList.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FContentsList := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  for i := FContentsList.Count - 1 downto 0 do
    TContentsElement(FContentsList.Items[i]).Free;
  FContentsList.Free;
end;

procedure TForm1.PRGridPanel1BeforePrintChild(Sender: TObject;
  ACanvas: TPRCanvas; ACol, ARow: Integer; Rect: TRect);
begin
  if FPos < FContentsList.Count then
  with TContentsElement(FContentsList[FPos]) do
    begin
      if ContentsIndex = '' then
      begin
        lblSectionName.FontBold := true;
        lblSectionNo.FontSize := 12;
        lblSectionName.FontSize := 12;
        lblSectionName.Top := 0;
      end
      else
      begin
        lblSectionName.FontBold := false;
        lblSectionNo.FontSize := 11;
        lblSectionName.FontSize := 11;
        lblSectionNo.Top := 3;
        lblSectionName.Top := 3;
      end;
      lblSectionNo.Caption := ContentsIndex;
      lblSectionName.Caption := Title;
      with Rect do
        Data := ACanvas.PdfCanvas.Doc.CreateAnnotation(asLink,
            _PdfRect(Left, ACanvas.PageHeight - Top, Right, ACanvas.PageHeight - Bottom));
      with Data do
        AddItem('Border', TPdfArray.CreateNumArray(nil, [0, 0, 0]));
    end
  else
  begin
    lblSectionNo.Caption := '';
    lblSectionName.Caption := '';
  end;
  inc(FPos);
end;

procedure TForm1.CoverPagePrintPage(Sender: TObject; ACanvas: TPRCanvas);
begin
  with PReport1 do
  begin
    OpenAction := CreateDestination;
    OpenAction.DestinationType := dtXYZ;
  end;
end;

function TForm1.FindLink(AItem: TPRItem): TContentsElement;
var
  i: integer;
  Element: TContentsElement;
begin
  result := nil;
  for i := FContentsList.Count - 1 downto 0 do
  begin
    Element := TContentsElement(FContentsList.Items[i]);
    if Element.Target = AItem then result := Element;
  end;
end;

end.