gridu.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit GridU;

// Please see chapter 'Create Table from Database' in the PDF manual

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables, WPRTEDefs, WPCTRMemo, WPCTRRich, ExtCtrls,
  WPUtil, WPPrvFrm, WPObj_Image, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    WPRichText1: TWPRichText;
    Table1: TTable;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    WPPreviewDlg1: TWPPreviewDlg;
    ProgressBar1: TProgressBar;
    RowBreak: TCheckBox;
    Button3: TButton;
    StressTest: TCheckBox;
    LoadBlobAsANSI: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure LoadBlobAsANSIClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure LoadFromDataSet(Data: TDataSet; aName: string; LoadBlobAsANSI: Boolean);
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
  WPPreviewDlg1.Execute;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Table1.Active := FALSE;
  Table1.DatabaseName := 'DBDEMOS';
  Table1.TableName := 'BIOLIFE.DB';
  Table1.Open;
  LoadFromDataSet(Table1, 'Biolife Demo Database - listed with WPTools 5', LoadBlobAsANSI.Checked);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Table1.Active := FALSE;
    Table1.DatabaseName := ExtractFilePath(
      ExtractFilePath(OpenDialog1.FileName));
    Table1.TableName := ExtractFileName(
      ExtractFileName(OpenDialog1.FileName));
    Table1.Open;
    LoadFromDataSet(Table1, OpenDialog1.FileName, LoadBlobAsANSI.Checked);
  end;
end;

procedure TForm1.LoadFromDataSet(Data: TDataSet; aName: string; LoadBlobAsANSI: Boolean);
var i, a, a_max, RowNr: Integer;
  table, cell, row: TParagraph;
  b, DisableImages: Boolean;
  obj: TWPTextObj;
  wpobj: TWPObject;
  bit: TBitmap;
  rowstyle: TWPTableRowStyle;
  tim: Cardinal;
  stream: TStream;
begin
  WPRichText1.Clear;

  Caption := 'loading... - press ESCAPE to abort';
  tim := GetTickCount;
  DisableImages := FALSE;
  try

    WPRichText1.EditOptions := [];

  // Set Page Size
    WPRichText1.Header.PageSize := wp_DinA4;
    WPRichText1.Header.LeftMargin := WPCentimeterToTwips(2);
    WPRichText1.Header.RightMargin := WPCentimeterToTwips(1);
    WPRichText1.Header.TopMargin := WPCentimeterToTwips(1.5);
    WPRichText1.Header.BottomMargin := WPCentimeterToTwips(1.5);
    WPRichText1.Header.Landscape := TRUE;
    // WPRichText1.WordWrap := TRUE;

  // Create Footer
    WPRichText1.ActiveText := WPRichText1.HeaderFooter.Get(wpIsFooter, wpraOnAllPages);
    WPRichText1.InputString(aName + #9);
    WPRichText1.InputTextField(wpoPageNumber);
    WPRichText1.ASet(WPAT_BorderFlags, WPBRD_DRAW_Top);
    WPRichText1.SetTabPos(MaxInt, tkRight);


    WPRichText1.ActiveText := WPRichText1.BodyText;

    RowNr := 0;

    if StressTest.Checked then
    begin a_max := 100;
      ProgressBar1.Visible := TRUE;
    end else
    begin
      a_max := 1;
      ProgressBar1.Visible := FALSE;
    end;

  // Boolean to alternate the background
    b := FALSE;

  // Add all rows to this table
    table := WPRichText1.ActiveText.CreateTable(nil);

    table.ASet(WPAT_BorderFlags, WPBRD_DRAW_All4);

  // now create the rows, a_max is used for stresstest
    for a := 1 to a_max do
    begin
      ProgressBar1.Position := a;
      ProgressBar1.Update;

    // Start at the beginnig of database
      Data.First;

    // Repeat for all data rows
      repeat
        inc(RowNr);
        rowstyle := table.CreateRow(nil, true);
        if rowstyle <> nil then
        begin
          b := not b;
          rowstyle.ASetColor(WPAT_BGColor, clBlue);
          rowstyle.ASet(WPAT_ShadingValue, 30);

        // Create first Column with numbers
          cell := rowstyle.InputCell;
          cell.ASet(WPAT_BorderFlags, WPBRD_DRAW_Right);
          cell.ASet(WPAT_COLWIDTH, WPCentimeterToTwips(1));
          cell.SetText(IntToStr(RowNr));

        // Make sure every other row is *not* shaded:
          if b then
          begin
            rowstyle.ADel(WPAT_BGColor);
            rowstyle.ADel(WPAT_ShadingValue);
          end;
          rowstyle.ASet(WPAT_IndentRight, 72);

          for i := 0 to Data.Fields.Count - 1 do
          begin
            cell := rowstyle.InputCell;
            if not DisableImages and (Data.Fields[i] is TGraphicField) then
            begin
              bit := TBitmap.Create;
              try
                wpobj := nil;
                try
                  bit.Assign(Data.Fields[i]);
                  wpobj := TWPOImage.CreateImage(WPRichText1.Memo.RTFData, bit);
                  obj := TWPTextObj.Create;
                  cell.Insert(0, obj);
                  obj.ObjRef := wpobj;
                  obj.ObjType := wpobjImage;
                  obj.Width := wpobj.ContentsWidth div 3;
                  obj.Height := wpobj.ContentsHeight div 3;
                except
                  DisableImages := TRUE;
                  FreeAndNil(wpobj);
                end;
              finally
                FreeAndNil(bit);
              end;
            end
            else if Data.Fields[i] is TBlobField then
            begin
              if LoadBlobAsANSI then
              begin
            // The simple method which loads text into one paragraph
                cell.ASet(WPAT_CharFontSize, 600);
                cell.SetText(Copy(Data.Fields[i].AsString, 1, 400) + '...');
              end else
              begin
            // the "difficult" method which also loads formatted text
                stream := TBlobStream.Create(Data.Fields[i] as TBlobField, bmRead);
                try
                  cell.LoadFromStream(stream, 'AUTO', '', [wploadpar_ClearShading]);
                finally
                  stream.Free;
                end;
              end;
            end
            else cell.SetText(Data.Fields[i].AsString);
            cell.ASet(WPAT_BorderFlags, WPBRD_DRAW_Bottom);
          end;
        // Create the cells
          row := table.EndRow(rowstyle);
          if not RowBreak.Checked then
            row.ASet(WPAT_ParKeep, 1);

        // Allow ESCAPE


          if (GetAsyncKeyState(VK_ESCAPE) shr 15) <> 0 then
          begin
            if MessageBox(Handle, 'Abort loading of data ?', 'ESCAPE',
              MB_YESNO) = IDYES then exit;
          end;
        end;

        Data.Next;
      until Data.EOF;
    end; // for a

  finally
    WPRichText1.Refresh;
    Caption := Format('WPTools5: Created %d rows in %.02f sec', [RowNr, (GetTickCount - tim) / 1000]);
  end;
end;



procedure TForm1.LoadBlobAsANSIClick(Sender: TObject);
begin
  // RowBreak usually works better since rows can be very long
  if not LoadBlobAsANSI.Checked then RowBreak.Checked := TRUE;
end;

end.