⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 smsform.pas

📁 delphi开发
💻 PAS
📖 第 1 页 / 共 2 页
字号:
          (doc.all.item(i).type='submit')and
          (doc.all.item(i).value=' 发送 ') then //发送按钮
       begin
           inc(ok);//=5
           if ok=7 then
             doc.all.item(i).click;
       end;
     end;
   end;
   end;
  end;
end;

procedure Tsmsfrm.SpeedButton1Click(Sender: TObject);
begin
  close;
end;

procedure Tsmsfrm.FormActivate(Sender: TObject);
begin
  myphonebook.Enabled := checkbox1.Checked;
  tv.OnMouseMove(sender,[ssleft],0,0);
  pagecontrol1.ActivePageIndex :=0;
  tv.Items[1].Selected :=true;
  tv.OnClick(sender);
  mycode.Text :=curuser.phone;
end;

procedure Tsmsfrm.CheckBox1Click(Sender: TObject);
begin
  myphonebook.Enabled :=checkbox1.Checked;
end;

procedure Tsmsfrm.PageControl1Change(Sender: TObject);
begin
   edit1.Visible :=( pagecontrol1.ActivePageIndex=2);
end;

procedure Tsmsfrm.WebDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
 i:integer;
begin

i:=cbcenter.ItemIndex;
if i=0 then
  sendsms(sender,url);
if i=1 then
  sendsohu(sender,url);
if i=2 then
  sendsina(sender,url);
if i=3 then
  sendchina(sender,url);
  btnsend.Enabled :=true;
  gb.Enabled :=true;
  pp.Visible :=false;
  pp1.Visible :=false;
end;

procedure Tsmsfrm.FormCreate(Sender: TObject);
begin
  loginfrm.showmodal;
  r:=0;
  sg.Cells[0,0]:='编号';
  sg.Cells[1,0]:='内容';
  sg.Cells[2,0]:='人气';
  sg2.Cells[0,0]:='编号';
  sg2.Cells[1,0]:='姓名';
  sg2.Cells[2,0]:='性别';
  sg2.Cells[3,0]:='手机号';
  sg2.Cells[4,0]:='备注';
  ini:=tinifile.create(extractfilepath(application.exename)+curuser.phone +'.ini');
  readini;
  updatephone;
  createico(application.ExeName,'短信发送');
//  showmessage(inttostr(length(label10.Caption)));
end;

procedure Tsmsfrm.btnsendClick(Sender: TObject);
var
  i1,i2,i3,i4:olevariant;
begin
  if length(trim(mycode.Text))<>11 then
  begin
      messagebox(handle,'请输入您的手机号码。','警告',mb_ok or mb_iconwarning);
      mycode.SetFocus;
      mycode.SelectAll;
      exit;
  end;
  if trim(mypwd.Text)='' then
  begin
      messagebox(handle,'请输入您的手机密码。','警告',mb_ok or mb_iconwarning);
      mypwd.SetFocus;
      mypwd.SelectAll;
      exit;
  end;
  if length(trim(frendcode.Text))<>11 then
  begin
      messagebox(handle,'请输入对方的手机号码。','警告',mb_ok or mb_iconwarning);
      frendcode.SetFocus;
      frendcode.SelectAll;
      exit;
  end;
  if trim( memomsg.Text)='' then
  begin
      messagebox(handle,'不能发送空消息。','警告',mb_ok or mb_iconwarning);
      memomsg.SetFocus;
      memomsg.SelectAll;
      exit;
  end;
  i1:=0;
  i2:=0;
  i3:=0;
  i4:=0;
try
  btnsend.Enabled :=false;
  gb.Enabled :=false;
  pp1.Visible :=true;
  pp.Visible :=true;
  application.ProcessMessages;
  web.Navigate(url,i1,i2,i3,i4);
  pagecontrol1.ActivePageIndex :=2;
  pagecontrol1.OnChange(sender);
except
  btnsend.Enabled :=true;
  gb.Enabled :=true;
  pp1.Visible :=true;
  pp.Visible :=false;
end;
end;

procedure Tsmsfrm.WebBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  edit1.Text :=url;
end;

procedure Tsmsfrm.mycodeClick(Sender: TObject);
begin
  mycode.SelectAll ;
end;

procedure Tsmsfrm.mypwdClick(Sender: TObject);
begin
  mypwd.SelectAll;
end;

procedure Tsmsfrm.frendcodeClick(Sender: TObject);
begin
  frendcode.SelectAll;
end;

procedure Tsmsfrm.memomsgChange(Sender: TObject);
var
  i:integer;
  j:integer;
begin
   j:=0;
   for i:=1 to length(trim(memomsg.Text)) do
   begin
     if bytetype(trim(memomsg.Text),i-1)<>mbleadbyte then
       inc(j);
   end;
  label8.Caption :=inttostr(j);
end;

procedure Tsmsfrm.spMoved(Sender: TObject);
begin
  tv.Width :=sp.Left;
  sg.Left:=sp.Left +sp.Width;
  sg.Width :=panel3.Width -sp.Width -tv.Width-1;
end;

procedure Tsmsfrm.tvClick(Sender: TObject);
var
  st:ttreenode;
begin
  st:=nil;
  if tv.Selected =nil then exit;
  if tv.Selected <>nil then
    st:=tv.Selected;
  if (st=tv.Items[0])or(st=tv.Items[2]) then
    exit;
  sg.RowCount :=2;
  sg.Cells[0,1]:='';
  sg.Cells[1,1]:='';
  sg.Cells[2,1]:='';
  if (st=tv.Items[1])and(fileexists('sms1.txt')) then
    updatesg('sms1.txt');
  if (st=tv.Items[3])and(fileexists('sms3.txt')) then
    updatesg('sms3.txt');
  if (st=tv.Items[4]) and(fileexists('sms4.txt'))then
    updatesg('sms4.txt');
  if (st=tv.Items[5])and(fileexists('sms5.txt')) then
    updatesg('sms5.txt');
  if (st=tv.Items[6])and(fileexists('sms6.txt')) then
    updatesg('sms6.txt');

end;

procedure Tsmsfrm.sgMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   k:integer;
begin
   sg.MouseToCell(x,y,c,r);
   if r>0 then
   begin
     label10.Caption :='  '+sg.Cells[1,r];
     k:=length(label10.Caption);
     k:=((k-1) div 48)+1;
     k:=k*18;
     label10.Height :=k;
     memosms.Height :=k+12;
     if trim(label10.Caption) <>'' then
       memosms.Visible :=true;
     memosms.Top :=y+54;
   end
   else
     memosms.Visible :=false;
end;

procedure Tsmsfrm.tvMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i:integer;
begin
  memosms.Visible :=false;
  shape3.Pen.Color :=bkcolor;
  shape4.Pen.Color :=bkcolor;
  shape5.Pen.Color :=bkcolor;
  shape6.Pen.Color :=bkcolor;
  shape7.Pen.Color:=bkcolor;
  shape8.Pen.Color :=bkcolor;
  shape18.Pen.Color :=bkcolor;
  shape17.Visible :=true;
  for i:=9 to 14 do
  tshape(smsfrm.FindComponent('shape'+inttostr(i))).Visible :=true;
end;

procedure Tsmsfrm.sgDblClick(Sender: TObject);
begin
   if r>1 then
     memomsg.Text :=sg.Cells[1,r];
end;

procedure Tsmsfrm.SpeedButton2Click(Sender: TObject);
var
  b:boolean;
begin
   if trim(edtname.Text)='' then
   begin
       messagebox(handle,'请输入姓名。','警告',mb_ok or mb_iconwarning);
       edtname.SetFocus;
       exit;
   end;
   if (trim(edtphone.Text)='')or(length(trim(edtphone.Text))<>11) then
   begin
       messagebox(handle,'请输入朋友的手机号码(11位)。','警告',mb_ok or mb_iconwarning);
       edtphone.SetFocus;
       exit;
   end;
   b:=rb1.Checked;
   writeini(trim(edtname.Text),b,trim(edtphone.text),trim(memo1.Text));
   readini;
   updatephone;
   edtname.Clear;
   edtphone.Clear;
   memo1.Clear;
   edtname.SetFocus;
end;

procedure Tsmsfrm.sg2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   sg2.MouseToCell(x,y,c,cr);
end;

procedure Tsmsfrm.SpeedButton4Click(Sender: TObject);
begin
  if cr1<1 then exit;
  if messagebox(handle,pchar('您真的要删除"'+trim(sg2.Cells[1,cr1])+'"的联系信息吗?'),'警告',mb_yesno or mb_iconwarning)=id_yes then
  begin
      deleteini(trim(sg2.Cells[1,cr1]),trim(sg2.Cells[3,cr1]));
      readini;
      updatephone;
      cr1:=0;
  end;
end;

procedure Tsmsfrm.sg2Click(Sender: TObject);
begin
  cr1:=cr;
end;

procedure Tsmsfrm.myphonebookChange(Sender: TObject);
var
   i:integer;
begin
   if myphonebook.ItemIndex >-1 then
   begin
      frendcode.Items.Clear;
      for i:=1 to myphonebook.Items.Count do
        if trim(myphonebook.Text)=userlist[i-1].name then
        begin
            frendcode.Items.Add(userlist[i-1].phone);
        end;
      if frendcode.Items.Count >0 then
         frendcode.ItemIndex :=0;
   end;
end;

procedure Tsmsfrm.edtnameKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
  begin
     edtphone.SetFocus;
     edtphone.SelectAll;
     exit;
  end;
end;

procedure Tsmsfrm.edtphoneKeyPress(Sender: TObject; var Key: Char);
begin
  if (key<'0')or(key>'9') then
     if key<>#8 then key:=#0;

end;

procedure Tsmsfrm.SpeedButton3Click(Sender: TObject);
begin
   if cr1<1 then exit;
   modifrm.showmodal;
end;

procedure Tsmsfrm.sg2DblClick(Sender: TObject);
begin
  cr1:=cr;
  if cr1>0 then
    modifrm.ShowModal;
end;

procedure Tsmsfrm.Shape10MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  sp:tshape;
  k:string;
begin
  sp:=(sender as tshape);
  sp.Visible :=false;
  k:=sp.Name;
  k:=copy(k,6,length(k)-5);
  tshape(smsfrm.FindComponent('shape'+inttostr(strtoint(k)-6))).pen.color:=clblue;
end;

procedure Tsmsfrm.btntimesendClick(Sender: TObject);
begin
   ismodi:=true;
   regfrm.showmodal;
end;

procedure Tsmsfrm.memomsgKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then key:=#0;
end;

procedure Tsmsfrm.cbcenterChange(Sender: TObject);
var
  i:integer;
begin
  i:=cbcenter.ItemIndex;
  if i<0 then exit;
  if i=0 then
     url:='www.smschina.com';
  if i=1 then
     url:='sms.sohu.com';
  if i=2 then
     url:='sms.sina.com.cn/docs/send.html';
  if i=3 then
     url:='sms.china.com';
end;

procedure Tsmsfrm.SpeedButton5Click(Sender: TObject);
begin
  sendfrm.showmodal;
end;

procedure Tsmsfrm.Shape17MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  shape18.Pen.Color :=clblue;
  shape17.Visible :=false;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -