utxlxz.pas

实现短信的收发应用非常的方便,系统很小直接使用不需安装

unit utxlxz;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ImgList, Menus, DB, DBTables,
  Buttons, ADODB, ToolWin;

type
  Tfrmtxlxz = class(TForm)
    Panel1: TPanel;
    TreeView2: TTreeView;
    PopupMenu1: TPopupMenu;
    N26: TMenuItem;
    N27: TMenuItem;
    Shape1: TShape;
    Label4: TLabel;
    Shape2: TShape;
    SpeedButton1: TSpeedButton;
    ImageList2: TImageList;
    qt1: TADOQuery;
    qt2: TADOQuery;
    qt3: TADOQuery;
    SpeedButton4: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ListBox2: TListBox;
    ToolBar1: TToolBar;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView2DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure TreeView2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmtxlxz: Tfrmtxlxz;

implementation
uses udb,Udxxj;
{$R *.dfm}

procedure Tfrmtxlxz.FormCreate(Sender: TObject);
var
 treenode,treenode1,treenode2,treenode3:ttreenode;
begin
    ToolBar1.Left:=listbox2.Left;
    ToolBar1.Top:=listbox2.Top+listbox2.Height+5;
    treeview2.items.clear;
    treenode:=treeview2.items.add(nil,'通讯录');
    treenode.HasChildren := true;
    treenode.ImageIndex := 0;
    treenode.SelectedIndex := 0;
    runsql(qt1,'select * from fz');
    with TreeView2.Items do
    begin
        while not qt1.eof do
        begin
            treenode1:=addchild(treenode,trim(qt1.fieldbyname('fzname').asstring));
            treenode1.ImageIndex := 1;
            treenode1.SelectedIndex := 2;
            //开始加第二层的内容：人员
               runsql(qt2,'select * from txl where fzid='''+trim(qt1.fieldbyname('fzid').asstring)+'''');
               while not qt2.Eof do
               begin
               treenode2:=addchild(treenode1,trim(qt2.fieldbyname('name').asstring));
               treenode2.ImageIndex := 3;
               treenode2.SelectedIndex := 4;
               //开始第三层：手机号，私人电 话，
                  runsql(qt3,'select * from txl where txlid='''+trim(qt2.fieldbyname('txlid').asstring)+'''');
                  while not qt3.Eof do
                  begin
                  //加个人具体信息
                    if  trim(qt3.fieldbyname('sex').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'性别：'+trim(qt3.fieldbyname('sex').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('telsj').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'手机号：'+trim(qt3.fieldbyname('telsj').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('telsr').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'私人电话：'+trim(qt3.fieldbyname('telsr').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('email').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'电子邮件：'+trim(qt3.fieldbyname('email').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('qz').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'传真：'+trim(qt3.fieldbyname('qz').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('telgs').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'公司电话：'+trim(qt3.fieldbyname('telgs').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('gsname').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'公司名称：'+trim(qt3.fieldbyname('gsname').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('ssbm').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'所属部门：'+trim(qt3.fieldbyname('ssbm').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                    if  trim(qt3.fieldbyname('xxdz').asstring)<>'' then
                    begin
                    treenode3:=addchild(treenode2,'联系地址：'+trim(qt3.fieldbyname('xxdz').asstring));
                    treenode3.ImageIndex := 5;
                    treenode3.SelectedIndex := 6;
                    end;
                  //加个人具体信息结束
                  qt3.Next;
                  end;
               //结束第三层
               qt2.Next;
               end;
            //结束第二层
            qt1.next;
        end;
    end;
end;

procedure Tfrmtxlxz.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbleft then
  begin
  releasecapture;
  perform(wm_syscommand,$f012,0);
  end;
end;

procedure Tfrmtxlxz.TreeView2DblClick(Sender: TObject);
var
 seltxlnode:Ttreenode;
 seltxlstr:string;
 strtest:string;
 laststr:string;
 
begin
if ((treeview2.Selected.Level =1) or (treeview2.Selected.Level =2)) then
  begin
    seltxlnode:=treeview2.Selected;
    seltxlstr:=seltxlnode.Text;
    //开始给发送窗口的手机号栏
    //开始分析窗口中的是否有逗号,如果有表示字符的累加,如果没有就直接赋值;
         laststr:='';//初始化最后edit2的值
         strtest:='';//初始化测试值
         strtest:=frmdxxj.Edit2.Text;
         if strtest<>'' then
         begin
           if (strtest[length(strtest)]=',') then//如果有逗号
           begin
             laststr:=strtest+seltxlstr;
             frmdxxj.Edit2.Text:=laststr;
             frmtxlxz.Close;
           end
           else
           begin
           frmdxxj.Edit2.Text:=seltxlstr;
           frmtxlxz.Close;
           end;
           end
           else
           begin
           frmdxxj.Edit2.Text:=seltxlstr;
           frmtxlxz.Close;
           end;
    //结束分析逗号;

    //结束写手机号
  end;
end;

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

procedure Tfrmtxlxz.TreeView2Click(Sender: TObject);
var
 i:integer;
 treenode:Ttreenode;
begin
   TreeNode:=TreeView2.Selected;
   if TreeNode<>nil then
   begin
       if treenode.Level in [0,3] then
         begin
           treenode.Selected:=false;
         end;
   end;
end;


procedure Tfrmtxlxz.SpeedButton4Click(Sender: TObject);
var
 i:integer;
begin
 ///开始检验是否存在已有的内容
  for I:=0 to treeview2.Items.Count-1 do
  begin
    if treeview2.Items.Item[i].Selected then
      begin
        if ListBox2.Items.IndexOf(trim(treeview2.Items.Item[i].text))<0 then
          begin
           listbox2.Items.Add(trim(treeview2.Items.Item[i].text));
          end;
      end;
  end;
 ///检验结束
end;

procedure Tfrmtxlxz.SpeedButton3Click(Sender: TObject);
var
  i:integer;
begin
 for I:=0 to ListBox2.Items.Count-1 do
 begin
   if ListBox2.Selected[i] then
   begin
     ListBox2.Items.Delete(i);
     break;
   end;
 end;
end;

procedure Tfrmtxlxz.ToolButton4Click(Sender: TObject);
var
  i:integer;
begin
 for I:=0 to ListBox2.Items.Count-1 do
 begin
   if ListBox2.Selected[i] then
   begin
     ListBox2.Items.Delete(i);
     break;
   end;
 end;
end;

procedure Tfrmtxlxz.ToolButton2Click(Sender: TObject);
var
 sendstr:string;
 i:integer;
begin
  sendstr:='';////实现发送字符的初始化
  for i:=0 to ListBox2.Items.Count-1 do
  begin
    sendstr:=sendstr+ListBox2.Items.Strings[i]+',';
  end;
  frmdxxj.Edit2.Text:=sendstr;
  close;//关闭现在的窗口
end;

end.