unit1.pas

DELPHI的报表控件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Grids, DBGrids, DBGridPrn, Db, DBTables,
  Menus, Buttons, clipbrd, DBGridColor, TreeViewEn, ImgList, ShapeEx,
  ScrollCustomControl, BitBtnGrid, DBCtrls;

type
  TForm1 = class(TForm)
    Query1: TQuery;
    DataSource1: TDataSource;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    BtnUp: TSpeedButton;
    BtnDown: TSpeedButton;
    Panel4: TPanel;
    RichEdit1: TRichEdit;
    Panel5: TPanel;
    Panel6: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    ImageList1: TImageList;
    Table1: TTable;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    PopupMenu2: TPopupMenu;
    Open1: TMenuItem;
    Close1: TMenuItem;
    N9: TMenuItem;
    New1: TMenuItem;
    Apply1: TMenuItem;
    ShapeEx1: TShapeEx;
    DBGridPrn1: TDBGridPrn;
    ProgressBar1: TProgressBar;
    Rename1: TMenuItem;
    DBNavigator1: TDBNavigator;
    TreeView1: TTreeView;
    SaveAs1: TMenuItem;
    BtnExec: TSpeedButton;
    BtnPrint: TSpeedButton;
    procedure Button1Click(Sender: TObject);    
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure BtnDownClick(Sender: TObject);
    procedure BtnUpClick(Sender: TObject);
    procedure DBGridPrn1TitleClick(Column: TColumn);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N8Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure TreeView1GetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView1CustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Open1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure ShapeEx1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure ShapeEx1CellEdit(Sender: TObject; Row, Col: Integer;
      var AllowEditing: Boolean);
    procedure Rename1Click(Sender: TObject);
    procedure TreeView1Editing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure PageControl1Resize(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure TreeView1Changing(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure TreeView1Edited(Sender: TObject; Node: TTreeNode;
      var S: String);
    procedure Apply1Click(Sender: TObject);
//    procedure RadioButton1Click(Sender: TObject);
  private
    { Private declarations }
    HistorySql: array [0..31] of TStrings;
    CurrPos : integer;
    TmpStrList : TStringList;
    procedure AddSubStrings(Node:TTreeNode;StrList:TStrings);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses inifiles,shlobj,BrowseFolder,Commctrl;
var
//  Dx,Dy,DD : integer;
  TmpNode :TTreeNode;
  NodeText : String;
  
//SELECT SUBSTRING(A.QYBM,12,4) , A.QYJC , C.BMSM , B.N1 FROM DJSW A,BMJKSM B,DJNSRD C WHERE A.QYBM=C.QYBM AND C.BMSM=B.N2
//AND A.NSRLX='10' AND A.DJYZRQ>'2000/9/1'  order by A.QYBM

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
begin
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Assign(richedit1.Lines);
  Try
    Query1.Open;
    if (RichEdit1.Modified) and (RichEdit1.Lines.Text<>'') then
    begin
      RichEdit1.Modified:=False;
      if HistorySql[CurrPos]=nil then
        HistorySql[CurrPos]:=TStringList.Create;
      HistorySql[CurrPos].Assign(RichEdit1.Lines);
      CurrPos:=(CurrPos+1) mod 32;
      BtnUp.Enabled:=True;
    end;
    For i:=0 to Query1.FieldCount-1 do if (Query1.Fields[i] is TCurrencyField) then (Query1.Fields[i] as TNumericField).DisplayFormat:=',0.00';
  except
    ShowMessage('SQL Statement Error, Please Check');
  end;
end;

procedure TForm1.N1Click(Sender: TObject);
var
  FF : TextFile;
  i : integer;
begin
  SaveDialog1.FilterIndex:=1;
  SaveDialog1.DefaultExt:='SQL';
  if SaveDialog1.Execute then begin
  AssignFile(FF,SaveDialog1.FileName);
  Rewrite(FF);
  try
    with RichEdit1.Lines do
    For i:=0 to Count-1 do
      Writeln(ff,Strings[i]);
  finally
    CloseFile(ff);
  end;
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  OpenDialog1.FilterIndex:=1;
  OpenDialog1.DefaultExt:='SQL';
  if OpenDialog1.Execute then RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.MenuItem1Click(Sender: TObject);
begin
  SaveDialog1.FilterIndex:=2;
  SaveDialog1.DefaultExt:='DBR';
  if SaveDialog1.Execute then DBGridPrn1.SaveToFile(SaveDialog1.FileName);

end;

procedure TForm1.MenuItem2Click(Sender: TObject);
begin
  OpenDialog1.FilterIndex:=2;
  OpenDialog1.DefaultExt:='DBR';
  if OpenDialog1.Execute then DBGridPrn1.LoadFromFile(OpenDialog1.FileName);

end;

procedure TForm1.BtnDownClick(Sender: TObject);
begin
  if HistorySql[CurrPos]<>nil
    then BEGIN
      RichEdit1.Lines.Assign(HistorySql[CurrPos]);
      CurrPos:=(CurrPos+1) MOD 32;
    end
  else begin
    RichEdit1.Lines.Clear;
  end;
  BtnUp.Enabled:=HistorySql[(CurrPos+31)mod 32]<>nil;
end;

procedure TForm1.BtnUpClick(Sender: TObject);
begin
  Dec(CurrPos);
  RichEdit1.Lines.Assign(HistorySql[CurrPos]);
  if HistorySql[(CurrPos+31) mod 32]=nil
  then begin
    BtnUp.Enabled:=False;
  end;
end;

procedure TForm1.DBGridPrn1TitleClick(Column: TColumn);
var
  Str:String;
begin
  if (Column.Field is TCurrencyField) or (Column.Field is TDateTimeField)
  then begin
    Str:=InputBox('Style Editor','Please enter the style','');
    if (Column.Field is TCurrencyField) then (Column.Field as TNumericField).DisplayFormat:=Str
      else (Column.Field as TDateField).DisplayFormat:=Str;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I:integer;
  Reg : TIniFile;
  Str: String;
  DisName:PChar;
  IIL : PItemIDList;
  TmpNode : TTreeNode;
begin
  For I:=0 to 31 do HistorySql[i]:=nil;
  Str:=ExtractFilePath(ParamStr(0))+'UsSearch0.ini';
// if not FileExists(Str) then FileCreate(Str);
  Reg:=TIniFile.Create(Str);
  Str:=Reg.ReadString('SaveDir','Dir1' , '');
  if Str='' then Str:=ExtractFilePath(ParamStr(0))+'StyleAndSQL';
  begin
    if not FileExists(Str+'\UsZSGLSearch317299.i2i') then
      if not CreateDir(Str) then
      begin
        FileClose(FileCreate(Str+'\UsZSGLSearch317299.i2i'));
        GetMem(DisName,MAX_PATH);
        ZeroMemory(DisName,MAX_PATH);
        SHGetSpecialFolderLocation(Handle,CSIDL_PERSONAL,iil);
        SHGetPathFromIDList(iil,DisName);
        Str:=DisName;
        FreeMem(DisName);
      end;
    Reg.WriteString('SaveDir','Dir1',Str);
  end;
  OpenDialog1.InitialDir:=Str;
  SaveDialog1.InitialDir:=Str;
//  ShowMessage(str);
  Reg.Free;

  TmpStrList := TStringList.Create;
//  TmpStrList.Sorted := True;
  Session.GetAliasNames(TmpStrList);
  TmpStrList.Sort;
//  AddSubStrings(TreeViewEn1.Items[0],TmpStrList);
  if TmpStrList.Count>0 then
  begin
    TmpNode := TreeView1.Items.AddChildObjectFirst(TreeView1.Items.Item[0],TmpStrList.Strings[0],0);
    TreeView1.Items.AddChildObjectFirst(TmpNode,'Tables',0);
    For i:= 1 to TmpStrList.Count-1 do
    begin
      TmpNode := TreeView1.Items.AddChildObject(TreeView1.Items[0],TmpStrList.Strings[i],0);
      TreeView1.Items.AddChildObjectFirst(TmpNode,'Tables',0);
    end;
  end;
  show
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  I:integer;
begin
  For I:=0 to 31 do if HistorySql[i]<>nil then HistorySql[i].Free;
  TmpStrList.Free;
end;

procedure TForm1.N8Click(Sender: TObject);
var
  Reg : TIniFile;
  Str:String;
begin
  if GetSelectedDir('',Str) then
    try
//      Str:=ExtractFilePath(ParamStr(0))+'UsZSGLSearch.ini';
      Reg:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'UsSearch0.ini');
      Reg.WriteString('SaveDir','Dir1',Str);
      OpenDialog1.InitialDir:=Str;
      SaveDialog1.InitialDir:=Str;
    finally