unit_main.pas

DELPHI的报表控件

unit Unit_Main;

interface

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

CONST   CN_MYTEXTUNDO = WM_APP + 2111;
        BufferCount = 32;
type
  TFormMain = 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;
    Panel5: TPanel;
    Panel6: TPanel;
    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;
    ProgressBar1: TProgressBar;
    Rename1: TMenuItem;
    TreeView1: TTreeView;
    SaveAs1: TMenuItem;
    Delete1: TMenuItem;
    Refresh1: TMenuItem;
    DataSource2: TDataSource;
    DBGridPrn2: TDBGridPrn;
    Panel2: TPanel;
    Panel3: TPanel;
    BtnUp: TSpeedButton;
    BtnDown: TSpeedButton;
    BtnExec: TSpeedButton;
    Panel4: TPanel;
    RichEdit1: TRichEdit;
    Splitter1: TSplitter;
    Panel7: TPanel;
    BtnPrint: TSpeedButton;
    DBGridPrn1: TDBGridPrn;
    SpeedButton1: TSpeedButton;
    Table2: TTable;
    PopupMenu3: TPopupMenu;
    Filter1: TMenuItem;
    N10: TMenuItem;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    DBNavigator1: TDBNavigator;
    Cancerl1: TMenuItem;
    SpeedButton5: TSpeedButton;
    ShapeEx1: TShapeEx;
    procedure Button1Click(Sender: TObject);    
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(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 Rename1Click(Sender: TObject);
    procedure TreeView1Editing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    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 SaveAs1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure Panel7Resize(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure CNMYTEXTUNDO(var Message: TMessage); message CN_MYTEXTUNDO;
    procedure Filter1Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure PopupMenu3Popup(Sender: TObject);
    procedure TreeView1Expanded(Sender: TObject; Node: TTreeNode);
    procedure Cancerl1Click(Sender: TObject);
    procedure PageControl1Changing(Sender: TObject;
      var AllowChange: Boolean);
    procedure SpeedButton5Click(Sender: TObject);
    procedure ShapeEx1Changing(Sender: TObject; Cell: TCellUnitEx;
      var AllowChange: Boolean);
    procedure ShapeEx1EditingCell(Sender: TObject; Cell: TCellUnitEx;
      var AllowEditing: Boolean);
    procedure ShapeEx1DrawingCell(Sender: TObject; ACanvas: TCanvas;
      Cell: TCellUnitEx; ACellState: TCellStates; ARect: TRect;
      Text: String; var DefaultDraw: Boolean);
    procedure ShapeEx1EditedCell(Sender: TObject; Cell: TCellUnitEx;
      AType: TEditingCellType);
    procedure ShapeEx1BeforeShowBtn(Sender: TObject; Cell: TCellUnitEx;
      var AShowBtnType: TShowBtnType; ACaption: String; ABitmap: TBitmap);
//    procedure TreeView1DblClick(Sender: TObject);
//    procedure RadioButton1Click(Sender: TObject);
  private
    { Private declarations }
    HistorySql: array [0..BufferCount-1] of TStrings;
    CurrPos,FirstPos,NextPos : integer;
    CurrAliasNode,OldAliasNode:TTreeNode;
    TmpStrList : TStringList;
    BBStream : TMemoryStream;
    procedure AddSubStrings(Node:TTreeNode;StrList:TStrings);
    Function IsOnlyOne(Tar : String):Boolean;
    procedure SortChildren;
    Function GetAliasNode(Node:TTreeNode):TTreeNode;
  public
    { Public declarations }
  end;
  procedure FileCopy2(Sou,Tar:String);
var
  FormMain: TFormMain;

implementation

{$R *.DFM}

uses inifiles,shlobj,Commctrl,UnitMyDlg, UnitAbout, ShellApi, FileCtrl, MyDialogs,Unit_ComEditor;
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 TFormMain.Button1Click(Sender: TObject);
var
  i,Count:integer;
  AliasName : String;
//  TD :TDataBase;
begin
  Query1.Close;
{  if CurrAliasNode=nil then Exit;
  if CurrAliasNode.Text<>Query1.DatabaseName then
  begin
    TD := Session.FindDatabase(OldAliasNode.Text);
    if TD<>nil then TD.Close;
{    except
      ShowMessage('Can not Close DataBase '+OldAliasNode.Text);
      Exit;
    end;
    if CurrAliasNode.Data=Pointer(0) then Exit
      else Query1.DatabaseName := CurrAliasNode.Text;
    try
      Session.OpenDatabase(OldAliasNode.Text);
    except
      with OldAliasNode do
      if Integer(Data)=1 then
      begin
        Collapse(False);
        Item[0].DeleteChildren;
        Data := 0;
        Item[0].Data := 0;
      end;
    end;
  end;  }
  Query1.SQL.Clear;
  Query1.SQL.Assign(richedit1.Lines);
  Try
    Query1.Prepare;
    if StrComp(PChar(UpperCase(Copy(Trim(RichEdit1.Lines[0]),1,6))),PChar('SELECT')) = 0
      then Query1.Open else Query1.ExecSQL;
    if (RichEdit1.Modified) then
    begin
      RichEdit1.Modified:=False;
      if HistorySql[NextPos]=nil then
        HistorySql[NextPos]:=TStringList.Create;
      HistorySql[NextPos].Assign(RichEdit1.Lines);
      CurrPos := NextPos;
      NextPos:=(NextPos+1) mod BufferCount;
      if NextPos=FirstPos then FirstPos := (FirstPos+1) mod BufferCount;
      BtnUp.Enabled := CurrPos <> FirstPos;
    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
    raise; //on E: Exception do ShowMessage(e.Message);
  end;
end;

procedure TFormMain.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 TFormMain.N2Click(Sender: TObject);
begin
  OpenDialog1.FilterIndex:=1;
  OpenDialog1.DefaultExt:='SQL';
  if OpenDialog1.Execute then RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TFormMain.N3Click(Sender: TObject);
begin
  SaveDialog1.FilterIndex:=2;
  SaveDialog1.DefaultExt:='DBR';
  if SaveDialog1.Execute then
  begin
    DBGridPrn1.LoadFromStream(BBStream);
    DBGridPrn1.SaveToFile(SaveDialog1.FileName);
  end;
end;

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

procedure TFormMain.BtnDownClick(Sender: TObject);
begin
  if CurrPos<>NextPos then CurrPos := (CurrPos+1) mod BufferCount;
  BtnUp.Enabled := CurrPos <> FirstPos;
  if CurrPos = NextPos
    then begin
      RichEdit1.Lines.Clear;
    end
  else begin
    RichEdit1.Lines.Assign(HistorySql[CurrPos]);
  end;
end;

procedure TFormMain.BtnUpClick(Sender: TObject);
begin
//  if (CurrPos <> FirstPos) then
  begin
    CurrPos := (CurrPos+BufferCount-1) mod BufferCount;
    RichEdit1.Lines.Assign(HistorySql[CurrPos]);
  end;
  BtnUp.Enabled := (CurrPos <> FirstPos);
end;

procedure TFormMain.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 TFormMain.FormCreate(Sender: TObject);
var
  I:integer;
  Reg : TIniFile;
  Str: String;
  DisName:PChar;
  IIL : PItemIDList;
  TmpNode : TTreeNode;
begin
  CurrPos := 0;
  FirstPos := 0;
  NextPos := 0;

  BBStream := TMemoryStream.Create;
  DBGridPrn1.SaveToStream(BBStream);
  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;

 // LoadWindowSize
  WindowState := TWindowstate(Reg.ReadInteger('SavedSize','State',0));
  if WindowState = wsNormal then
  begin
    Left := Reg.ReadInteger('SavedSize','Left',50);
    Top := Reg.ReadInteger('SavedSize','Top',100);
    Width := Reg.ReadInteger('SavedSize','Width',600);
    Height := Reg.ReadInteger('SavedSize','Height',360);
  end;