myinforset.pas

絮语2007视频聊天软件源程序.仅供参考

unit myinforset;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,mmsystem,
  StdCtrls, ComCtrls, ExtCtrls,inifiles, Buttons, jpeg, Menus,
  syshot,gifimage, Mask, constunt,xpButton, Spin;

type
  Tmyinfor_set = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Bevel2: TBevel;
    uname: TEdit;
    TabSheet3: TTabSheet;
    Label1: TLabel;
    Bevel1: TBevel;
    myimg: TImage;
    TabSheet5: TTabSheet;
    Bevel6: TBevel;
    Label4: TLabel;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    audioinlist: TComboBox;
    audiooutlist: TComboBox;
    CheckBox13: TCheckBox;
    GroupBox3: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    hotkey2: THotKey;
    GroupBox6: TGroupBox;
    CheckBox3: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    Label6: TLabel;
    tel: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    GroupBox5: TGroupBox;
    Edit3: TEdit;
    Edit4: TEdit;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    GroupBox7: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    xpButton1: TxpButton;
    memo1: TRichEdit;
    xpButton2: TxpButton;
    xpButton4: TxpButton;
    xpButton5: TxpButton;
    xpButton6: TxpButton;
    xpButton7: TxpButton;
    xpButton16: TxpButton;
    BitBtn15: TxpButton;
    xpButton19: TxpButton;
    xpButton20: TxpButton;
    myvideo: TImage;
    GroupBox8: TGroupBox;
    RadioButton6: TRadioButton;
    Label11: TLabel;
    Label12: TLabel;
    HotKey4: THotKey;
    Label14: TLabel;
    videolist: TComboBox;
    CheckBox5: TCheckBox;
    business: TEdit;
    dept: TEdit;
    pwd1: TEdit;
    pwd2: TEdit;
    CheckBox1: TCheckBox;
    xpButton11: TxpButton;
    xpButton12: TxpButton;
    GroupBox9: TGroupBox;
    SpinEdit1: TSpinEdit;
    Label13: TLabel;
    ComboBox1: TComboBox;
    xpButton13: TxpButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    CheckBox2: TCheckBox;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Bevel3: TBevel;
    procedure CreateParams(var Params: TCreateParams);override;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox13Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure xpButton5Click(Sender: TObject);
    procedure xpButton7Click(Sender: TObject);
    procedure BitBtn15Click(Sender: TObject);
    procedure xpButton19Click(Sender: TObject);
    procedure xpButton20Click(Sender: TObject);
    procedure videolistChange(Sender: TObject);
    procedure audioinlistChange(Sender: TObject);
    procedure audiooutlistChange(Sender: TObject);
    procedure xpButton4Click(Sender: TObject);
    procedure xpButton1Click(Sender: TObject);
    procedure pwd1KeyPress(Sender: TObject; var Key: Char);
    procedure xpButton2Click(Sender: TObject);
    procedure xpButton16Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure xpButton6Click(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure xpButton11Click(Sender: TObject);
    procedure xpButton12Click(Sender: TObject);
    procedure xpButton13Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure process_custom_message(var msg:tmessage);message refresh_status;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    procedure startwave;
    procedure inituserinfo;
    procedure inimsgmemo;
    procedure initfromset;
    procedure playvideo;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  myinfor_set: Tmyinfor_set;
implementation

uses udpcores, structureunt,shareunit,richunt;

{$R *.DFM}

procedure Tmyinfor_set.CreateParams(var Params: TCreateParams);
begin
  inherited ;
  Params.WndParent := 0;
end;

procedure Tmyinfor_set.playvideo;
begin
myvideo.Picture.bitmap.Assign(udpcore.video_dx9.outbitmap);
myvideo.Invalidate;
end;

procedure Tmyinfor_set.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_media_video:playvideo;
  end;
end;

//------------------------------------------------------------------------------
// 获取声音输入输出设备信息
//------------------------------------------------------------------------------
procedure tmyinfor_set.startwave;
var
Count, i: integer;
FWaveInCaps:TWaveInCaps;
FWaveOutCaps:TWaveOutCaps;
begin

udpcore.video_dx9.video_select(videolist.items);
if videolist.Items.Count<=video_index then
   video_index:=videolist.Items.Count-1;
videolist.itemindex:=video_index;
   
Count:=waveInGetNumDevs;
for i:=0 to Count-1 do
  begin
  waveInGetDevCaps(i,@FWaveInCaps,SizeOf (TWaveInCaps));
  if (audioinlist.Items.IndexOf(FWaveInCaps.szPname)<0) then
     audioinlist.Items.Add(FWaveInCaps.szPname);
  end;

if audioinlist.items.count<=mic_index then
   mic_index:=audioinlist.items.count-1;
audioinlist.itemindex:=mic_index;

Count:=waveOutGetNumDevs;
for i:=0 to Count-1 do
  begin
  waveOutGetDevCaps(i,@FWaveOutCaps,SizeOf (FWaveOutCaps));
  if (audiooutlist.Items.IndexOf(FWaveOutCaps.szPname)<0) then
     audiooutlist.Items.Add(FWaveOutCaps.szPname);
  end;
if audiooutlist.Items.Count<=audio_index then
   audio_index:=audiooutlist.Items.Count-1;
audiooutlist.itemindex:=audio_index;

end;

procedure Tmyinfor_set.inituserinfo;
var tmp:userinfo;
    filenames:string;
begin
tmp:=udpcore.user.getuserinfoex(0);
uname.Text:=tmp.uname;
tel.text:=tmp.tel;
dept.text:=tmp.dept;
business.text:=tmp.business;
memo1.text:=tmp.mytext;
radiobutton2.Checked:=tmp.checkup=1;
radiobutton3.Checked:=tmp.checkup=2;
filenames:=udpcore.pic.getmd5tofile(tmp.md5pic);
if fileexists(filenames)then
  try
  myimg.Picture.LoadFromFile(filenames);
  myimg.Hint:=tmp.md5pic;
  except
    on EInvalidGraphic do
       myimg.Picture:= nil;
  end;
end;

procedure Tmyinfor_set.inimsgmemo;
begin
listbox1.Items.Assign(msgmemo);
edit1.Text:=revertmsg;
combobox1.itemindex:=auto_status-1;
spinedit1.Value:=status_outtime;
checkbox1.Checked:=allow_auto_status;
end;

//------------------------------------------------------------------------------
// 初始化窗体控件
//------------------------------------------------------------------------------
procedure Tmyinfor_set.initfromset;
begin
radiobutton5.checked:=playsound_pc;
hotkey2.hotkey:=systemhot_key;
hotkey4.hotkey:=bosshot_key;
edit3.text:=playwave_code;
edit4.text:=playsound_code;
Edit2.text:=autopath;

checkbox10.checked:=file_supervention;
checkbox9.checked:=newmsg_sound;
checkbox7.checked:=winstart_run;
checkbox3.checked:=newmsg_popup;
checkbox11.checked:=autoaccept_file;
checkbox12.checked:=starting_mini;
checkbox2.checked:=newpictext_ok;
checkbox5.checked:=closetomin;
checkbox13.enabled:=videoisok;
end;

procedure Tmyinfor_set.FormCreate(Sender: TObject);
var picfile:string;
begin
addhwnd(handle);
udpcore.changeLayered(handle);
picfile:=udpcore.pic.getmd5tofile(videopic);
if fileexists(picfile) then
  try
  myvideo.Picture.LoadFromFile(picfile);
  except
    on EInvalidGraphic do
       myvideo.Picture:= nil;
  end;
initrichedit(memo1);
startwave;
inituserinfo;
inimsgmemo;
initfromset;
end;

procedure Tmyinfor_set.CheckBox13Click(Sender: TObject);
begin
if videoisok then
if checkbox13.Checked then
   udpcore.video_dx9.videostart
   else udpcore.video_dx9.videostop;
end;

procedure Tmyinfor_set.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if checkbox13.checked then checkbox13.Checked:=false;
end;

procedure Tmyinfor_set.xpButton5Click(Sender: TObject);
begin
udpcore.audio_dx9.playwave;
end;

procedure Tmyinfor_set.BitBtn15Click(Sender: TObject);
begin
if videoisok then
   udpcore.video_dx9.videoseting(handle);
end;

procedure Tmyinfor_set.xpButton19Click(Sender: TObject);
begin
udpcore.audio_dx9.ACM.ChooseFormatIn(true);
end;

procedure Tmyinfor_set.xpButton20Click(Sender: TObject);
begin
udpcore.audio_dx9.ACM.ChooseFormatout(true);
end;

procedure Tmyinfor_set.videolistChange(Sender: TObject);
begin
video_index:=videolist.ItemIndex;
end;

procedure Tmyinfor_set.audioinlistChange(Sender: TObject);
begin
mic_index:=audioinlist.itemindex;
end;

procedure Tmyinfor_set.audiooutlistChange(Sender: TObject);
begin
audio_index:=audiooutlist.itemindex;
end;

procedure Tmyinfor_set.pwd1KeyPress(Sender: TObject; var Key: Char);
begin
If Key = #13 Then
  Begin
  If HiWord(GetKeyState(VK_SHIFT)) <> 0 then
     SelectNext(Sender as TWinControl,False,True)
  else
   SelectNext(Sender as TWinControl,True,True);
   Key := #0
  end;
end;

procedure Tmyinfor_set.xpButton4Click(Sender: TObject);
var newfilename,img_path:string;
begin
with topendialog.Create(nil) do
   try
   Title:='图片大小(120*120)';
   Filter:='图片文件|*.bmp;*.jpg;*.jpeg;*.gif';
   img_path:=extractfilepath(application_name)+'images\';
   InitialDir:=img_path;
   if execute then
     try
     myimg.Picture.loadfromfile(filename);
     myimg.Hint:='{'+md5encodefile(filename)+'}';
     if (extractfilepath(filename)<>img_path)
        and (not udpcore.pic.checkmd5pic(myimg.Hint)) then
        begin
        newfilename:=img_path+myimg.Hint+extractfileext(filename);
        copyfile(pchar(filename),pchar(newfilename),true);
        udpcore.pic.addpictolist(newfilename);
        end;
     except
      on EInvalidGraphic do
         myimg.Picture:= nil;
     end;
   finally
   free;
   end;
end;

procedure Tmyinfor_set.xpButton2Click(Sender: TObject);
var tmp:userinfo;
begin
if (uname.text<>'')and(tel.text<>'') and(memo1.text<>'')and
   (business.text<>'')and(dept.text<>'')and(myimg.Hint<>'') then
   begin
   tmp:=udpcore.user.getuserinfoex(0);
   tmp.uname:=uname.text;
   tmp.tel:=tel.text;
   tmp.business:=business.Text;
   tmp.dept:=dept.text;
   tmp.mytext:=memo1.text;
   tmp.md5pic:=myimg.Hint;
   udpcore.user.modifyuser(tmp.md5name,tmp);
   close;
   end;
end;

procedure Tmyinfor_set.xpButton16Click(Sender: TObject);
var tmp:userinfo;
    n:integer;
begin
n:=0;
tmp:=udpcore.user.getuserinfoex(0);
if radiobutton2.Checked then n:=1;
if radiobutton3.Checked then n:=2;
tmp.checkup:=n;
udpcore.user.modifyuser(tmp.md5name,tmp);
close;
end;

procedure Tmyinfor_set.xpButton1Click(Sender: TObject);
var tmp:userinfo;
begin
if (pwd1.text<>'')and(pwd2.text<>'') then
if (pwd1.text<>pwd2.text) then
   begin
   tmp:=udpcore.user.getuserinfoex(0);
   if tmp.pwd=md5encode(loginuser+pwd1.text) then
      begin
      tmp.pwd:=md5encode(loginuser+pwd2.text);
      udpcore.user.modifyuser(tmp.md5name,tmp);
      showmessage('密码修改成功!');
      end else showmessage('旧密码错误!');
   end;
pwd1.text:='';pwd2.text:='';
end;

procedure Tmyinfor_set.xpButton7Click(Sender: TObject);
begin
autopath:=Edit2.text;
file_supervention:=checkbox10.checked;
newpictext_ok:=checkbox2.checked;
newmsg_sound:=checkbox9.checked;
winstart_run:=checkbox7.checked;
newmsg_popup:=checkbox3.checked;
autoaccept_file:=checkbox11.checked;
starting_mini:=checkbox12.checked;
closetomin:=checkbox5.checked;
systemhot_key:=hotkey2.hotkey;
bosshot_key:=hotkey4.hotkey;
udpcore.recreate_hotkey;
close;
end;

//------------------------------------------------------------------------------
// 状态,回复
//------------------------------------------------------------------------------
procedure Tmyinfor_set.RadioButton4Click(Sender: TObject);
begin
playsound_pc:=sender=radiobutton5; 
end;

procedure Tmyinfor_set.xpButton6Click(Sender: TObject);
begin
with topendialog.Create(nil) do
   try
   Filter:='声音文件|*.wav';
   InitialDir:=extractfilepath(application_name)+'sound\';
   if execute then
     playwave_code:=filename;
   finally
   free;
   end;

end;

procedure Tmyinfor_set.Edit4Change(Sender: TObject);
begin
playsound_code:=edit4.text;
end;

procedure Tmyinfor_set.xpButton11Click(Sender: TObject);
begin
if edit1.Text<>'' then
   listbox1.items.Add(edit1.text);
end;

procedure Tmyinfor_set.xpButton12Click(Sender: TObject);
begin
if listbox1.itemindex+1>0 then;
   begin
   edit1.Text:='';
   listbox1.Items.Delete(listbox1.itemindex);
   end;
end;

procedure Tmyinfor_set.xpButton13Click(Sender: TObject);
begin
revertmsg:=edit1.text;
msgmemo.Assign(listbox1.items);
auto_status:=combobox1.itemindex+1;
status_outtime:=spinedit1.Value;
allow_auto_status:=checkbox1.checked;
close;
end;

procedure Tmyinfor_set.ListBox1Click(Sender: TObject);
begin
if listbox1.itemindex+1>0 then
   edit1.text:=listbox1.Items.Strings[listbox1.itemindex];
end;

procedure Tmyinfor_set.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
delhwnd(handle);
end;

procedure Tmyinfor_set.Button1Click(Sender: TObject);
var s:string;
begin
s:=edit2.text;
if selectpath(s) then edit2.text:=s;
end;

end.