u_web_plan.pas

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

unit U_WEB_PLAN;

interface

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

type
   TF_WEB_PLAN = class(TForm)
      PN_VIP: TPanel;
      PN_BN: TPanel;
      LB_PLAN: TLabel;
      LB_ADATE: TLabel;
      SG_JL: TAdvStringGrid;
      LB_DDATE: TLabel;
      LB_OPNO: TLabel;
      Bevel1: TBevel;
      MM_MEMO: TMemo;
      LB_MEMO: TLabel;
      Bevel2: TBevel;
      ED_ADATE: TFlatEdit;
      ED_DDATE: TFlatEdit;
      ED_ACCNO: TFlatEdit;
      ED_PLAN: TFlatEdit;
      BN_BC: TFlatButton;
      BN_XZ: TFlatButton;
      BN_PRN: TFlatButton;
      BN_LOCATE: TFlatButton;
      BN_QX: TFlatButton;
      Label1: TLabel;
      BN_ROOM: TFlatButton;
      ED_ATIME: TFlatEdit;
      ED_DTIME: TFlatEdit;
      Label2: TLabel;
      Label3: TLabel;
      CB_TYPE: TFlatComboBox;
      Label4: TLabel;
      CB_URGENT: TFlatComboBox;
      Label5: TLabel;
      CB_IMPT: TFlatComboBox;
      function savetodb(Sender: TObject; m_flag: string): boolean;
      procedure DealTag(Sender: Tobject; UpDown: integer; Tag: integer);
      procedure check_pn1(Sender: TObject);
      procedure BN_BCClick(Sender: TObject);
      procedure BN_QXClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure SG_JLDblClick(Sender: TObject);
      procedure ED_ADATEKeyPress(Sender: TObject; var Key: Char);
      procedure BN_XZClick(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure BN_LOCATEClick(Sender: TObject);
      procedure SG_JLGetCellColor(Sender: TObject; ARow, ACol: Integer;
         AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
      procedure CB_DEPNOKeyPress(Sender: TObject; var Key: Char);
      procedure ED_ADATEExit(Sender: TObject);
      procedure ED_PLANExit(Sender: TObject);
      procedure BN_PRNClick(Sender: TObject);
      procedure CB_DEPNOExit(Sender: TObject);
      procedure BN_ROOMClick(Sender: TObject);
      procedure SG_JLGetAlignment(Sender: TObject; ARow, ACol: Integer;
         var HAlign: TAlignment; var VAlign: TVAlignment);
      procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
         WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
      procedure ED_ATIMEExit(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_WEB_PLAN: TF_WEB_PLAN;

implementation
uses Pub_program, U_WEB_DM, U_WEB_LOCATE, U_WEB_GRIDPRN, U_WEB_VNO;
var
   updrow, arow: integer;
   m_caseid: string;
   {$R *.DFM}

function TF_WEB_PLAN.savetodb(sender: TObject; m_flag: string): boolean;
var
   s, s1: string;
   i, j: integer;
begin

   try //此过程只将所有STRING-GRID 中的数据存入数据库。
      f_web_dm.hoteldb.Connected := true;
      f_web_dm.hoteldb.StartTransaction;

      if m_flag = 'add'
         m_caseid := datetostr(now, 18);

      {with f_web_dm_wy2.sp_bccaseinfo_wangy do
         begin
            close;
            parambyname('@vflag').asstring := m_flag;
            parambyname('@vcaseid').asstring := m_caseid;
            parambyname('@vadate').asdatetime := strtodatetime(ed_adate.text + ' ' + ed_atime.text);
            parambyname('@vddate').asdatetime := strtodatetime(ed_ddate.text + ' ' + ed_dtime.text);
            parambyname('@vname').asstring := trim(ed_plan.text);
            parambyname('@vaccno').asstring := trim(ed_accno.text);
            parambyname('@vissuer').asstring := gstr_myaccno;
            parambyname('@vtype').asinteger := strtoint(getpartstr(cb_type.text));
            parambyname('@vurgent').asinteger := strtoint(getpartstr(cb_urgent.text));
            parambyname('@vimport').asinteger := strtoint(getpartstr(cb_impt.text));
            prepare;
            execproc;
            close;
         end;}

      with f_web_dm.qy_wangy do
         begin
            close;
            sql.Clear;
            if m_flag = 'add' then
               begin
                  s := 'insert into casedb(caseid,date,type,urgent,import,name,adate,ddate,issuer,accno)';
                  s := s + ' values(:vcaseid,getdate(),:vtype,:vurgent,:vimport,:vname,:vadate,:vddate,:vissuer,:vaccno)';
                  sql.Add(s);
                  parambyname('vissuer').asstring := gstr_myaccno;
               end
            else
               if m_flag = 'modify' then
               begin
                  s := 'update casedb set name=:vname,type=:vtype,urgent=:vurgent,import=:vimport,adate=:vadate,ddate=:vddate,accno=:vaccno where caseid=:vcaseid';
                  sql.Add(s);
               end;
            parambyname('vcaseid').asstring := m_caseid;
            parambyname('vadate').asdatetime := strtodatetime(ed_adate.text + ' ' + ed_atime.text);
            parambyname('vddate').asdatetime := strtodatetime(ed_ddate.text + ' ' + ed_dtime.text);
            parambyname('vname').asstring := trim(ed_plan.text);
            parambyname('vaccno').asstring := trim(ed_accno.text);
            parambyname('vtype').asinteger := strtoint(getpartstr(cb_type.text));
            parambyname('vurgent').asinteger := strtoint(getpartstr(cb_urgent.text));
            parambyname('vimport').asinteger := strtoint(getpartstr(cb_impt.text));
            prepare;
            execsql;
            close;
            sql.Clear;
            sql.Add('delete case_memo where caseid=:vcaseid');
            parambyname('vcaseid').asstring := m_caseid;
            prepare;
            execsql;
            close;
            sql.Clear;
            sql.Add('insert into case_memo(caseid,datano,remark) values(:vcaseid,:vdateno,:vremark)');
            prepare;
            for i := 0 to mm_detail.Lines.Count - 1 do
               begin
                  parambyname('vcaseid').asstring := m_caseid;
                  parambyname('vdatano').asinteger := i;
                  parambyname('vremark').asstring := trimright(mm_detail.Lines.Strings[i]);
                  prepare;
                  execsql;
               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, mtinformation, [mbok], 0);
      result := false;
   end;
end;

procedure TF_WEB_PLAN.BN_BCClick(Sender: TObject);
begin
   check_pn1(pn_vip);
   if not savetodb(BN_bc) then
      abort;

   with sg_jl do
      begin
         if updrow <> -1 then
            begin
               arow := updrow;
               updrow := -1;
               cells[6, arow] := datetostr(now, 1);
            end
         else
            begin
               str_grid_wy(sg_jl, arow);
               cells[5, arow] := datetostr(now, 1);
            end;

         cells[1, arow] := ed_adate.text;
         cells[2, arow] := ed_ddate.text;
         cells[3, arow] := ed_opno.text;
         cells[4, arow] := ed_plan.text;
      end;

   //if check_pn(pn_vip) then
   //   ed_planexit(ed_plan);
   enablepn_wy(pn_vip, false);
   colorpn_wy(pn_vip, $00ECF0F2);
   clearpn_wy(pn_vip, true, true);
   //bn_del.Enabled := false;
   bn_prn.Enabled := false;
end;

procedure TF_WEB_PLAN.check_pn1(Sender: TObject);
var
   s: string;
begin
   s := trim(ed_adate.Text);
   if s = '' then
      begin
         MessageDlg(lb_adate.Caption + null_msg, mtinformation, [mbok], 0);
         ed_adate.Text := gstr_pubdate;
         ed_adate.SetFocus;
         abort;
      end;
   s := trim(ed_ddate.Text);
   if s = '' then
      begin
         MessageDlg(lb_ddate.Caption + null_msg, mtinformation, [mbok], 0);
         ed_ddate.SetFocus;
         abort;
      end;
   if strtodate(ed_ddate.text) - strtodate(ed_adate.text) < 0 then
      begin
         MessageDlg(date_msg, mtinformation, [mbok], 0);
         ed_ddate.SetFocus;
         abort;
      end;

   s := trim(ed_opno.Text);
   if s = '' then
      begin
         MessageDlg(lb_opno.Caption + null_msg, mtinformation, [mbok], 0);
         ed_opno.SetFocus;
         abort;
      end;
   s := trim(ed_plan.Text);
   if s = '' then
      begin
         MessageDlg(lb_plan.Caption + null_msg, mtinformation, [mbok], 0);
         ed_plan.SetFocus;
         abort;
      end;
end;

procedure TF_WEB_PLAN.BN_QXClick(Sender: TObject);
begin
   if not noedit_sg(sg_jl) then
      if MessageDlg(asksave_msg, mtConfirmation, [mbyes, mbno], 0) = mrno then
         exit;
   close;
end;

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

procedure TF_WEB_PLAN.FormCreate(Sender: TObject);
var
   i: integer;
   s: string;
begin
   enablepn_wy(pn_vip, false);
   clearall(sender);
   updrow := -1;
   s := '事务标题*22*事务性质*12*紧急程度*12*重要性*10*相关人员*22*希望开工时间*15*希望完成时间*15*录入时间*15*提交人*8*编号*12*';
   title_sg_wy(sg_jl, s, false);
   cb_type.Clear;
   with f_web_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select name,type,urgent,import,accno,adate,ddate,date,issuer,caseid from casedb order by date');
         open;
         with sg_jl do
            while not eof do
               begin
                  str_grid_wy(sg_jl, arow);
                  for i := 0 to colcount - 1 do