mainmes.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

unit mainmes;

interface

uses Unit2,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls,shlobj,Activex,Registry, Menus, cmpTrayIcon;

type
  TfrmMain = class(TForm)
    btnExit: TBitBtn;
    Label1: TLabel;
    AddrBox: TComboBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    sbDBServer: TSpeedButton;
    SpeedButton1: TSpeedButton;
    GroupBox1: TGroupBox;
    MesText: TMemo;
    TrayIcon21: TTrayIcon2;
    PopupMenu1: TPopupMenu;
    Show1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    About1: TMenuItem;
    BitBtn1: TBitBtn;
    btnSend: TBitBtn;
    StatusLabel: TLabel;
    BitBtn2: TBitBtn;
    Label2: TLabel;
    SpeedButton2: TSpeedButton;
    procedure btnSendClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MesTextChange(Sender: TObject);
    procedure AddrBoxChange(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure sbDBServerClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Show1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    UserName : string;
    MessageHeader : TStringList;
    function ChooseComputer(parent_window: HWND; caption: String): String;
    function NetworkBrowsing(parent_window: HWND; caption: String; browse_for: Integer): String;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses about;

{$R *.DFM}


procedure TfrmMain.btnSendClick(Sender: TObject);
var
  i, res: Integer;
begin
  if AddrBox.Text <> '' then
  begin
    StatusLabel.Font.Color := clBlack;
    StatusLabel.Caption := '请稍等... ';
    Update;
    if AddrBox.Items.IndexOf(AddrBox.Text) = -1 then
      AddrBox.Items.Add(AddrBox.Text);
    res := SendMsg(AddrBox.Text,'',MessageHeader.Text+mesText.Text);
    if res = 0 then
      frmMain.StatusLabel.Font.Color := clBlue
    else
      frmMain.StatusLabel.Font.Color := clRed;
    case res of
      0    : frmMain.StatusLabel.Caption := '消息被发送';
      87   : frmMain.StatusLabel.Caption := '发送参数错误';
      123  : frmMain.StatusLabel.Caption := '发送不正确';
      2273 : frmMain.StatusLabel.Caption := '不能找到目的地: '+frmMain.AddrBox.Text;
    else     frmMain.StatusLabel.Caption := '错误: '+IntToStr(res);
    end;

  end;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  strUser : PChar;
  strSize : DWord;
begin
  strUser := StrAlloc(100);
  strSize := 100;
  GetUserName(strUser,strSize);
  UserName := strUser;
  StrDispose(strUser);
  MessageHeader := TStringList.Create;
  MessageHeader.Add('==========================================');
  MessageHeader.Add('    玄武饭店消息从: '+UserName);
  MessageHeader.Add('==========================================');
  MessageHeader.Add('[内容:]');
end;


procedure TfrmMain.MesTextChange(Sender: TObject);
begin
  StatusLabel.Caption := ' ';
end;

procedure TfrmMain.AddrBoxChange(Sender: TObject);
begin
  StatusLabel.Caption := ' ';
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
Hide;
end;
function TfrmMain.ChooseComputer(parent_window: HWND; caption: String): String;
begin
     Result:=NetworkBrowsing(parent_window, caption, BIF_BROWSEFORCOMPUTER);
end;
//
// Display a dialog box allowing the user to choose a computer, network drive,
// etc.
//
// Args: parent window (usually TForm.Handle)
//       caption to display on the dialog box, e.g. Choose Cache Server
//       what to browse for (e.g. BIF_BROWSEFORCOMPUTER for computers)
//
// Returns: computer chosen
//          empty string on error or no computer chosen
//
// Note: typical browse_for values are
//
//   BIF_RETURNONLYFSDIRS for networked folders
//   BIF_BROWSEFORCOMPUTER for computers
//
function TfrmMain.NetworkBrowsing(parent_window: HWND; caption: String; browse_for: Integer): String;
var lpbi: _browseInfo;
    dn: String;
    idlist: ITEMIDLIST;
    ridlist: PITEMIDLIST;
    ppMalloc: IMalloc;
begin
     try
        // Get pointer to network root
        SHGetSpecialFolderLocation(parent_window, CSIDL_NETWORK, PITEMIDLIST(idlist));

        // Initialise & display dialog box
        lpbi.hwndOwner:=parent_window;
        lpbi.pidlRoot:=PITEMIDLIST(idlist);
        SetLength(dn, 255);
        lpbi.pszDisplayName:=PChar(dn);
        lpbi.lpszTitle:=PChar(caption);
        lpbi.ulFlags:=browse_for;
        lpbi.lpfn:=nil;
        ridlist:=SHBrowseForFolder(lpbi);

           // Return only the name of the 'thing' selected
           Result:=lpbi.pszDisplayName;

        // Free memory
        if ridlist=nil then
           Result:=''
        else begin
           SHGetMalloc(ppMalloc);
           ppMalloc.Free(ridlist);
        end;
     except
        // Oops
        Result:='';
     end;
end;

procedure TfrmMain.sbDBServerClick(Sender: TObject);
var add:string;
    i:integer;
begin
   add:= ChooseComputer (self.Handle, Caption);

    for i:=0 to AddrBox.Items.Count-1 do begin
        if add=AddrBox.Items.Strings[i] then exit;
    end;
   AddrBox.Items.Add(add);
   AddrBox.ItemIndex:=AddrBox.Items.IndexOf(add);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Reg: TRegistry;
  s:string;
  i:integer;
  b:boolean;
begin

  if AddrBox.Text<>'' then begin
        for i:=0 to AddrBox.Items.Count-1 do begin
            if AddrBox.Text=AddrBox.Items.Strings[i] then
               b:=true;
        end;
  if not b then
    AddrBox.Items.Add(AddrBox.Text);

  end;


if AddrBox.Items.Count<>0 then begin


  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software\xwfd\Message', True) then
   begin
      Reg.WriteString('Count',InttoStr(AddrBox.Items.Count));
      for i:=0 to AddrBox.Items.Count-1 do begin
          s:=AddrBox.Items.Strings[i];
          Reg.WriteString(IntToStr(i),s);
      end;

      Reg.CloseKey;
    end;
  finally
    Reg.Free;
    inherited;
  end;


  end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
var
  Reg: TRegistry;
  s:string;
  i:integer;
begin
  Reg := TRegistry.Create;
  AddrBox.Clear;
  try
   Reg.RootKey := HKEY_CURRENT_USER;
   if Reg.OpenKey('\Software\xwfd\Message', True) then
   begin
      if reg.ReadString('Count')='' then exit;
      i:=StrToInt(reg.ReadString('Count'));
      for i:=0 to i-1 do begin
            s:=Reg.ReadString(IntToStr(i));
            AddrBox.Items.Add(s);
       end;
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
    inherited;
  end;


end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);
begin
 if AddrBox.Text='' then exit;
 if MessageDlg('你想删除地址:'+''''+AddrBox.Text+''''+'吗?',
    mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;


  AddrBox.Items.Delete(AddrBox.Items.IndexOf(AddrBox.Text));

end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
close;
end;

procedure TfrmMain.About1Click(Sender: TObject);
begin
 frmAbout.ShowModal;
end;

procedure TfrmMain.Show1Click(Sender: TObject);
begin
  Show;
end;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
begin
 Close;
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
var
  i,j:integer;
begin
  i:=AddrBox.Items.Count;
  if i=0 then exit;
  if MessageDlg('你想发送给所有成员吗?',
     mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;

  for j:=0 to i-1 do begin
      AddrBox.ItemIndex:=j;
      btnSend.Click;

  end;

end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);
var
  Reg: TRegistry;
  s:string;
  i:integer;
begin
 if MessageDlg('你想清除所有地址吗?',
    mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;


 if AddrBox.Items.Count<>0 then begin
   Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    reg.DeleteKey('\Software\xwfd\Message');
    AddrBox.Clear;
    Reg.CloseKey;
  finally
    Reg.Free;
    inherited;
  end;


  end;

end;

end.