terminal.pas

1. 发卡服务端：Server 项目文件：autojet.prj 2. 计费客户端：Client 项目文件：internet.prj Explorer.prj 先启动Exp

unit Terminal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DBCtrls, StdCtrls, Mask, DB, ADODB, ExtCtrls;

type
  TCustomDBGridCracker = class(TCustomDBGrid) ;

  TFrm_Terminal = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Btn_Add: TButton;
    Btn_Modi: TButton;
    Btn_Dele: TButton;
    Bevel1: TBevel;
    Btn_Close: TButton;
    StaticText1: TStaticText;
    StTxt_Qty1: TStaticText;
    StaticText2: TStaticText;
    StTxt_Qty2: TStaticText;
    GroupBox1: TGroupBox;
    edt_Termname: TEdit;
    CmbBx_RName: TComboBox;
    Label3: TLabel;
    CmbBx_ComName: TComboBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Btn_AddClick(Sender: TObject);
    procedure Btn_ModiClick(Sender: TObject);
    procedure Btn_DeleClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure CmbBx_RNameChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure disa ;
    procedure enab1 ;
    procedure enab2 ;
    procedure GetQty ;
    { Private declarations }
  public

    { Public declarations }
  end;

var
  Frm_Terminal: TFrm_Terminal;

implementation

uses sys_dm ;

{$R *.dfm}
var
  str1, str2: string ;

  m_Termname: string ;
  m_Gid: string='01' ;
  m_ComName : string='COM1' ;
  m_tmpname: string ;

procedure TFrm_Terminal.GetQty ;
begin
  with frm_sys_dm.Qr_tmp2 do
  begin
    close;
    sql.Clear ;
    sql.text := 'select Count(Termname) from users' ;
    open;
    str1:= intTostr(fields[0].asinteger);

    close;
    sql.Clear ;
    sql.text := 'select Count(Termname) from users where gid=''01''' ;
    open;
    str2:= intTostr(fields[0].asinteger);
  end;
  StTxt_Qty1.Caption := str1+'台' ;
  StTxt_Qty2.Caption := str2+'台' ;
end;


procedure TFrm_Terminal.disa;
begin
  edt_Termname.Enabled := false;
  cmbBx_RName.Enabled := false;
  cmbBx_ComName.Enabled := false ;

  Btn_Add.Caption := '增加[&A]' ; Btn_Add.Tag := 0 ;
  Btn_Modi.Caption := '修改[&M]'; Btn_Modi.Tag := 0 ;
  Btn_Dele.Enabled := true ;

  dbgrid1.Enabled := true ;
  dbgrid1.SetFocus ;   // dbgrid1 聚集
  GetQty ; // 得到统计数量
end;

procedure TFrm_Terminal.enab1;  // 插入
begin
  Edt_Termname.Enabled := true ;
  CmbBx_RName.Enabled := true ;
  CmbBx_ComName.Enabled := true ;
  edt_Termname.SetFocus ;   //DBedt_Termname 聚集

  Btn_Add.Caption := '保存(&S)' ; Btn_Add.Tag := 1 ;   // 增加标记
  Btn_Modi.Caption := '放弃(&C)'; Btn_Modi.Tag := 1 ;
  Btn_Dele.Enabled := false ;

  Dbgrid1.Enabled := false ;
end;

procedure TFrm_Terminal.enab2;  // 修改
begin
  Edt_Termname.Enabled := true ;
  CmbBx_RName.Enabled := true ;
  CmbBx_ComName.Enabled := true ;
  edt_Termname.SetFocus ;   //DBedt_Termname 聚集

  Btn_Add.Caption := '保存(&S)' ; Btn_Add.Tag := 2 ;  // 修改标记
  Btn_Modi.Caption := '放弃(&C)'; Btn_Modi.Tag := 2 ;
  Btn_Dele.Enabled := false ;

  Dbgrid1.Enabled := false ;
end;

procedure TFrm_Terminal.FormCreate(Sender: TObject);
begin
  with frm_sys_dm.Qr_tmp1 do
  begin
    close;
    sql.text := 'select TermName, A.Gid, Rname, COMNAME from users as A , ratename as B where A.Gid=B.Gid' ;
    open;
  end;
end;

procedure TFrm_Terminal.FormShow(Sender: TObject);
begin
  disa;
end;

procedure TFrm_Terminal.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  frm_sys_dm.Qr_tmp1.close ;
end;


procedure TFrm_Terminal.DataSource1DataChange(Sender: TObject;
  Field: TField);
begin
  with frm_sys_dm.Qr_tmp1 do begin
    edt_Termname.Text := fieldbyname('Termname').AsString ;
    m_Termname := fieldbyname('Termname').AsString ;     // 得到要修改的终端名称
    CmbBx_RName.ItemIndex := CmbBx_RName.Items.IndexOf(fieldbyname('Rname').AsString);
    CmbBx_ComName.ItemIndex := CmbBx_ComName.Items.IndexOf(fieldbyname('ComName').AsString);
  end;
end;


procedure TFrm_Terminal.CmbBx_RNameChange(Sender: TObject);
begin
  if CmbBx_RName.ItemIndex = -1  then m_gid := '01' ;  // 普通费率
  if CmbBx_RName.ItemIndex = 0   then m_gid := '01' ;  // 普通费率
  if CmbBx_RName.ItemIndex = 1   then m_gid := '02' ;  // 特别费率
end;

procedure TFrm_Terminal.Btn_AddClick(Sender: TObject);
begin
  if Btn_Add.Tag =0 then  // 增加
  begin
    edt_Termname.Text := '' ;
    CmbBx_RName.ItemIndex := 0 ;
    CmbBx_ComName.ItemIndex := 0 ;
    enab1;
    exit ;
  end ;

  if Btn_Add.Tag =1 then  begin  // 增加保存

    edt_Termname.Text := trim(edt_Termname.Text);
    if edt_Termname.Text ='' then begin
      messagebox(handle, '请输入终端名称', '提示', mb_ok+mb_iconstop);
      edt_Termname.SetFocus ;
      exit
    end;
    if CmbBx_RName.ItemIndex = -1  then  begin
      messagebox(handle, '请选择费率类型', '提示', mb_ok+mb_iconstop);
      exit
    end;

    if CmbBx_ComName.ItemIndex = -1  then  begin
      messagebox(handle, '请选择端口', '提示', mb_ok+mb_iconstop);
      exit
    end;

    with frm_sys_dm.Qr_tmp2 do
    begin
      close;
      sql.text := 'insert into USERS (TermName, Gid, ComName)  values ('''+edt_Termname.text+''', '+''''+m_Gid+''', '+''''+CmbBx_ComName.text+''')' ;
      try
        ExecSQL ;
      except
        messagebox(handle,' 增加失败! ', '提示', mb_ok+mb_iconstop);
        exit ;
      end;
      close;
      sql.text := 'insert into Tigue (TermName, Icno)  values ('''+edt_Termname.text+''', 0)' ;
      try
        ExecSQL ;
      except
        messagebox(handle,' 增加失败! ', '提示', mb_ok+mb_iconstop);
        exit ;
      end;
    end;
  end;


  if Btn_Add.Tag =2 then  begin  // 修改保存

    edt_Termname.Text := trim(edt_Termname.Text);
    if edt_Termname.Text ='' then begin
      messagebox(handle, '请输入终端名称', '提示', mb_ok+mb_iconstop);
      edt_Termname.SetFocus ;
      exit
    end;

    with frm_sys_dm.Qr_tmp2 do
    begin
      close;
      if m_TermName=trim(edt_TermName.Text) then
         sql.text := 'update USERS set Gid='''+m_Gid+''', comname='''+CmbBx_ComName.text+''' where TermName='''+m_TermName+''''
      else
         sql.text := 'update USERS set TermName='''+edt_Termname.text+''', Gid='''+m_Gid+''', comname='''+CmbBx_ComName.text+''' where TermName='''+m_TermName+'''' ;
      try
        ExecSQL ;
      except
        messagebox(handle,' 修改失败! ', '提示', mb_ok+mb_iconstop);
        exit;
      end;

      if m_TermName<>edt_TermName.Text then begin
         close;
         sql.text := 'update Tigue set TermName='''+edt_Termname.text+''' where TermName='''+m_TermName+'''' ;
         try
           ExecSQL ;
         except
           messagebox(handle,' 修改失败! ', '提示', mb_ok+mb_iconstop);
           exit;
         end;
      end;
    end;
  end;

  m_tmpname := edt_Termname.text ;
  with frm_sys_dm.Qr_tmp1 do
  begin
    disablecontrols;
    close;
    open;
    locate('TermName',m_tmpname,[]);
    enablecontrols;
  end;
  disa;
end;

procedure TFrm_Terminal.Btn_ModiClick(Sender: TObject);
begin
  if Btn_Modi.Tag = 0 then   // 修改
  begin
    enab2;
    exit ;
  end else                   // 放弃
  begin
    disa;
  end;
end;

procedure TFrm_Terminal.Btn_DeleClick(Sender: TObject);
var
  Tname, NextTname: string ;
begin
  Tname := frm_sys_dm.Qr_tmp1.fieldbyname('Termname').asstring ;

  // 得到下一条记录的ID
  frm_sys_dm.qr_tmp1.Next ;
  if frm_sys_dm.qr_tmp1.eof then
  begin
    frm_sys_dm.qr_tmp1.prior;
    NextTname :=  frm_sys_dm.qr_tmp1.Fields[0].AsString ;
    frm_sys_dm.qr_tmp1.Next;
  end else
  begin
      NextTname :=  frm_sys_dm.qr_tmp1.Fields[0].AsString ;
      frm_sys_dm.qr_tmp1.prior;
  end;


  if MessageBox(handle, pchar('终端'+Tname+' 将被删去, 您确定吗？'),'信息提示',MB_yesno+mb_iconquestion+MB_DEFBUTTON2)=ID_yes then

  with frm_sys_dm.qr_tmp2 do
  begin
    close;
    sql.clear;
    sql.text := 'delete from Users  where Termname = '''+Tname+'''' ;
    try
      ExecSQL;  // 执行SQL
      with frm_sys_dm.qr_tmp1 do  // DBGRID重新显示
      begin
        disablecontrols;
        close;
        open;
        // 查找下一条记录
        locate('Termname',NextTname,[]);
        enablecontrols;
      end;
    except
      application.messagebox('操作出错，未能删除本条记录！','提示',mb_ok+mb_iconstop);
      exit;
    end;

    close;
    sql.clear;
    sql.text := 'delete from Tigue  where Termname = '''+Tname+'''' ;
    try
      ExecSQL;  // 执行SQL
    except
      application.messagebox('操作出错，未能删除本条记录！','提示',mb_ok+mb_iconstop);
      exit;
    end;
  end;
  disa ;
end;

procedure TFrm_Terminal.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = VK_SPACE) and (btn_modi.Tag=0)  then btn_modi.Click ;
  if key = VK_DELETE then btn_dele.Click ;
  if (key=ord('N')) and (shift-[ssalt]-[ssshift]+[ssctrl]=shift) then btn_add.Click ;

  case key of
    vk_return:
    begin
      if (activecontrol is TDbgrid) then
        exit;
      SelectNext(ActiveControl As Twincontrol,true,true);
      key:=0;
    end;
    vk_up,vk_down:
    begin
      if (activecontrol is TDbgrid) then
        exit;
      SelectNext(ActiveControl As Twincontrol,key=vk_down,true);
      key:=0;
    end;
  end;
end;

procedure TFrm_Terminal.DBGrid1DblClick(Sender: TObject);
begin
  if Btn_Modi.Tag = 0 then Btn_Modi.Click ;
end;

procedure TFrm_Terminal.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  with TCustomDBGridCracker(sender) do
  begin
    if DataLink.ActiveRecord = Row-1 then
    begin
      Canvas.Font.Color := clred ;
      Canvas.Brush.color := $00FFEEEE
    end else
    begin
      canvas.Font.color := clBlack ;

      if frm_sys_dm.Qr_tmp1.fieldbyname('Gid').Value ='02' then
         canvas.Brush.Color := clSkyBlue
      else
         canvas.Brush.Color := clwhite;
    end;

    DefaultDrawColumnCell(Rect,DataCol,column,state);
  end;
end;


end.