creport.pas

Delphi报表设计器源代码

unit creport;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ReportControl, StdCtrls, Buttons, Menus, IniFiles, ExtCtrls,ComCtrls, Spin,  db,  ExtDlgs,about, ImgList;

type
  TCreportForm = class(TForm)
    MainMenu1: TMainMenu;
    T1: TMenuItem;
    FileOpen: TMenuItem;
    FileExit: TMenuItem;
    N1: TMenuItem;
    T2: TMenuItem;
    NewTable: TMenuItem;
    InsertLine: TMenuItem;
    AddLine: TMenuItem;
    DeleteLine: TMenuItem;
    N4: TMenuItem;
    CombineCells: TMenuItem;
    SplitCell: TMenuItem;
    N7: TMenuItem;
    FileSave: TMenuItem;
    OpenDialog1: TOpenDialog;
    N2: TMenuItem;
    AddCell: TMenuItem;
    InsertCell: TMenuItem;
    DeleteCell: TMenuItem;
    CellBorderLine: TMenuItem;
    CellFont: TMenuItem;
    CellDiagonalLine: TMenuItem;
    CellColor: TMenuItem;
    FontDialog1: TFontDialog;
    SaveDialog1: TSaveDialog;
    PrintIt: TMenuItem;
    VSplitCell: TMenuItem;
    MarginSetting: TMenuItem;
    N6: TMenuItem;
    PopupMenu1: TPopupMenu;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    file1: TMenuItem;
    FileClose: TMenuItem;
    N3: TMenuItem;
    N29: TMenuItem;
    N32: TMenuItem;
    N30: TMenuItem;
    ScrollBox1: TScrollBox;
    ReportControl1: TReportControl;
    Panel3: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton23: TSpeedButton;
    SpeedButton24: TSpeedButton;
    SpeedButton25: TSpeedButton;
    SpeedButton26: TSpeedButton;
    SpeedButton28: TSpeedButton;
    SpeedButton29: TSpeedButton;
    SpeedButton30: TSpeedButton;
    SpeedButton31: TSpeedButton;
    Panel1: TPanel;
    Panel2: TPanel;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    Bevel1: TBevel;
    Panel4: TPanel;
    Bevel2: TBevel;
    fontbox: TComboBox;
    fontsize: TComboBox;
    bold: TSpeedButton;
    italic: TSpeedButton;
    underline: TSpeedButton;
    left1: TSpeedButton;
    center1: TSpeedButton;
    right1: TSpeedButton;
    top1: TSpeedButton;
    medium1: TSpeedButton;
    bottom1: TSpeedButton;
    Bevel5: TBevel;
    SpeedButton8: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton9: TSpeedButton;
    Bevel9: TBevel;
    OpenPictureDialog1: TOpenPictureDialog;
    SpeedButton17: TSpeedButton;
    StatusBar1: TStatusBar;
    StrikeOut: TSpeedButton;
    ImageList1: TImageList;
    SpeedButton32: TSpeedButton;
    SpeedButton33: TSpeedButton;
    SpeedButton7: TSpeedButton;
    Bevel3: TBevel;
    Bevel4: TBevel;
    N401To4111: TMenuItem;
    N31: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    SpeedButton5: TSpeedButton;
    N25: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    Bevel7: TBevel;
    N26: TMenuItem;
    CellDispFormt: TComboBox;
    Lsum: TComboBox;
    ComboBox1: TComboBox;
    SpeedButton4: TSpeedButton;
    Bevel6: TBevel;
    Bevel8: TBevel;
    procedure FileOpen1(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FileExitClick(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure NewTableClick(Sender: TObject);
    procedure InsertLineClick(Sender: TObject);
    procedure AddLineClick(Sender: TObject);
    procedure CombineCellsClick(Sender: TObject);
    procedure SplitCellClick(Sender: TObject);
    //procedure CellPropClick(Sender: TObject);
    procedure DeleteLineClick(Sender: TObject);
    procedure AddCellClick(Sender: TObject);
    procedure InsertCellClick(Sender: TObject);
    procedure DeleteCellClick(Sender: TObject);
    procedure CellBorderLineClick(Sender: TObject);
    procedure CellDiagonalLineClick(Sender: TObject);
    procedure CellFontClick(Sender: TObject);
    procedure CellColorClick(Sender: TObject);
    procedure FileSaveClick(Sender: TObject);
    procedure PrintItClick(Sender: TObject);
    procedure VSplitCellClick(Sender: TObject);
    procedure MarginSettingClick(Sender: TObject);
    procedure UpdateOldies(thefile: string; sender: tobject);
    procedure RecentFile1(sender: tobject);
    procedure RecentFile2(sender: tobject);
    procedure RecentFile3(sender: tobject);
    procedure RecentFile4(sender: tobject);
    procedure RecentFile5(sender: tobject);
    procedure RecentFile6(sender: tobject);
    procedure RecentFile7(sender: tobject);
    procedure RecentFile8(sender: tobject);
    procedure RecentFile9(sender: tobject);
    procedure T1Click(Sender: TObject);
    procedure FileCloseClick(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure ScrollBox1Resize(Sender: TObject);
    procedure loadini;
    procedure SaveIni;
    procedure left1Click(Sender: TObject);
    procedure fontboxChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure fontsizeChange(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure ReportControl1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton7Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ReportControl1DragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure ReportControl1DragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure ComboBox1Change(Sender: TObject);
    procedure mn_medium1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N401To4111Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure CellDispFormtChange(Sender: TObject);
    procedure LsumChange(Sender: TObject);
  private
    IsFile:Boolean;  //是否有打开的报表
    FStream:TStream;
    
    dbarleft: integer;
    dbartop: integer;
    zoomxxx: INTEGER;
    Saved: boolean;//是否已经存盘
    procedure ListBoxDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

    function LFindComponent(Owner: TComponent; Name: string): TComponent;
    procedure LEnumComponents(F: TComponent);
    procedure RecentFile(Index:Integer);
  public
    FFile:String;
    procedure LoadFromFile(FileName:String);
    procedure LoadFromStream(Stream:TStream);
    procedure setbuttonClose; //设置相关场能不可用
  end;

const
  DefIni = 'EReport.ini';
implementation

uses NewDialog, Border, diagonal, Color, vsplit, margin, SxB;

{$R *.DFM}


procedure TCreportForm.SaveIni;
var
  IniFile: TIniFile;
  toolbar, fonts, statusbar, autosave: integer;
begin
  IniFile := TIniFile.create(defini);
  try
    inifile.writeinteger('其他', 'toolbar', toolbar);
    inifile.writeinteger('其他', 'statusbar', statusbar);
    inifile.writeinteger('其他', 'autosave', autosave);
    inifile.writeinteger('其他', 'fonts', fonts);
  finally
    IniFile.Free;
  end;
end;

procedure TCreportForm.loadini;
var
  IniFile: TIniFile;
  savetime, fonts, toolbar, statusbar, autosave: integer;
begin
  try
    IniFile := TIniFile.create(defini);
    toolbar := inifile.readinteger('其他', 'toolbar', 1);
    statusbar := inifile.readinteger('其他', 'statusbar', 1);
    autosave := inifile.readinteger('其他', 'autosave', 1);
    savetime := inifile.readinteger('其他', 'savetime', 120000);
    fonts := inifile.readinteger('其他', 'fonts', 1);
  finally
    IniFile.Free
  end;
end;

procedure TCreportForm.FormCreate(Sender: TObject);
var
  i, j: integer;
begin
  width := 800;
  Height := 550;
  Left := (Screen.Width - Width) div 2;
  Top  := (Screen.Height - Height) div 2;
  WindowState := wsMaximized;

  Saved := true; //未存盘标志     add　lzl

  dbarleft := 0;
  dbartop := 0;
  Caption := '[无报表]';
  loadini;
  SaveIni;
  fontbox.Items := screen.fonts;
  fontbox.ItemIndex := 1;
  fontsize.ItemIndex := 1;

  for i := 0 to fontbox.items.Count do
  begin
    if fontbox.Items[i] = '宋体' then
    begin
      fontbox.ItemIndex := i;
      break;
    end;
  end;
  zoomxxx := 100;
  if ParamCount >= 1 then
  begin
    LoadFromFile(ParamStr(1));
  end;
  ReportControl1.CalcWndSize;

  combobox1.Clear;
  for i := 0 to Screen.FormCount - 1 do
    for j := 0 to Screen.Forms[i].ComponentCount - 1 do
      if Screen.Forms[i].Components[j] is TDataSet then
      begin
        with TDataSet(Screen.Forms[i].Components[j]) do
          combobox1.Items.Add(Screen.Forms[i].Name + '.' + TDataSet(Screen.Forms[i].Components[j]).Name);
      end;

  for i := 0 to Screen.DataModuleCount - 1 do
    for j := 0 to Screen.DataModules[i].ComponentCount - 1 do
      if Screen.DataModules[i].Components[j] is TDataSet then
      begin
        with TDataSet(Screen.DataModules[i].Components[j]) do
          combobox1.Items.Add(Screen.DataModules[i].Name + '.' + TDataSet(Screen.DataModules[i].Components[j]).Name);
      end;

  for i := 0 to Screen.CustomFormCount - 1 do
    if (Screen.CustomForms[i].ClassName = 'TDataModuleForm') then
      for j := 0 to Screen.CustomForms[i].ComponentCount - 1 do
      begin
        if (Screen.CustomForms[i].Components[j] is TDataModule) then
          LEnumComponents(Screen.CustomForms[i].Components[j]);
      end;
end;

procedure TCreportForm.FileExitClick(Sender: TObject);
begin
  close;
end;


procedure TCreportForm.FileOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    LoadFromFile(OpenDialog1.Filename);
    updateOldies(OpenDialog1.Filename, sender);
    zoomxxx := 100;
    ShowWindow(ReportControl1.Handle, SW_HIDE);
    ReportControl1.ReportScale := zoomxxx;
    ScrollBox1Resize(Self);
    ShowWindow(ReportControl1.Handle, SW_SHOW);
  end;
end;

procedure TCreportForm.FileOpen1(Sender: TObject);
begin
  ReportControl1.LoadFromFile(FFile);
  UpdateOldies(FFile, sender);
end;

procedure TCreportForm.NewTableClick(Sender: TObject);
var
  t: boolean;
  n1, n2: Integer;
begin
  with TfrmNewTable.Create(Self) do begin
    try
      if ShowModal = IDOK then
      begin
        try
            //创建表格
            ReportControl1.NewTable(StrToInt(Edit2.Text), StrToInt(Edit1.Text));
        except
          on E: EConvertError do
            MessageBox(handle, pchar('程序错误，错误信息如下：' + #13#10 + E.Message), '错误', MB_ICONERROR+MB_OK);
            //ShowMessage(E.ClassName + #13#10 + E.Message);
        end;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TCreportForm.InsertLineClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.InsertLine;
  Saved := False;
end;

procedure TCreportForm.AddLineClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
    ReportControl1.AddLine;
    Saved := False;
end;

procedure TCreportForm.CombineCellsClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.CombineCell;
  Saved := False;
end;

procedure TCreportForm.SplitCellClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.SplitCell;
  fontboxChange(Sender);
  Saved := False;
end;


procedure TCreportForm.DeleteLineClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.DeleteLine;
  Saved := False;
end;

procedure TCreportForm.AddCellClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.AddCell;
  Saved := False;
end;

procedure TCreportForm.InsertCellClick(Sender: TObject);
begin
if cellline_d=nil then
begin
   Application.Messagebox('请选择单元格!!!', '警告', MB_OK + MB_iconwarning);
   exit;
end;
  ReportControl1.InsertCell;
  Saved := False;
end;

procedure TCreportForm.DeleteCellClick(Sender: TObject);
begin