frmtestunt.pas

EAComps手工画报表 对写报表编辑器有一定的参考价值

unit frmTestUnt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ActnList, ImgList, DB, ADODB, Tabs, EAReportPmm,
  EAReportDrawGrid_Comp, EAReportPmmDefining_Lib, EAReportLabel_Comp,
  EAReportImage_Comp, EAReportLine_Comp, ExtCtrls;

type
  TfrmTest = class(TForm)
    ADOConn: TADOConnection;
    AdsTmp: TADODataSet;
    imgList: TImageList;
    ActList: TActionList;
    ActFile_Open: TAction;
    mmMain: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    scrollReport: TScrollBox;
    pnlShadow: TPanel;
    tabPages: TTabSet;
    dlgOpen: TOpenDialog;
    ActFile_Exit: TAction;
    ActFile_Print: TAction;
    ActFilePrint1: TMenuItem;
    N5: TMenuItem;
    ActView_100: TAction;
    ActView_Inc: TAction;
    ActView_Dec: TAction;
    N6: TMenuItem;
    B1: TMenuItem;
    S1: TMenuItem;
    Z1: TMenuItem;
    N7: TMenuItem;
    drReport: TEAReportPmm;
    ActFile_Preview: TAction;
    V1: TMenuItem;
    procedure ActFile_OpenExecute(Sender: TObject);
    procedure drReportButtonClick(Sender, ASelectedObj: TObject;
      AObjType: TEASelectedObjectType);
    procedure drReportDrawFillData(Sender, ADrawDataObj: TObject;
      AObjType: TEASelectedObjectType; ANeedRepaint: Boolean;
      var ADefaultDraw: Boolean);
    procedure drReportMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint);
    procedure scrollReportResize(Sender: TObject);
    procedure tabPagesChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure ActFile_ExitExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ActFile_PrintExecute(Sender: TObject);
    procedure ActView_100Execute(Sender: TObject);
    procedure ActView_IncExecute(Sender: TObject);
    procedure ActView_DecExecute(Sender: TObject);
    procedure ActFile_PreviewExecute(Sender: TObject);
  private
    procedure InitData;
    procedure InitReport;
    function GetConnectionStr: string;

    procedure SetReportScale(AScale: Integer);
  public
    { Public declarations }
  end;

var
  frmTest: TfrmTest;

implementation
uses
  EASysUtils;
{$R *.dfm}

procedure TfrmTest.ActFile_OpenExecute(Sender: TObject);
const
  cSTitleStr = 'EAReportPmm';
var
  I: Integer;
begin
  if not dlgOpen.Execute then
    Exit;

  drReport.Store.StopStore := True;
  drReport.LoadFromFile(dlgOpen.FileName);
  drReport.Store.Clear;

  tabPages.Tabs.BeginUpdate;
  tabPages.Tabs.Clear;

  for I := 0 to drReport.Pages.Count - 1 do
    tabPages.Tabs.Add(drReport.Pages[I].Name);
  if drReport.Pages.Count > 0 then
  begin
    tabPages.TabIndex := drReport.PageIndex;
  end
  else begin
    drReport.Pages.Add('第 1 页');
  end;

  tabPages.Tabs.EndUpdate;
  Self.Caption := cSTitleStr + '[' + dlgOpen.FileName + ']';

  InitReport;
end;

procedure TfrmTest.drReportButtonClick(Sender, ASelectedObj: TObject;
  AObjType: TEASelectedObjectType);
begin
  if AObjType = esotDrawGridCell then
    if TEAReportDrawGridCell(ASelectedObj).CellType = egctButton then
      ShowMessage('click me is ok!!!');
end;

procedure TfrmTest.drReportDrawFillData(Sender, ADrawDataObj: TObject;
  AObjType: TEASelectedObjectType; ANeedRepaint: Boolean;
  var ADefaultDraw: Boolean);
var
  vCell: TEAReportDrawGridCell;
  I, N: Integer;
begin
  if not ANeedRepaint then
    Exit;
  if AObjType = esotDrawGridCell then
  begin
    vCell := TEAReportDrawGridCell(ADrawDataObj);
    if vCell.CellType = egctStaticGrid then
    begin
      with AdsTmp do
      begin
        Active := False;
        CommandText := 'SELECT SDate,SNumber,SUnitPrice,SPurchaser,SMoneySove,'
          + 'SExplain FROM ReportUserInfo';
        Active := True;
        N := 0;
        vCell.StaticGrid.RecordCount := RecordCount;
        while not Eof do
        begin
          for I := 0 to 5 do
            vCell.StaticGrid.Cells[N, I] := Fields[I].AsString;
          Next;
          Inc(N);
        end;
        Active := False;
      end;
    end;
  end;
end;

procedure TfrmTest.drReportMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint);
begin
  with scrollReport.VertScrollBar do
  begin
    if WheelDelta > 0 then
      Position := Position - 16
    else
      Position := Position + 16;
  end;
end;

procedure TfrmTest.scrollReportResize(Sender: TObject);
var
  vLeft: Integer;
begin
  scrollReport.VertScrollBar.Range := drReport.Height + 40;
  scrollReport.HorzScrollBar.Range := drReport.Width + 40;
  vLeft := Trunc((scrollReport.ClientWidth - drReport.Width) / 2);
  if vLeft < 20 then
    vLeft := 20;
  drReport.Left := vLeft;
  pnlShadow.SetBounds(vLeft + 2, drReport.Top + 2, drReport.Width,
    drReport.Height);
end;

procedure TfrmTest.tabPagesChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  drReport.HideEditor;
  drReport.PageIndex := NewTab;
end;

procedure TfrmTest.ActFile_ExitExecute(Sender: TObject);
begin
  Close;
end;

function TfrmTest.GetConnectionStr: string;
begin
  Result := 'Provider=Microsoft.Jet.OLEDB.4.0;'
    + 'Data Source=' + ea.Files.AppPath + 'EAReportPmmTest.mdb;'
    + 'Persist Security Info=False';
end;

procedure TfrmTest.InitData;
begin
  ADOConn.ConnectionString := GetConnectionStr;
  ADOConn.Connected := True;
end;

procedure TfrmTest.FormCreate(Sender: TObject);
begin
  InitData;
end;

procedure TfrmTest.InitReport;
var
  vPage: TEAPage;
  I, N: Integer;
  vGrid: TEAReportDrawGrid;
  vLabel: TEAReportLabel;
  vImage: TEAReportImage;
  vLine: TEAReportLine;
begin
  drReport.FourCorner.Visible := False;
  drReport.Options := [eroCanSelect];

  for I := 0 to drReport.Pages.Count - 1 do
  begin
    vPage := drReport.Pages[I];
    for N := 0 to vPage.Count - 1 do
    begin
      if vPage.Objects[N] is TEAReportDrawGrid then
      begin
        vGrid := TEAReportDrawGrid(vPage.Objects[N]);
        vGrid.ShowVisibleCell := False;
        vGrid.Options := [erdoCanSelect, erdoCanEdit];
      end
      else if vPage.Objects[N] is TEAReportLabel then
      begin
        vLabel := TEAReportLabel(vPage.Objects[N]);
        vLabel.ShowFrame := False;
        vLabel.Options := [];
        vLabel.Transparent := True;
      end
      else if vPage.Objects[N] is TEAReportImage then
      begin
        vImage := TEAReportImage(vPage.Objects[N]);
        vImage.ShowFrame := False;
        vImage.Options := [];
      end
      else if vPage.Objects[N] is TEAReportLine then
      begin
        vLine := TEAReportLine(vPage.Objects[N]);
        vLine.Options := [];
      end
    end;
  end;
end;

procedure TfrmTest.ActFile_PrintExecute(Sender: TObject);
begin
  drReport.Print;
end;

procedure TfrmTest.ActView_100Execute(Sender: TObject);
begin
  SetReportScale(100);
end;

procedure TfrmTest.ActView_IncExecute(Sender: TObject);
begin
  SetReportScale(drReport.ViewScale + 25);
end;

procedure TfrmTest.ActView_DecExecute(Sender: TObject);
begin
  SetReportScale(drReport.ViewScale - 25);
end;

procedure TfrmTest.SetReportScale(AScale: Integer);
var
  vLeft: Integer;
begin
  drReport.ViewScale := AScale;
  drReport.SetBounds(drReport.Left, drReport.Top,
    800 * AScale div 100,
    1024 * AScale div 100);

  scrollReport.VertScrollBar.Range := drReport.Height + 40;
  scrollReport.HorzScrollBar.Range := drReport.Width + 40;
  vLeft := Trunc((scrollReport.ClientWidth - drReport.Width) / 2);
  if vLeft < 20 then
    vLeft := 20;
  drReport.Left := vLeft;
  pnlShadow.SetBounds(vLeft + 2, drReport.Top + 2, drReport.Width,
    drReport.Height);
end;

procedure TfrmTest.ActFile_PreviewExecute(Sender: TObject);
begin
  drReport.Preview;
end;

end.