mainfrm.pas

个用VC编写的仓库管理小系统

unit mainfrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RzButton, ExtCtrls, RzPanel, RzBckgnd, RzGroupBar,ImgList,RzForms,StdCtrls,
  ScktComp,GeneralInf, RzLabel, RzTray,mmsystem,RzCommon, Magnetic,Logfrm,
  RegUser, Chatfrm, FileCtrl, Buttons,CoolMenuPro,Menus;


Const
  AllowNumber=10;
  UM_Destroy=WM_User+102;


type

  TInitData=Record
    IP:string[15];
    Port:integer;
    AutoSave:Boolean;
    OnTop:Boolean;
    ShowOnHint:Boolean;
    ShowOffHint:Boolean;
    PlayWave:Boolean;
    Path:string[255];
  end;

  TSession=Record
    Msg:string;
    Handle:string;
    Param1:string;
    Param2:string;
    Param3:string;
    Param4:string;
    Param5:string;
    Param6:string;
  end;

  TfrmMain = class(TForm)
    ImageList1: TImageList;
    RzPanel1: TRzPanel;
    GB: TRzGroupBar;
    GPLogin: TRzGroup;
    GPFriend: TRzGroup;
    c: TClientSocket;
    Tray1: TRzTrayIcon;
    ImageList2: TImageList;
    RegIni1: TRzRegIniFile;
    Magnetic1: TMagnetic;
    RzLabel1: TRzLabel;
    RzShapeButton1: TRzShapeButton;
    ImageList3: TImageList;
    RzGroup1: TRzGroup;
    Timer1: TTimer;
    RzFormState1: TRzFormState;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure GPLoginItems2Click(Sender: TObject);
    procedure GPLoginItems0Click(Sender: TObject);
    procedure GPLoginItems1Click(Sender: TObject);
    procedure cError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure cRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure RzShapeButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Tray1LButtonDblClick(Sender: TObject);
    procedure RzGroup1Items0Click(Sender: TObject);
    procedure cConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure RzGroup1Items2Click(Sender: TObject);
    procedure RzGroup1Items3Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure WMQueryEndSession(var Msg: TMessage);message WM_QueryEndSession;
    procedure MoveIn(var msg:Tmessage);message CM_MOUSEENTER;
    procedure MoveOut(var msg:Tmessage);message CM_MOUSELEAVE;
    function CreateChatFrm(ID:string;Index:integer;ExecGame:Boolean):TfrmChat;
    function FindFormByID(ID:string):integer;
    procedure CreateInitData;
    procedure UMDestroy(var Message : TMessage); message UM_Destroy;
    //function GetUserInfo(AUserName,ALogined,ASex,AHandle,AID:Pchar):AUserInfo;
  public
    { Public declarations }
    RecText:PPs;
    frmIndex:integer;//聊天对话框索引,唯一值
    UserInfo:PUserInfo;
    Logined,Registered:Boolean;
    FileStream:TFileStream;
    InitData:TInitData;
    hRes:THandle;
    PstrSound:Pchar;
    IsSrvStart:Boolean;
    LoseSession:Boolean;
    Receive:Boolean;
    Sent:Boolean;

    myName,myID,myHandle,myHost,myAddress:string;
    mySex:byte;
    myImgIndex:integer;

    ChatUsersID,FIFOIndex:TStrings;
    frmChat:array of TfrmChat;
    procedure Send(Msg,Handle,Param1,Param2,Param3,Param4,Param5,Param6:string);
    procedure RefreshStates;
    procedure ItemClick(sender:Tobject);
    procedure MoreClick(sender:TObject);
    procedure MenuItemClick(sender:TObject);
    procedure UpDateUserState(User:TRZGroupItem;Name,Sex:string; Logined:Boolean);
    procedure GetmyIP(var Host,Address:string);
    procedure ShowChatFrm(ID:string);
    procedure Write(AfileName:string;var Text:string);
    function Read(AfileName:string):string;
    procedure Information(msg:string);
    procedure UpdateUserMenu(User:TCoolItem95;Name,Sex:string; Logined:Boolean);
    function GetTextID(Text: string; BreakSymbol: string = '.'): string;
    function GetTextName(Text: string; BreakSymbol: string = '.'): string;
    procedure DisplayText(Lines:TStrings;NewText,UserName:string);overload;
    procedure DisplayText(Lines:TStrings;NewText:string);overload;
    procedure GameExec(frm:TfrmChat;Index:integer;Flag,Style,extr,CommandText,Station,AUserHandle:string);
  end;

  TUserInfoList=function (AUserName,ALogined,ASex,AHandle,AID:Pchar):PUserInfo;stdcall;

var
  frmMain: TfrmMain;


procedure xx(n,s:string);

implementation

uses Configfrm, UserInfofrm, Mailfrm, Adminfrm, Infofrm, CoolMenu, Russ,
  PopMenufrm;


{$R *.DFM}
{$R Sound.RES}

procedure xx(n,s:string);
var
  Txtfile:TextFile;
begin
  Assignfile(Txtfile,n);
  if fileExists(n) then
    Append(Txtfile)
  else
    Rewrite(Txtfile);
  try
    writeln(Txtfile,s);
  finally
    closefile(Txtfile);
  end;
end;

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

procedure TfrmMain.GPLoginItems0Click(Sender: TObject);
begin
  frmLogin:=TfrmLogin.Create(application);
  frmLogin.ShowModal;
end;

procedure TfrmMain.GPLoginItems1Click(Sender: TObject);
var
  i:integer;
begin
  for i:=low(frmChat) to high(frmChat) do
    if Assigned(frmChat[i]) then
      frmChat[i].Close ;

  ChatUsersID.Clear;
  UserMenu.Clear;
  UserMenu.Height:=3; 
  GPFriend.Items.clear;
  GPFriend.Height:=50 ;
  Logined:=false;
  Registered:=false;
  if (not LoseSession) then
  begin
    send('C',myHandle,myName,inttostr(mySex),myID,myHost,myAddress,'');
  end;
  RefreshStates;
end;

procedure TfrmMain.Send(Msg, Handle, Param1, Param2, Param3, Param4,
  Param5, Param6: string);
var
  TmpStr:string;
begin
  if Msg='' then Msg:='?';
  if Handle='' then Handle:='?';
  if Param1='' then Param1:='?';
  if Param2='' then Param2:='?';
  if Param3='' then Param3:='?';
  if Param4='' then Param4:='?';
  if Param5='' then Param5:='?';
  if Param6='' then Param6:='?';
  TmpStr:=Msg+#255+Handle+#255+Param1+#255+Param2+#255+Param3+#255+Param4+#255+Param5+#255+Param6;
  c.Socket.SendText(TmpStr);
end;

procedure TfrmMain.cError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  Screen.Cursor:=crdefault;
  case ErrorCode of
    10053:
      begin
        c.Socket.Close ;
        information('你与服务器的连接已断开！');
        ErrorCode:=0;
      end;
    10060:
      begin
        if assigned(frmconfig) then
          if assigned(frmconfig.c) then
          begin
            frmconfig.c.Close;
            frmconfig.c.free;
          end;
        information('网络上不存在该IP地址请重新设置！');
        ErrorCode:=0;
      end;
    10061:
      begin
        if assigned(frmconfig) then
          if assigned(frmconfig.c) then
          begin
            frmconfig.c.Close;
            frmconfig.c.free;
          end;
        information('服务器没有启动，请检查系统设置！');
        IsSrvStart:=false;
        ErrorCode:=0;
      end;
  end;
end;

procedure TfrmMain.cRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Tmps,HisText:String;
  i:integer;
  x:TRZGroupItem;
  y:TCoolItem95;
  FunHandle:Thandle;
  UserInfoList:TUserInfoList;
  ID,UserHandle:string;//注：由于Session值随时都可能发生改变,用ID,UserHandle代替
  Session:TSession;
begin//注：由于Session在这个过程相当于全局变量，值随时都可能发生改变
  Tmps:=Socket.ReceiveText;
  RecText:=GetSession(Pchar(Tmps),7);//Pchar类型转换可能有问题
  Session.Msg:=strpas(RecText^[0]);
  Session.Handle:=strpas(RecText^[1]);
  Session.Param1:=strpas(RecText^[2]);
  Session.Param2:=strpas(RecText^[3]);
  Session.Param3:=strpas(RecText^[4]);
  Session.Param4:=strpas(RecText^[5]);
  Session.Param5:=strpas(RecText^[6]);
  Session.Param6:=strpas(RecText^[7]);
  if Session.Msg ='admin' then
  begin
    if not Assigned(frmAdmin) then
      frmAdmin:=TfrmAdmin.Create(self);
    DisplayText(frmAdmin.LText.Lines,Session.Param1);
    SendMessage(frmAdmin.LText.Handle,EM_SCROLL,SB_BOTTOM,0);
    frmAdmin.show;
    flashwindow(frmAdmin.Handle,true);

    if InitData.PlayWave then
      sndplaysound(pStrSound,snd_async or snd_memory);

    if Session.Handle ='1' then
      LoseSession:=true;
  end;

  case Ord(Session.Msg[1]) of
    Ord('J')://中断游戏
      begin
        ID:=Session.Param1;
        frmIndex:=FindFormByID(ID);
        if assigned(frmChat[frmIndex]) then
        begin
          if assigned(frmChat[frmIndex].Russfrm) then
          begin
            frmChat[frmIndex].Russfrm.sSec.TextOut('对方已下线',clRed);
            frmChat[frmIndex].Russfrm.GameConnected:=False;
          end;
        end;
      end;
    Ord('P'): //游戏
      begin
        ID:=Session.Param5;
        i:=FindFormByID(ID);
        if (i<>-1) and assigned(frmChat[i]) and assigned(frmChat[i].Russfrm) then
          GameExec(frmChat[i],i,Session.Param1,Session.Param2,Session.Param4,Session.Param6,Session.Param3,frmChat[i].Russfrm.UserHandle);
      end;
    Ord('K')://对方取消游戏
      begin
        ID:=Session.Param2;
        frmIndex:=FindFormByID(ID);
        frmChat[frmIndex]:=CreateChatFrm(ID,frmIndex,false);
        frmChat[frmIndex].show;
        DisplayText(frmChat[frmIndex].BText.Lines,'对方取消了游戏...','系统消息');
      end;
    Ord('V')://对方接受游戏
      begin
        ID:=Session.Param1;
        frmIndex:=FindFormByID(ID);
        frmChat[frmIndex]:=CreateChatFrm(ID,frmIndex,true);
        frmChat[frmIndex].Show;
        //游戏窗体不能在此创建 要在获得用户信息之后再创建
        //frmChat[frmIndex].CreateRussfrm;
      end;
    Ord('I')://对方要求游戏  是否开始
      begin
        if Session.Param5='0' then
        begin
          ID:=Session.Param3;
          frmIndex:=FindFormByID(ID);
          if assigned(frmChat[frmIndex]) then
          begin
            DisplayText(frmChat[frmIndex].BText.Lines,frmChat[frmIndex].UserName+'已下线...','系统消息');
            SendMessage(frmChat[frmIndex].BText.Handle,EM_SCROLL,SB_BOTTOM,0);
          end;
        end
        else
        begin
          if MessageBox(0,Pchar(Session.Param1+'要与你玩游戏，要开始吗？'), '提示', MB_ICONASTERISK or MB_OKCANCEL) = IDOK then
          begin
            ID:=Session.Param2;
            frmIndex:=FindFormByID(ID);
            frmChat[frmIndex]:=CreateChatFrm(ID,frmIndex,true);
            frmChat[frmIndex].show;
            frmChat[frmIndex].SendToBack;
            sleep(100);
            UserHandle:=Session.Handle;
            frmmain.Send('V',frmmain.myHandle,frmmain.myName,frmmain.myID,UserHandle,ID,'0','');
            //游戏窗体不能在此创建 要在获得用户信息之后再创建
            //frmChat[frmIndex].CreateRussfrm;
          end
          else
            frmmain.Send('K',frmmain.myHandle,frmmain.myName,frmmain.myID,Session.Param3,Session.Param4,'0','');
        end;
      end;
    Ord('D')://清除掉线用户
      begin
        Send('D',myHandle,'','','','','','');
      end;
    Ord('Y')://对方取消接收文件,可判断对方端口是否被占
      begin