tour.pas

地理资源的录入程序运用了api的一些知识

    except
        on e: exception do
        begin
          application.MessageBox(pchar(e.Message), '添加信息提示');
          sql.Clear;
          sql.Add('select * from T_Geo_Gnis order by z_ptzybh');
          open;
          exit;
        end;
      end;
      sql.Clear;
      sql.Add('select * from T_Geo_Gnis ');
      open;
      Last;
      DIS; //  使所有的控件不可用
      application.MessageBox('信息添加成功!!!', '添加信息提示', MB_ICONINFORMATION);
    end;
  end
  else                    //修改数据库内容

  begin
   if (bzmc.Text ='') or (zybm.Text='') then
    begin
        showmessage('必添项不能为空!');
       exit;
       end;
    dm.dlxxzy.Edit;
    with dm.dlxxzy do
    begin

      fields[0].Value := ZYPTBH.Text;
      fields[1].Value := ZYBM.Text;
      fields[2].Value := BZMC.Text;
      fields[3].Value := LMZMPX.Text;
      fields[4].Value := BM.Text;
      fields[5].Value := JLNX.Text;
      fields[6].Value := CSGM.Text;
      fields[7].Value := SJDM.Text;
      fields[8].Value := BW.Text;
      fields[9].Value := ZBW.Text;
      fields[10].Value := DJ.Text;
      fields[11].Value := ZDJ.Text;
      fields[12].Value := XZLS.Text;
      fields[13].Value := xzhqdm.Text;
      fields[14].Value := ZFZD.Text;
      fields[15].Value := ZFWZ.Text;
      fields[16].Value := XJZQ.Text;
      fields[17].Value := YZBM.Text;
      fields[18].Value := RK.Text;
      fields[19].Value := MJ.Text;
      fields[20].Value := QHLX.Text;
      fields[21].Value := DMLX.Text;
      fields[22].Value := DMHY.Text;
      fields[23].Value := LSYG.Text;
      fields[24].Value := QTXX.Text;
      ExecSQL;

     try
        UpdateBatch;
        application.MessageBox('信息修改成功!!!', '修改信息提示', MB_ICONINFORMATION);
      except
        on e: exception do
        begin
          application.MessageBox(pchar(e.Message), '修改信息提示');
          exit;
        end;
      end;
    end;
  end;

  DM.dlxxzy.Close;
  DM.dlxxzy.Open;  //打开customer组件
  dm.dlxxzy.Last;

end;


//取消按钮程序
procedure Tdlxxfrm.BitBtn4Click(Sender: TObject);
begin
DIS;   //所有TEdit控件不可以
cls;
zfwz.Text :='http://';
zybm.Text :='';
end;


//删除按钮程序
procedure Tdlxxfrm.BitBtn5Click(Sender: TObject);
var
  i: integer;
  j: string;
begin
  j := DM.dlxxzy.FieldValues['Z_PTZYbh'];
  i := application.MessageBox('信息删除将直接影响数据库,您确信真的要删除吗？', '删除信息提示', MB_YESNO + MB_ICONWARNING);
  if i =6 then
  begin
    DM.dlxxzy.Close;
    DM.dlxxzy.SQL.Clear;
    DM.dlxxzy.SQL.Add('delete * from T_Geo_Gnis where Z_PTZYBH= ' +#39+j+#39);
    DM.dlxxzy.ExecSQL;
    application.MessageBox('信息删除成功!!!', '删除信息提示', MB_ICONINFORMATION);
    CLS; //调用用户定义CLS的函数来清除所有的控件内容
    DM.dlxxzy.SQL.Clear;
     DM.dlxxzy.SQL.Add('select * from T_Geo_Gnis');
     DM.dlxxzy.Open;
  end
end;


//关闭按钮程序
procedure Tdlxxfrm.BitBtn6Click(Sender: TObject);
begin
close;
end;



procedure Tdlxxfrm.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
case DM.dsdlxxzy.DataSet.RecNo mod 2 = 0 of
    //如果是奇数行显示的颜色是00DDE8FF，偶数行显示时clwhite
    True: DbGrid1.Canvas.Brush.Color := clWhite;
    False: DbGrid1.Canvas.Brush.Color := clGradientActiveCaption;
  end;
  with TCustomDBGridCracker(sender) do
       begin
              if DataLink.ActiveRecord=Row-1 then
              Canvas.Brush.Color:=clgreen;
              DefaultDrawColumnCell(Rect,DataCol,Column,State);
       end;
end;

procedure Tdlxxfrm.DBGrid1DblClick(Sender: TObject);
begin
 GetAll;
 Bitbtn2.Click; //鼠标双击的时候，进入该条记录的编辑状态
 
end;



procedure Tdlxxfrm.DBNavigator1Click(Sender: TObject;
  Button: TNavigateBtn);
begin
case button of
 nbfirst:
  begin
     getall;
     dis;//bitbtn2.Click;
  end;
  nbprior:
      begin
       getall;
      dis;// bitbtn2.Click;
     end;
  nbnext:
   begin
      getall;
dis;//      bitbtn2.Click;
  end;
  nblast:
     begin
      getall;
    dis; // bitbtn2.Click;
  end;
end;
end;

procedure Tdlxxfrm.FormShow(Sender: TObject);
begin

dis;
//cls;
//if dm.dlxxzy.Active =false then
//  dm.dlxxzy.Active :=true;
end;

procedure Tdlxxfrm.zybmExit(Sender: TObject);
begin
if zybm.ItemIndex=0 then
   zybm.Text :='4101010001'
   else
     if zybm.ItemIndex = 1 then
        zybm.Text:= '4101010002'
     else
        if zybm.ItemIndex =2 then
            zybm.Text :='4101010003'
        else
           if zybm.ItemIndex = 3  then
              zybm.Text :='4101010004';
end;

procedure Tdlxxfrm.Button1Click(Sender: TObject);
begin
//dm.dlxxzy.Close;
//dm.dlxxzy.SQL.Clear ;
//dm.dlxxzy.SQL.Add('update T_Geo_Gnis set z_zybm=4101010004 where z_zybm=:3101010004 ')
//dm.dlxxzy.ExecSQL;

end;

procedure Tdlxxfrm.BZMCKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
    lmzmpx.SetFocus ;
end;

procedure Tdlxxfrm.LMZMPXKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
 bm.SetFocus ;
end;

procedure Tdlxxfrm.JLNXKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
  csgm.SetFocus ;
end;

procedure Tdlxxfrm.BMKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
jlnx.SetFocus ;
end;

procedure Tdlxxfrm.CSGMKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
 sjdm.SetFocus ;
end;

procedure Tdlxxfrm.sjdmKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
bw.SetFocus ;
end;

procedure Tdlxxfrm.BWKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
  zbw.SetFocus ;
end;

procedure Tdlxxfrm.ZBWKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then dj.SetFocus ;
end;

procedure Tdlxxfrm.DJKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then zdj.SetFocus ;
end;

procedure Tdlxxfrm.zdjKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then xzls.SetFocus ;
end;

procedure Tdlxxfrm.xzlsKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then xzhqdm.SetFocus ;
end;

procedure Tdlxxfrm.xzhqdmKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then zfzd.SetFocus ;
end;

procedure Tdlxxfrm.zfzdKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then zfwz.SetFocus ;
end;

procedure Tdlxxfrm.zfwzKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then yzbm.SetFocus ;
end;

procedure Tdlxxfrm.rkKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then mj.SetFocus ;
end;

procedure Tdlxxfrm.yzbmKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then rk.SetFocus ;
end;

procedure Tdlxxfrm.mjKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then xjzq.SetFocus ;
end;

procedure Tdlxxfrm.btnokClick(Sender: TObject);
begin
dlwzcxfrm.show;
end;

procedure Tdlxxfrm.BitBtn8Click(Sender: TObject);
var m :integer;
    xls1: Variant;
    i, j: integer;

begin
  m := application.MessageBox('信息导出可能需要一点时间,您确信要导出吗？', '导出信息提示', MB_YESNO + MB_ICONWARNING);
  if m =6 then
  begin
  //~~~~~~~~~~~~~~~~~~~~~~~~~~  导出到excel~~~~~~~

    begin
  if(dm.dlxxzy.Active=false) or (dm.dlxxzy.RecordCount=0) then
   begin
     messagedlg('没有数据，输出失败！',mterror,[mbyes],0);
     exit;
   end;
    //创建excel对象
  try
    xls1 := createoleobject('Excel.Application');
    xls1.Visible := false;
    xls1.Workbooks.Add;

  except
    showmessage('你的电脑没有安装excel程序，无法完成此功能!');
    exit;
  end;
    //setfocus;处理标题
  messagedlg('共'+inttostr(dm.dlxxzy.RecordCount)+'条记录,请稍等片刻！复制完毕后，将给出提示',mtConfirmation,[mbyes],0);
  for j := 0 to DBGrid1.FieldCount - 1 do
  begin
   xls1.cells[1, j + 1] := DBGrid1.Columns[j].Title.Caption;
  end; //处理记录
 dm.dlxxzy.First;
  i := 2;
  while not Dm.dlxxzy.Eof do
  begin
       //处理一行
    //   dm.dqjjxx.DisableControls;
    for j := 0 to dm.dlxxzy.FieldCount - 1 do
    begin
      if DBGrid1.Fields[j] <> nil then
        xls1.cells[i, j + 1] := trim(DBGrid1.Fields[j].asstring)
      else
        xls1.cells[i, j + 1] := '';
    end;
    i := i + 1;
    dm.dlxxzy.Next;
  end;
  // dm.dqjjxx.DisableControls;
 messagedlg('已成功导出到excel！',mtConfirmation,[mbyes],0);
 xls1.Visible := true;
end;

    //~~~~~~~~~~~~~~~~~~~~~~~~~~
//outputexcel(dbgrid1)
 end;

 end;

procedure Tdlxxfrm.BitBtn7Click(Sender: TObject);
begin
 dm.dlxxzy.Close;
 dm.dlxxzy.SQL.Clear;
 dm.dlxxzy.SQL.Add('select * from  T_geo_gnis where 1>0');
 dm.dlxxzy.Active :=true;
end;

end.