rm_pwwgrid.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{          Report Machine v2.0            }
{             wwdbgrid report             }
{                                         }
{*****************************************}

unit RM_PwwGrid;

interface

{$I RM.inc}
{$IFDEF InfoPower}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Stdctrls,
  Printers, DB, Wwdbigrd, Wwdbgrid, RM_Class, RM_dbset, RM_View, RM_Pars,
  RM_wwrtf, RM_FormReport;

type
  TRMwwGridReport = class(TComponent) // fake component
  end;

 { TRMPrintwwSpinEdit }
  TRMPrintwwSpinEdit = class(TRMPrintEdit)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintwwDBCheckBox }
  TRMPrintwwDBCheckBox = class(TRMPrintCheckBox)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

 { TRMPrintwwRichEdit }
  TRMPrintwwRichEdit = class(TRMFormReportObject)
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

  { TRMPrintwwDBGrid }
  TRMPrintwwDBGrid = class(TRMFormReportObject)
  private
    FDBGrid: TwwCustomDBGrid;
    procedure OnBeforePrintBandEvent(Band: TRMBand; var PrintBand: Boolean);
  public
    procedure OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
      Control: TControl; var t: TRMView); override;
  end;

{$ENDIF}
implementation

{$IFDEF InfoPower}
uses Wwcommon, wwriched, wwdbedit, wwdblook, wwcheckbox, wwdbdatetimepicker,
  RM_Utils;

type
  THackwwDBGrid = class(TwwDBGrid)
  end;

  THackFormReport = class(TRMFormReport)
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPrintwwSpinEdit}

procedure TRMPrintwwSpinEdit.OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
  Control: TControl; var t: TRMView);
var
  ds: TDataSource;
  dataset: TDataSet;
begin
  inherited;
  if Control is TwwDBCustomEdit then
  begin
    try
      ds := TwwDBCustomEdit(Control).DataSource;
      t.Memo.Text := Format('[%s.%s."%s"]', [ds.DataSet.Owner.Name, ds.DataSet.Name, TwwDBCustomEdit(Control).DataField]);
    except
    end;
  end
  else if Control is TwwDBCustomLookupCombo then
  begin
    try
      ds := TwwDBCustomLookupCombo(Control).DataSource;
      if ds <> nil then
        t.Memo.Text := Format('[%s.%s."%s"]', [ds.DataSet.Owner.Name, ds.DataSet.Name, TwwDBCustomLookupCombo(Control).DataField])
      else
      begin
        dataset := TwwDBCustomLookupCombo(Control).LookupTable;
        t.Memo.Text := Format('[%s.%s."%s"]', [dataset.Owner.Name, dataset.Name,
          RMGetOneField(TwwDBCustomLookupCombo(Control).LookupField)]);
      end;
    except
    end;
  end
  else if Control is TwwDBCustomDateTimePicker then
  begin
    try
      ds := TwwDBCustomDateTimePicker(Control).DataSource;
      t.Memo.Text := Format('[%s.%s."%s"]', [ds.DataSet.Owner.Name, ds.DataSet.Name,
        TwwDBCustomDateTimePicker(Control).DataField]);
    except
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMPrintwwDBCheckBox.OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
  Control: TControl; var t: TRMView);
var
  ds: TDataSource;
begin
  inherited;
  try
    ds := TwwDBCustomCheckBox(Control).DataSource;
    t.Memo.Text := Format('[%s.%s."%s"]', [ds.DataSet.Owner.Name, ds.DataSet.Name, TwwDBCustomCheckBox(Control).DataField]);
  except
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPrintwwRichEdit}

procedure TRMPrintwwRichEdit.OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
  Control: TControl; var t: TRMView);
var
  ds: TDataSource;
begin
  t := RMCreateObject(gtAddin, 'TRMwwRichView');
  t.CreateUniqueName;
  t.x := Control.Left + THackFormReport(aFormReport).OffsX;
  t.y := Control.Top + THackFormReport(aFormReport).OffsY;
  t.dx := Control.Width + 2;
  t.dy := Control.Height + 2;
  if (Control is TwwDBRichEdit) and (TwwDBRichEdit(Control).DataSource <> nil) and
    (TwwDBRichEdit(Control).DataField <> '') then
  begin
    try
      ds := TwwDBRichEdit(Control).DataSource;
      t.Memo.Text := Format('[%s.%s."%s"]', [ds.DataSet.Owner.Name, ds.DataSet.Name, TwwDBRichEdit(Control).DataField]);
    except
    end;
  end
  else
    TRMwwRichView(t).RichEdit.Lines.Assign(TwwCustomRichEdit(Control).Lines);
  if rmgoDrawBorder in aFormReport.ReportOptions then
    t.Prop['FrameTyp'] := $F
  else
  	t.Prop['FrameTyp'] := 0;

  Page.Objects.Add(t);
  if aFormReport.DrawOnPageFooter then
    aFormReport.ColumnFooterViews.Add(t)
  else
    aFormReport.PageHeaderViews.Add(t);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPrintwwDBGrid}

procedure TRMPrintwwDBGrid.OnBeforePrintBandEvent(Band: TRMBand; var PrintBand: Boolean);
var
  Bookmark: TBookmark;
  i: integer;
begin
  PrintBand := False;
  Bookmark := THackwwDBGrid(FDBGrid).DataSource.DataSet.GetBookmark;
  try
    for i := 1 to THackwwDBGrid(FDBGrid).SelectedList.Count do
    begin
      PrintBand := THackwwDBGrid(FDBGrid).DataSource.DataSet.CompareBookmarks(TBookmark(THackwwDBGrid(FDBGrid).SelectedList[I - 1]), Bookmark) = 0;
      if PrintBand then
        Break;
    end;
  finally
    THackwwDBGrid(FDBGrid).DataSource.DataSet.FreeBookmark(Bookmark);
  end;
end;

procedure TRMPrintwwDBGrid.OnGenerate_Object(aFormReport: TRMFormReport; Page: TRMPage;
  Control: TControl; var t: TRMView);
var
  liView: TRMView;
  i, tmpx, tmpx0, NextTop, DD, Y: Integer;
  liDBGrid: THackwwDBGrid;
  DSet: TDataSet;
  str: string;
  CTypes: TStrings;
  liPage: TRMPage;
  liPageNo, liNum, liGridTitleHeight: Integer;
  liFlagFirstColumn: Boolean;

  procedure DrawDoubleFrameBottom(aView: TRMView; aList: TList);
  var
    t: TRMMemoView;
  begin
    if rmgoDoubleFrame in aFormReport.ReportOptions then
    begin
      t := TRMMemoView(RMCreateObject(gtMemo, ''));
      t.CreateUniqueName;
      t.LeftFrame.Visible := False;
      t.TopFrame.Visible := True;
      t.RightFrame.Visible := False;
      t.BottomFrame.Visible := False;
      t.TopFrame.Width := 2;
      t.Gapx := 0; t.GapY := 0;
      t.SetBounds(aView.x, aFormReport.GridTop + aFormReport.GridHeight, aView.dx, 2);
      t.PStretched := rmgoStretch in aFormReport.ReportOptions;
      liPage.Objects.Add(t);
      aList.Add(t);
    end;
  end;

  procedure MakeOneHeader(aIndex: Integer);
  begin
    Inc(Y);
    liView := TRMMemoView(RMCreateObject(gtMemo, ''));
    liView.CreateUniqueName;
    str := DSet.Fields[aIndex].DisplayLabel;
    while Pos('~', str) <> 0 do
      str[Pos('~', str)] := #13;
    liView.Memo.Text := str;
    liView.x := tmpx;
    liView.y := NextTop;
    liView.dx := liDBGrid.ColWidths[Y + DD] + 1;
    liView.dy := liGridTitleHeight;
    aFormReport.AssignFont(TRMMemoView(liView), liDBGrid.TitleFont);
    TRMMemoView(liView).PLayout := rmtlCenter;
    case liDBGrid.TitleAlignment of
      taLeftJustify: TRMMemoView(liView).PAlignment := rmtaLeftJustify;
      taRightJustify: TRMMemoView(liView).PAlignment := rmtaRightJustify;
      taCenter: TRMMemoView(liView).PAlignment := rmtaCenterJustify;
    end;
    if rmgoUseColor in aFormReport.ReportOptions then
      liView.FillColor := liDBGrid.TitleColor;
    if (rmgoGridLines in aFormReport.ReportOptions) and (dgColLines in liDBGrid.Options) then
	    liView.Prop['FrameTyp'] := $F
  	else
  		liView.Prop['FrameTyp'] := 0;

    liPage.Objects.Add(liView);
    aFormReport.PageHeaderViews.Add(liView);
    tmpx := tmpx + liView.dx;

    if rmgoDoubleFrame in aFormReport.ReportOptions then
    begin
      if liFlagFirstColumn then
        liView.LeftFrame.Width := 2;
      liView.TopFrame.Width := 2;
    end;
    liFlagFirstColumn := False;
  end;

  procedure MakeOneDetail(aIndex: Integer);
  var
  	j: Integer;
  begin
    Inc(Y);
    str := '';
    if CTypes <> nil then
    begin
      for j := 1 to CTypes.Count do
      begin
        str := CTypes[j - 1];
        if Copy(str, 1, Pos(';', str) - 1) = DSet.Fields[aIndex].FieldName then
        begin
          System.Delete(str, 1, Pos(';', str));
          Break;
        end;
      end;
    end;

    if Uppercase(Copy(str, 1, Pos(';', str) - 1)) = 'BITMAP' then
    begin
      liView := TRMPictureView(RMCreateObject(gtPicture, ''));
      liView.Memo.Text := Format('[%s.%s."%s"]', [DSet.Owner.Name, DSet.Name, DSet.Fields[aIndex].FieldName]);