xt_bffa_frm_main.pas

delphi开发的中国移动大客户管理系统,后台数据库为oracle

//------------------------------------------------------------
//      作者:曾庆顺
//      模块:数据备份方案窗口
//      时间：2002.09.17
//      功能介绍：
//-----------------------------------------------------------
unit xt_bffa_frm_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Db, DBTables, ComCtrls, Grids, DBGrids, ImgList,
  Buttons;

type
  TData = class
    dcid:string;
  end;
  Txt_bffa_main = class(TForm)
    Query: TQuery;
    Splitter1: TSplitter;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    Splitter2: TSplitter;
    ScrollBox1: TScrollBox;
    Panel2: TPanel;
    btn_add: TButton;
    btn_query: TButton;
    btn_sort: TButton;
    btn_first: TButton;
    btn_prior: TButton;
    btn_next: TButton;
    btn_last: TButton;
    btn_print: TButton;
    btn_refresh: TButton;
    TreeView1: TTreeView;
    ImageList1: TImageList;
    qry_TB_XTGL_FAZB: TQuery;

    DataSource1: TDataSource;
    Label2: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Edit_fabh: TEdit;
    Edit_famc: TEdit;
    Memo_fams: TMemo;
    SP_Add: TSpeedButton;
    SP_Delete: TSpeedButton;
    SP_Modify: TSpeedButton;
    SP_Save: TSpeedButton;
    qry_TB_XTGL_FACB: TQuery;
    qry_TB_XTGL_FACBFABH: TStringField;
    qry_TB_XTGL_FACBJLID: TStringField;
    qry_TB_XTGL_FACBBYWM: TStringField;
    qry_TB_XTGL_FACBBZWM: TStringField;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn_refreshClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CbX_dcmcChange(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure btn_addClick(Sender: TObject);
    procedure btn_queryClick(Sender: TObject);
    procedure btn_sortClick(Sender: TObject);
    procedure btn_firstClick(Sender: TObject);
    procedure btn_priorClick(Sender: TObject);
    procedure btn_nextClick(Sender: TObject);
    procedure btn_lastClick(Sender: TObject);
    procedure btn_printClick(Sender: TObject);
    procedure SP_AddClick(Sender: TObject);
    procedure SP_DeleteClick(Sender: TObject);
    procedure SP_ModifyClick(Sender: TObject);
    procedure SP_SaveClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

    FAdd :Boolean;
    //方案主表 1 -- 增加 2 --修改
    FZAdd:string;
    FTreenode:ttreenode;
    FRefresh:Boolean;
    procedure P_SetEditValues;
    procedure P_SetColor(b:boolean);
    //释放节点内存
    procedure FreeNode(TREEVIEW:TTREEVIEW);
    //打开表
    Function OpenQuery(PQuery:TQuery;PSql:string):Boolean;
    Function ExecQuery(PQuery:TQuery;PSql:string):Boolean;
    //只建单层
    procedure CreateOneTree(treeview:ttreeview;Fdatabasename,Fsqlstring,fbm,fmc:string);
  public
    { Public declarations }
  end;

var
  xt_bffa_main: Txt_bffa_main;

implementation

uses Main,dmmain,query,sort,xt_bffa_frm_Add,xt_bffa_frm_print;

{$R *.DFM}

procedure Txt_bffa_main.FormCreate(Sender: TObject);
var Ldata:Tdata;
begin
    FZAdd:='0';
    //初始状态
    Btn_First.Enabled :=false;
    Btn_prior.Enabled :=false;
end;

procedure Txt_bffa_main.FormDestroy(Sender: TObject);
var i:integer;
begin
  freenode(treeview1);
end;

procedure Txt_bffa_main.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    Action:=CaFree;
end;

procedure Txt_bffa_main.FormShow(Sender: TObject);
begin
   btn_refreshClick(nil);
end;


procedure Txt_bffa_main.CbX_dcmcChange(Sender: TObject);
var fsql:string;
begin

end;


procedure Txt_bffa_main.treeview1Change(Sender: TObject; Node: TTreeNode);
var
  fsql,ftem:string;
begin
  if( not FRefresh ) then exit;
  //恢复旧节点
  if FTreeNode<>nil then FTreeNode.ImageIndex:=0;
  if TreeView1.Selected<>nil then
  begin
     TreeView1.Selected.ImageIndex:=1;
     TreeView1.Selected.SelectedIndex:=1;
     //保存新节点
     FTreeNode:=TreeView1.Selected;
  end;

  if treeview1.Selected=nil then exit;
  ftem:=pchar(treeview1.selected.data);
  //如果记录为空则按钮置灰
  try
     Query.close;
     Query.sql.Clear;
     FSql:='Select Nvl(Count(*),0) from T_XTGL_FACB where FABH = ''' + ftem + '''';
     Query.sql.Add(FSql);
     Query.open;
     Query.First;
     if Query.Fields[0].asinteger < 1 then
     begin
       Btn_First.Enabled :=false;
       Btn_prior.Enabled :=false;
       Btn_Next.Enabled :=false;
       Btn_Last.Enabled :=false;
     end
     else
     begin
       Btn_First.Enabled :=true;
       Btn_prior.Enabled :=true;
       Btn_Next.Enabled :=true;
       Btn_Last.Enabled :=true;
     end;
  except
  end;
  //刷新主表的控件属性
  Query.close;
  Query.sql.Clear;
  Query.sql.Add('Select * from T_XTGL_FAZB where fabh =:p1');
  Query.ParamByName('p1').asstring:=ftem;
  Query.open;
  Query.First;

  Edit_fabh.text:=Query.fieldbyname('fabh').asstring;
  Edit_famc.text:=Query.fieldbyname('famc').asstring;
  memo_fams.Text:=Query.fieldbyname('fams').asstring;
  P_SetColor(true);
  //刷新DBGRID1的数据
  fsql:='select * from T_XTGL_FACB where FABH = '+#39+ftem+#39;
  OpenQuery(qry_TB_XTGL_FACB,fsql);
end;

procedure Txt_bffa_main.P_SetEditValues;
begin
  //赋值编辑框
  Edit_fabh.text:='';
  Edit_famc.text :='';
  memo_fams.Text:='';
end;
procedure Txt_bffa_main.P_SetColor(b:boolean);
begin
  if b then
  begin
    Edit_fabh.ReadOnly:=true;
    Edit_fabh.Color:=clBtnFace;
    Edit_famc.ReadOnly:=true;
    Edit_famc.Color:=clBtnFace;
    memo_fams.ReadOnly:=true;
    memo_fams.Color:=clBtnFace;
  end
  else
  begin
    Edit_fabh.ReadOnly:=false;
    Edit_fabh.Color:=clWindow;
    Edit_famc.ReadOnly:=false;
    Edit_famc.Color:=clWindow;
    memo_fams.ReadOnly:=false;
    memo_fams.Color:=clWindow;
  end;
end;
//方案主表 1 -- 增加 2 --修改
//FZAdd
procedure Txt_bffa_main.SP_AddClick(Sender: TObject);
begin

   FZAdd:='1';
   P_SetEditValues;
   P_SetColor(false);
   Edit_fabh.SetFocus;
end;

procedure Txt_bffa_main.SP_ModifyClick(Sender: TObject);
begin

  if treeview1.Selected=nil then
   begin
     Application.MessageBox('左边树没有选择方案名称,不能修改备份方案!','警告',MB_OK+MB_ICONINFORMATION);
     exit;
   end;

   FZAdd:='2';
   P_SetColor(false);
   Edit_fabh.ReadOnly:=true;
   Edit_fabh.Color:=clBtnFace;
   Edit_famc.SetFocus;
end;

procedure Txt_bffa_main.SP_DeleteClick(Sender: TObject);
var fsql:string;
begin
   if treeview1.Selected=nil then exit;

   fSql:='delete from T_XTGL_FAZB where FABH = '''+ pchar(treeview1.selected.data)+'''';
   ExecQuery(query,fsql);
   btn_refreshClick(nil);
end;

procedure Txt_bffa_main.SP_SaveClick(Sender: TObject);
var fsql:string;
begin
   if FZAdd = '0' then exit;
   if FZadd = '1' then
   begin
      fsql:='insert into T_XTGL_FAZB (FABH,FAMC,FAMS) values(:p1,:p2,:p3)';
      //判断是否有主键重复
      Query.close;
      Query.sql.Clear;
      Query.sql.Add('Select Nvl(Count(*),0) from T_XTGL_FAZB where fabh =:p1');
      Query.ParamByName('p1').asstring:=trim(edit_fabh.Text);
      Query.open;
      Query.First;
      if Query.Fields[0].asinteger > 0 then
      begin
         Application.MessageBox('主键重复!','警告',MB_OK+MB_ICONINFORMATION);
         Edit_fabh.SetFocus;
         btn_refreshClick(nil);
         exit;
      end;
   end;
   if FZadd = '2' then
   begin
      fsql:='update T_XTGL_FAZB set FAMC =:p2,FAMS = :p3 where  FABH =:p1'
   end;
   //执行SQL语句
   try
    Query.close;
    Query.sql.Clear;
    Query.sql.Add(fsql);
    Query.ParamByName('p1').asstring:=trim(edit_fabh.text);
    Query.ParamByName('p2').asstring:=trim(edit_famc.text);
    Query.ParamByName('p3').asstring:=trim(MEMO_fams.text);
    Query.ExecSQL;
   finally
    btn_refreshClick(nil);
   end;
   FZAdd:='0';
end;
procedure Txt_bffa_main.btn_addClick(Sender: TObject);
var
  dlg:Txt_bffa_Add;
  fabh:string;
begin
  if treeview1.Selected=nil then exit;
  try
    fabh:=pchar(treeview1.Selected.Data);
    dlg:=Txt_bffa_Add.create(self);
    dlg.Fabh:=fabh;
    dlg.FSsql:='select COMMENTS from USER_TAB_COMMENTS where COMMENTS is not null and COMMENTS not in ';
    dlg.FSsql:=dlg.FSsql + '(select BZWM from T_XTGL_FACB where fabh = '''+fabh+''')';

    dlg.FDsql:='select BZWM from T_XTGL_FACB where fabh = '''+fabh+'''';
    dlg.ShowModal;
  finally
    dlg.free;
    qry_TB_XTGL_FACB.close;
    qry_TB_XTGL_FACB.Open;
  end;
end;
procedure Txt_bffa_main.btn_queryClick(Sender: TObject);
begin
   p_Query(DbGrid1);
end;
procedure Txt_bffa_main.btn_sortClick(Sender: TObject);
begin
   p_Sort(qry_TB_XTGL_FACB,DbGrid1);
end;

procedure Txt_bffa_main.btn_firstClick(Sender: TObject);
//当前记录在第一条
begin
   qry_TB_XTGL_FACB.First;
   Btn_First.Enabled :=false;
   Btn_prior.Enabled :=false;
   Btn_Next.Enabled :=True;
   Btn_Last.Enabled :=True;
end;

procedure Txt_bffa_main.btn_priorClick(Sender: TObject);
//当前记录向上一条
begin
  qry_TB_XTGL_FACB.Prior;
  if qry_TB_XTGL_FACB.Bof then
  begin
    Btn_First.Enabled :=false;
    Btn_prior.Enabled :=false;
    Btn_Next.Enabled :=True;
    Btn_Last.Enabled :=True;
  end
  else
  begin
    Btn_First.Enabled :=true;
    Btn_prior.Enabled :=true;
    Btn_Next.Enabled :=True;
    Btn_Last.Enabled :=True;
  end;
end;
procedure Txt_bffa_main.btn_nextClick(Sender: TObject);
//当前记录向下一条
begin
  qry_TB_XTGL_FACB.Next;
  if qry_TB_XTGL_FACB.Eof then
  begin
    Btn_First.Enabled :=true;
    Btn_prior.Enabled :=true;
    Btn_Next.Enabled :=false;
    Btn_Last.Enabled :=false;
  end
  else
  begin
    Btn_First.Enabled :=true;
    Btn_prior.Enabled :=true;
    Btn_Next.Enabled :=True;
    Btn_Last.Enabled :=True;
  end;
end;
procedure Txt_bffa_main.btn_lastClick(Sender: TObject);
//当前记录最后一条
begin
    qry_TB_XTGL_FACB.last;
    Btn_First.Enabled :=true;
    Btn_prior.Enabled :=true;
    Btn_Next.Enabled :=false;
    Btn_Last.Enabled :=false;
end;

procedure Txt_bffa_main.btn_refreshClick(Sender: TObject);
var fsql:string;
begin
  //初始化树
  FtreeNode:=nil;
  FRefresh:=false;
  //释放旧内存
  freenode(treeview1);
  //清除树
  treeview1.Items.clear;
  fsql:='select FABH,FAMC from T_XTGL_FAZB ';
  createonetree(treeview1,dm_main.Databasedh.DatabaseName,fsql,'fabh','famc');
  FRefresh:=true;
  if TreeView1.Items.Count = 0 then
  begin
     //如果没有条件fabh='$'
     fsql:='select * from T_XTGL_FACB where FABH = ''$''';
     OpenQuery(qry_TB_XTGL_FACB,fsql);
     //设置编辑框
     P_SetEditValues;
     P_SetColor(true);
  end;

  treeview1.SetFocus;
end;



procedure Txt_bffa_main.btn_printClick(Sender: TObject);
var
  dlg:Txt_bffa_print;
begin
  if treeview1.Selected=nil then exit;
  try
    dlg:=Txt_bffa_print.create(self);
    dlg.qry_TB_XTGL_FACB.Close;
    dlg.qry_TB_XTGL_FACB.sql.Text :=qry_TB_XTGL_FACB.sql.Text;
    dlg.qry_TB_XTGL_FACB.open;
    dlg.QRLabel4.Caption:=treeview1.Selected.Text;
    dlg.QuickRep1.Preview;
  finally
    dlg.free;
  end;
end;

procedure Txt_bffa_main.FreeNode(TREEVIEW: TTREEVIEW);
VAR
  I:INTEGER;
  pnode:pchar;
begin
  FOR I:=0 to treeview.Items.Count-1 do
  begin
     pnode:=pchar(treeview.Items[i].Data);
     Freemem(pnode);
  end;
end;

function Txt_bffa_main.OpenQuery(PQuery: TQuery; PSql: string): Boolean;
begin
  Result:=true;
  PQuery.close;
  PQuery.sql.Clear;
  PQuery.Filtered:=false;
  PQuery.sql.add(PSql);
  try
    PQuery.open;
  except
    Result:=false;
  end;
end;

function Txt_bffa_main.ExecQuery(PQuery: TQuery; PSql: string): Boolean;
begin
  Result:=true;
  PQuery.close;
  PQuery.sql.Clear;
  PQuery.Filtered:=false;
  PQuery.sql.add(PSql);
  try
    PQuery.ExecSQL;
  except
    Result:=false;
  end;
end;

procedure Txt_bffa_main.CreateOneTree(treeview: ttreeview; Fdatabasename,
  Fsqlstring, fbm, fmc: string);
var query:TQuery;
    code,bh:string;
    FNode:pchar;
begin
  try
      query:=TQuery.Create(nil);
  except
      exit;
  end;
  query.DatabaseName:=fdatabasename;
  query.close;
  query.sql.Clear;
  query.sql.Add(fsqlstring+' order by '+fbm);
  try
     query.open;
  except
     exit;
  end;
  query.First;
  while  not query.Eof do
  begin
      bh:=query.FieldByName(Fbm).asstring;
      code := query.FieldByName(Fmc).asstring;
      try
         getmem(fnode,length(bh)+1);//得到指针的内存空间
      except
         exit;
      end;
      move(bh[1],fnode^,length(bh)+1);//指针指出结点对应的编码
      if length(code) >255 then code :=copy(code,0,255);
      treeview.Items.AddObject(nil,code, fnode);
      query.Next;
  end;
  query.free;
end;

procedure Txt_bffa_main.Button1Click(Sender: TObject);
begin
  close;
end;

end.