unit1.pas

DELPHI的报表控件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Query1: TQuery;
    Panel1: TPanel;
    DataSource1: TDataSource;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    Panel4: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel3: TPanel;
    RichEdit1: TRichEdit;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Database1: TDatabase;
    N3: TMenuItem;
    N4: TMenuItem;
    BtnUp: TSpeedButton;
    BtnDown: TSpeedButton;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    DBGridPrn1: TDBGridPrn;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure ComboBox1DropDown(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure BtnDownClick(Sender: TObject);
    procedure BtnUpClick(Sender: TObject);
    procedure Query1AfterOpen(DataSet: TDataSet);
    procedure Query1AfterClose(DataSet: TDataSet);
    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 RadioButton1Click(Sender: TObject);
  private
    { Private declarations }
    HistorySql: array [0..31] of TStrings;
    CurrPos : integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses inifiles,shlobj,BrowseFolder;

//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.Button2Click(Sender: TObject);
begin
  DBGridPrn1.Preview;
end;

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);
begin
  SaveDialog1.FilterIndex:=1;
  SaveDialog1.DefaultExt:='SQL';
  if SaveDialog1.Execute then RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
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.ComboBox1DropDown(Sender: TObject);
var
  index:integer;
begin
  ComboBox1.Items.Clear;
  ComboBox1.ItemIndex:=-1;
  Session.GetAliasNames(ComboBox1.Items);
  index:=ComboBox1.Items.IndexOf('zwg3172AllSearch');
  if Index>-1 then ComboBox1.Items.Delete(Index);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 if ComboBox1.ItemIndex>-1 then
  Try
    if Database1.Connected then
    begin
      Query1.Close;
      Database1.Close;
    end;
    Database1.AliasName:=ComboBox1.Text;
    Database1.Open;
  except
    ShowMessage('不能连接到数据库"'+ComboBox1.Text+'"。');
    ComboBox1.ItemIndex:=-1;
  end;
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.Query1AfterOpen(DataSet: TDataSet);
begin
  Button2.Enabled:=True;
end;

procedure TForm1.Query1AfterClose(DataSet: TDataSet);
begin
  Button2.Enabled:=False;
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;
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;
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;
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
      reg.Free;
    end;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  RichEdit1.CutToClipboard;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  RichEdit1.CopyToClipboard;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  RichEdit1.PasteFromClipboard;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  N5.Enabled:=RichEdit1.SelLength>0;
  N7.Enabled:=Clipboard.AsText<>'';
  N6.Enabled:=N5.Enabled;
  N1.Enabled:=RichEdit1.Text<>'';
end;

end.