u_web_plan.pas

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

         while not eof do
            begin
               cb_type.Items.Add(fieldbyname('code').asstring + ' - ' + fieldbyname('name').asstring);
               next;
            end;
         close;
      end;
   {with f_web_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select msgid,adate,ddate,opno,memo,date,mdate from compmsg where opno_in=:vopno_in');
         parambyname('vopno_in').asstring := gstr_myacc;
         open;
         with sg_jl do
            while not eof do
               begin
                  str_grid_wy(sg_jl, arow);
                  for i := 0 to colcount - 1 do
                     case i of
                        1, 2: cells[i, arow] := datetostr(fields.Fields[i].asdatetime);
                        5, 6: cells[i, arow] := datetostr(fields.Fields[i].asdatetime, 1);
                        else
                           cells[i, arow] := fields.Fields[i].asstring;
                     end;
                  next;
               end;
         close;
      end; }
   //sg_jl.row := 1;
end;

procedure TF_WEB_PLAN.DealTag(Sender: Tobject; UpDown: integer; Tag: integer);
var
   i: integer;
begin
   case Tag of
      1: BN_ROOMClick(sender);
      {2: ed_vip.Text := nextvip(trim(ed_vip.text), updown);
      4:
         begin
            if (trim(ed_ctl.text) = '') then
               i := 0
            else
               i := strtoint(copy(trim(ed_ctl.text), 1, 1));
            if i = 1 then
               ed_ctl.Text := forbid_msg
            else
               ed_ctl.Text := permit_msg;
         end;
      7: BN_gzClick(sender); }
      20:
         if ActiveControl is TFlatComboBox then
            TFlatComboBox(ActiveControl).DroppedDown := true;
   end;
end;

procedure TF_WEB_PLAN.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   case Key of
      VK_RETURN:
         if activecontrol.ClassType <> TMemo then
            Perform(WM_NEXTDLGCTL, 0, 0);
      VK_Escape: close;
      VK_SPACE:
         if (ActiveControl.ClassType = TFlatComboBox) then
            (ActiveControl as TFlatComboBox).droppeddown := true
         else
            if (ActiveControl.Tag > 0) then
            DealTag(sender, 1, ActiveControl.Tag);
      VK_F2:
         if bn_bc.Enabled and bn_bc.Visible then
            bn_bcclick(sender);
      VK_F3:
         if bn_xz.Enabled and bn_xz.Visible then
            bn_xzclick(sender);
      VK_F4:
         if bn_prn.Enabled and bn_prn.Visible then
            bn_prnclick(sender);
      VK_F5:
         if bn_locate.Enabled and bn_locate.Visible then
            bn_locateclick(sender);
   end;
end;

procedure TF_WEB_PLAN.SG_JLDblClick(Sender: TObject);
begin
   clearpn_wy(pn_vip, true);
   with sg_jl do
      begin
         if (row = 0) then
            abort;
         if not check_sg(sg_jl, row, true) then
            abort;
         updrow := row;
         arow := updrow;
         ed_adate.text := cells[1, arow];
         ed_ddate.text := cells[2, arow];
         ed_opno.text := cells[3, arow];
         ed_plan.text := cells[4, arow];
      end;
   mm_memo.clear;

   bn_prn.Enabled := true;
   //bn_del.Enabled := true;
   enablepn_wy(pn_vip, true);
   colorpn_wy(pn_vip, clwhite);
   ed_adate.SetFocus;
end;

procedure TF_WEB_PLAN.ED_ADATEKeyPress(Sender: TObject; var Key: Char);
begin
   key := only_dat(key);
end;

procedure TF_WEB_PLAN.BN_XZClick(Sender: TObject);
var
   s: string;
begin
   pn_vip.Enabled := true;
   clearpn_wy(pn_vip, true, true);
   //bn_del.enabled := false;
   ed_adate.Text := datetostr(date);
   ed_ddate.Text := datetostr(date + 1);
   ed_atime.Text := '13:30';
   ed_dtime.Text := '12:00';

   enablepn_wy(pn_vip, true);
   colorpn_wy(pn_vip, clwhite);
   ed_adate.SetFocus;
end;

procedure TF_WEB_PLAN.FormActivate(Sender: TObject);
begin
   if windowstate <> wsMaximized then
      windowstate := wsMaximized;
end;

procedure TF_WEB_PLAN.BN_LOCATEClick(Sender: TObject);
begin
   sg_locate_wy(sg_jl, sg_jl.colcount + 8);
   sg_jl.ColCount := sg_jl.colcount + 9;
   sg_jl.SortByColumn(sg_jl.ColCount - 1);
   sg_jl.ColCount := sg_jl.colcount - 9;
   setcursor(crDefault);
   sg_jl.Row := 1;
   sg_jl.Repaint;
end;

procedure TF_WEB_PLAN.SG_JLGetCellColor(Sender: TObject; ARow,
   ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
var
   i: integer;
begin
   if arow > 0 then
      with sg_jl do
         begin
            ABrush.color := clwhite;
            i := strtoint(getstr(cells[colcount * 3 + 10, arow]));
            if i = 1 then
               ABrush.color := clInfoBk;
         end;
end;

procedure TF_WEB_PLAN.CB_DEPNOKeyPress(Sender: TObject; var Key: Char);
begin
   key := only_num(key);
end;

procedure TF_WEB_PLAN.ED_ADATEExit(Sender: TObject);
begin
   if (Sender as TFlatEdit).Text = '' then
      abort;
   if not (verifydate(sender)) then
      (Sender as TFlatEdit).SetFocus;
   if sender = ED_ADATE then
      begin
         if (strtodate(ed_adate.text) - strtodate(gstr_pubdate)) < 0 then
            begin
               MessageDlg(lb_adate.caption + pre_msg + sys_day, mtinformation, [mbok], 0);
               ed_adate.SetFocus;
               abort;
            end;
      end
   else
      begin
         if (strtodate(ed_ddate.text) - date) < 0 then
            begin
               MessageDlg(lb_ddate.caption + pre_msg + sys_day, mtinformation, [mbok], 0);
               ed_ddate.SetFocus;
               abort;
            end;
         if (strtodate(ed_ddate.Text) - strtodate(ed_adate.Text)) < 0 then
            begin
               MessageDlg(lb_ddate.Caption + pre_msg + lb_adate.Caption + '!', mtinformation, [mbok], 0);
               if ed_ddate.enabled then
                  ed_ddate.SetFocus;
               abort;
            end;
      end;
end;

procedure TF_WEB_PLAN.ED_PLANExit(Sender: TObject);
begin
   ed_plan.Text := uppercase_wy(ed_plan.text);
end;

procedure TF_WEB_PLAN.BN_PRNClick(Sender: TObject);
begin
   if not check_sg(sg_jl) then
      begin
         messagedlg(nodata_msg, mtinformation, [mbok], 0);
         exit;
      end;
   tran_str := 'caption:[' + gstr_myacc + '] 事务清单' + '*colcount:' + inttostr(lastcol_sg(sg_jl)) + '*rowcount:' + inttostr(sg_jl.rowcount) + '*';
   F_WEB_GRIDPRN := TF_WEB_GRIDPRN.Create(self);
   F_WEB_GRIDPRN.colselecth(sg_jl);
   F_WEB_GRIDPRN.only_length;
   F_WEB_GRIDPRN.Showmodal;
end;

procedure TF_WEB_PLAN.CB_DEPNOExit(Sender: TObject);
begin
   if not analy_com_wy(sender) then
      begin
         (sender as TFlatComboBox).droppeddown := true;
         exit;
      end;
end;

procedure TF_WEB_PLAN.BN_ROOMClick(Sender: TObject);
begin
   g_diff := 1;
   tran_str := 'accno:' + getstr(ed_opno.Text) + '*';
   F_WEB_VNO := tF_WEB_VNO.Create(self);
   F_WEB_VNO.ShowModal;
   case g_diff of
      0: ed_opno.text := '';
      1: ed_opno.text := analy_str('opno', tran_str);
   end; {}
   ed_opno.SetFocus;
end;

procedure TF_WEB_PLAN.SG_JLGetAlignment(Sender: TObject; ARow,
   ACol: Integer; var HAlign: TAlignment; var VAlign: TVAlignment);
begin
   case arow of
      0: HAlign := tacenter;
   end;
end;

procedure TF_WEB_PLAN.FormMouseWheel(Sender: TObject; Shift: TShiftState;
   WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
   if activecontrol = ED_ADATE then
      ed_adate.Text := inc_date(ed_adate.text, WheelDelta)
   else
      if activecontrol = ED_DDATE then
      ed_ddate.Text := inc_date(ed_ddate.text, WheelDelta)
   else
      if activecontrol = ED_ATIME then
      ed_atime.Text := inc_time(ed_atime.text, WheelDelta)
   else
      if activecontrol = ED_DTIME then
      ed_dtime.Text := inc_time(ed_dtime.text, WheelDelta);
   Handled := true;
end;

end.