u_web_gstinfo.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit U_WEB_GSTINFO;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Grids, ExtCtrls, StdCtrls, AdvGrid, TFlatEditUnit, TFlatComboBoxUnit,
   TFlatButtonUnit, BaseGrid, ieview, imageenview, imageen;

type
   TF_WEB_GSTINFO = class(TForm)
      PN_VIP: TPanel;
      Panel2: TPanel;
      LB_NAME: TLabel;
      Label4: TLabel;
      Label6: TLabel;
      SG_JL: TAdvStringGrid;
      ED_NAME: TFlatEdit;
      ED_VIP: TFlatEdit;
      ED_REMARK: TFlatEdit;
      BN_BC: TFlatButton;
      BN_DEL: TFlatButton;
      BN_FH: TFlatButton;
      LB_ADATE: TLabel;
      ED_BIRTH: TFlatEdit;
      LB_DDATE: TLabel;
      ED_EMAIL: TFlatEdit;
      BN_ADD: TFlatButton;
      PN_CAPTION: TPanel;
      Panel3: TPanel;
      ImageEn1: TImageEn;
      Label3: TLabel;
      ED_TELNO1: TFlatEdit;
      ED_TELNO2: TFlatEdit;
      Label7: TLabel;
      ED_MTELNO1: TFlatEdit;
      ED_MTELNO2: TFlatEdit;
      Label2: TLabel;
      ED_TSYQ: TFlatEdit;
      FlatButton2: TFlatButton;
      Label10: TLabel;
      CB_NATION: TFlatComboBox;
      Label11: TLabel;
      Label12: TLabel;
      Label13: TLabel;
      Label15: TLabel;
      ED_IDX: TFlatEdit;
      ED_NAMEE: TFlatEdit;
      ED_SEX: TFlatEdit;
      ED_HELLO: TFlatEdit;
      FlatButton3: TFlatButton;
      function savetodb(sender: TObject): boolean;
      procedure check_pn_folio;
      procedure DealTag(Sender: Tobject; UpDown: integer; Tag: integer);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure ed_costnoExit(Sender: TObject);
      procedure ED_REMARKExit(Sender: TObject);
      procedure BN_DELClick(Sender: TObject);
      procedure BN_FHClick(Sender: TObject);
      procedure SG_JLDblClick(Sender: TObject);
      procedure BN_BCClick(Sender: TObject);
      procedure ED_NAMEExit(Sender: TObject);
      procedure ED_VIPKeyPress(Sender: TObject; var Key: Char);
      procedure ED_BIRTHKeyPress(Sender: TObject; var Key: Char);
      procedure ED_BIRTHExit(Sender: TObject);
      procedure BN_ADDClick(Sender: TObject);
      procedure SG_JLGetAlignment(Sender: TObject; ARow, ACol: Integer;
         var HAlign: TAlignment; var VAlign: TVAlignment);
      procedure ED_NAMEEExit(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_WEB_GSTINFO: TF_WEB_GSTINFO;

implementation
uses Pub_program, U_WEB_DM; //, U_RECA_USERM;
var
   updrow, arow, m_diff: integer;
   m_str: string;

   {$R *.DFM}

function TF_WEB_GSTINFO.savetodb(sender: TObject): boolean;
var
   s: string;
begin
   {try //此过程只将所有STRING-GRID 中的数据存入数据库。
      f_web_dm.hoteldb.Connected := true;
      f_web_dm.hoteldb.StartTransaction;

      with f_web_dm_wy.sp_bcagenvip_wangy do
         begin
            close;
            with sg_jl do
               for arow := 1 to rowcount - 1 do
                  begin
                     s := cells[colcount, arow];
                     if (s = 'normal') or (s = '') then
                        continue;
                     // s := 'FOLIO*10*名  称*20*消费上限*20*起始日期*10*结束日期*10*消费项目*18*备    注*30*数据状态*14*';
                     parambyname('@vno_dw').asstring := analy_str('no_dw', m_str);
                     parambyname('@vopno').asstring := gstr_pubdate;
                     parambyname('@vname').asstring := cells[0, arow];
                     parambyname('@vhello').asstring := cells[1, arow];
                     parambyname('@vvip').asinteger := strtoint(getpartstr(cells[2, arow]));

                     if cells[3, arow] = '' then
                        parambyname('@vbirth').Clear
                     else
                        parambyname('@vbirth').asdatetime := strtodate(cells[3, arow]);

                     parambyname('@vsex').asstring := getsex(cells[4, arow]);
                     parambyname('@vnation').asstring := getpartstr(cells[5, arow]);
                     parambyname('@vtelno1').asstring := cells[6, arow];
                     parambyname('@vmtelno1').asstring := cells[7, arow];
                     parambyname('@vtsyq').asstring := cells[8, arow];
                     parambyname('@vremark').asstring := cells[9, arow];
                     parambyname('@vemail').asstring := cells[10, arow];
                     parambyname('@vidx').asstring := cells[11, arow];
                     parambyname('@vnamee').asstring := cells[12, arow];
                     parambyname('@vtelno2').asstring := cells[13, arow];
                     parambyname('@vmtelno2').asstring := cells[14, arow];
                     parambyname('@vkrbm_o').asinteger := strtoint(getstr(cells[colcount + 1, arow]));
                     parambyname('@vflag').asstring := cells[colcount, arow];
                     prepare;
                     execproc;
                     cells[colcount + 1, arow] := parambyname('@vkrbm').asstring;
                  end;
            close;
         end;
      f_web_dm.hoteldb.Commit;
      f_web_dm.hoteldb.Connected := false;
      result := true;
      if sender = BN_BC then
         MessageDlg(succ_msg, mtinformation, [mbok], 0);
   except
      f_web_dm.hoteldb.Rollback;
      f_web_dm.hoteldb.Connected := false;
      MessageDlg(err_msg, mtWarning, [mbok], 0);
      result := false;
   end;}
end;

procedure TF_WEB_GSTINFO.FormClose(Sender: TObject;
   var Action: TCloseAction);
begin
   action := cafree;
end;

procedure TF_WEB_GSTINFO.FormCreate(Sender: TObject);
var
   s: string;
   i: integer;
begin
   top := gint_top;
   left := 0;
   width := gint_width;
   height := gint_height;
   clearall(sender);
   m_diff := g_diff;
   m_str := tran_str;
   updrow := -1;
   pn_caption.caption := '      ' + analy_str('no_dw', m_str) + ' - ' + analy_str('c_name', m_str) + iif(m_lang = 1, ' 公司客户设置', '  CORP GUEST SETTING');
   case m_lang of
      1: s := '姓  名*18*称谓*10*VIP*5*出生日期*11*性别*5*国籍*12*联系电话*16*移动电话*16*嗜好*21*备注*18*EMAIL*14*索引*6*英文名*16*其他电话*16*其他移动电话*16*数据状态*14*';
      2: s := 'NAME*18*HELLO*10*VIP*5*BIRTHDAY*11*SEX*5*NATION*12*TELNO_1*16*MOBIL TELNO_1*16*LIKING*21*REMARK*18*EMAIL*14*IDX*6*E.NAME*16*TELNO_2*16*MOBIL TELNO_2*16*DATA STATUS*14*';
   end;
   title_sg_wy(sg_jl, s, false);
   case m_diff of
      2:
         begin
            bn_bc.Visible := false;
            bn_add.Visible := false;
            bn_del.Visible := false;
         end;
   end;

   with f_web_dm.qy_wangy do
      begin
         close;
         sql.clear;
         sql.add('select code,name from nation order by code');
         open;
         while not eof do
            begin
               cb_nation.Items.Add(fieldbyname('code').asstring + ' - ' + fieldbyname('name').asstring);
               next;
            end;
         close;
         sql.clear;
         sql.add('select name,hello,vip,birth,sex,nation,telno1,m_telno1,tsyq,remark,email,idx,namee,telno2,m_telno2,krbm from corp_usr order by name');
         open;
         with sg_jl do
            while not eof do
               begin
                  str_grid_wy(sg_jl, arow);
                  for i := 0 to colcount - 2 do
                     case i of
                        2: cells[i, arow] := fieldbyname('vip').asstring;//vip_list[fieldbyname('vip').asinteger];
                        3:
                           if not fields.Fields[i].isnull then
                              cells[i, arow] := datetostr(fields.Fields[i].asdatetime);
                        4:
                           if not fields.Fields[i].isnull then
                              cells[i, arow] := iif(fields.Fields[i].AsInteger = 0, male_msg, fema_msg);
                        5: cells[i, arow] := fieldbyname('nation').asstring;//search_list_wy(nat_list, fields.Fields[i].AsString);
                        else
                           cells[i, arow] := fields.Fields[i].asstring;
                     end;
                  cells[colcount, arow] := 'normal';
                  cells[colcount + 1, arow] := fieldbyname('krbm').asstring;
                  next;
               end;
         close;
         bztomc_wy(sg_jl, sg_jl.colcount, sg_jl.colcount - 1);
      end;
   cb_nation.ItemIndex := -1;
   pn_vip.Enabled := false;
   colorpn_wy(pn_vip, pn_vip.Color);
end;

procedure TF_WEB_GSTINFO.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   case Key of
      VK_Escape: bn_fhclick(sender);
      VK_F2:
         if bn_bc.Visible and bn_bc.Enabled then
            bn_bcclick(sender);
      VK_F3:
         if bn_add.Visible and bn_add.Enabled then
            bn_addclick(sender);
      VK_RETURN: Perform(WM_NEXTDLGCTL, 0, 0);
      VK_SPACE:
         if (ActiveControl.ClassType = TFlatComboBox) then
            (ActiveControl as TFlatComboBox).droppeddown := true
         else
            if (ActiveControl.Tag > 0) then
            DealTag(sender, 1, ActiveControl.Tag);
      VK_UP:
         if not (ActiveControl.ClassType = TFlatComboBox) then
            Perform(WM_NEXTDLGCTL, 1, 0);
      VK_DOWN:
         if not (ActiveControl.ClassType = TFlatComboBox) then
            Perform(WM_NEXTDLGCTL, 0, 0);
   end;
end;