📄 mainfrm.pas

📁 个用VC编写的仓库管理小系统
💻 PAS
📖 第 1 页 / 共 4 页
字号:
                        GPFriend.Items.Delete(i);
                        x:=GPFriend.Items.Add;
                        with Session do
                          UpdateUserState(x,Param1,Param2,(Param3='1'));
                      end;
                    end
                    else
                    begin
                      ChatUsersID.Delete(i-AllowNumber);//减
                      UserMenu.RemoveItem(i-AllowNumber);
                      y:=TCoolItem95.Create(self);
                      with Session do
                        UpDateUserMenu(y,Param1,Param2,(Param3='1'));
                      UserMenu.AddItem(y);
                    end;
                  end;
                  break;
                end;
          end;
          if Session.Param4 ='1' then //检查是否是刚注册登录的用户
          begin
            if Assigned(Userinfo^) then
            begin
              SetLength(UserInfo^,high(UserInfo^)+1+1);
              setLength(frmChat,high(UserInfo^)+1+1);
            end
            else
            begin
              SetLength(UserInfo^,1);
              setLength(frmChat,1);
            end;

            GetMem(UserInfo^[high(UserInfo^)].UserName,length(Session.Param1)+1);
            GetMem(UserInfo^[high(UserInfo^)].Logined,length(Session.Param3)+1);
            GetMem(UserInfo^[high(UserInfo^)].Sex,length(Session.Param2)+1);
            GetMem(UserInfo^[high(UserInfo^)].Handle,length(Session.Handle)+1);
            GetMem(UserInfo^[high(UserInfo^)].ID,length(Session.Param5)+1);

            StrPCopy(UserInfo^[high(UserInfo^)].UserName,Session.Param1);
            StrPCopy(UserInfo^[high(UserInfo^)].Logined,Session.Param3);
            StrPCopy(UserInfo^[high(UserInfo^)].Sex,Session.Param2);
            StrPCopy(Userinfo^[high(UserInfo^)].Handle,Session.Handle);
            StrPCopy(Userinfo^[high(UserInfo^)].ID,Session.Param5);

            if UserMenu.ControlCount =0 then
            begin
              ChatUsersID.Insert(0,Session.Param5);
              if GPFriend.Items.Count <AllowNumber then
              begin
                GPFriend.Update;
                x:=TRZGroupItem(GPFriend.Items.Insert(0));
                with Session do
                  UpdateUserState(x,Param1,Param2,(Param3='1'));
              end
              else if GPFriend.Items.Count =AllowNumber then//往菜单加
              begin
                GPFriend.Update;
                x:=GPFriend.Items.Add;
                x.ImageIndex :=-1;
                x.DisabledIndex :=-1;
                x.Caption:='更多...';
                x.OnClick :=MoreClick;

                y:=TCoolItem95.Create(self);
                UserMenu.Height :=UserMenu.Height +y.Height ;
                with GPFriend.Items[GPFriend.Items.Count-2] do
                  UpDateUserMenu(y,Caption,inttostr(ImageIndex-3),Enabled);
                UserMenu.InsertItem(0,y);

                GPFriend.Update;
                GPFriend.Items.Delete(GPFriend.Items.Count-2);
                x:=TRZGroupItem(GPFriend.Items.Insert(0));
                with Session do
                  UpdateUserState(x,Param1,Param2,(Param3='1'));
              end
            end
            else
            begin
              ChatUsersID.Insert(0,Session.Param5);
              y:=TCoolItem95.Create(self);
              UserMenu.Height :=UserMenu.Height +y.Height ;
              with GPFriend.Items[GPFriend.Items.Count-2] do
                UpDateUserMenu(y,Caption,inttostr(ImageIndex-3),Enabled);
              UserMenu.InsertItem(0,y);

              GPFriend.Update;
              GPFriend.Items.Delete(GPFriend.Items.Count-2);
              x:=TRZGroupItem(GPFriend.Items.Insert(0));
              with Session do
                UpdateUserState(x,Param1,Param2,(Param3='1'));
            end;
          end;
          if  Session.Param4='2' then//检查用户是否是由administrator添加的
          begin
            if Assigned(Userinfo^) then
            begin
              SetLength(UserInfo^,high(UserInfo^)+1+1);
              setLength(frmChat,high(UserInfo^)+1+1);
            end
            else
            begin
              SetLength(UserInfo^,1);
              setLength(frmChat,1);
            end;

            GetMem(UserInfo^[high(UserInfo^)].UserName,length(Session.Param1)+1);
            GetMem(UserInfo^[high(UserInfo^)].Logined,length(Session.Param3)+1);
            GetMem(UserInfo^[high(UserInfo^)].Sex,length(Session.Param2)+1);
            GetMem(UserInfo^[high(UserInfo^)].Handle,length(Session.Handle)+1);
            GetMem(UserInfo^[high(UserInfo^)].ID,length(Session.Param5)+1);

            StrPCopy(UserInfo^[high(UserInfo^)].UserName,Session.Param1);
            StrPCopy(UserInfo^[high(UserInfo^)].Logined,Session.Param3);
            StrPCopy(UserInfo^[high(UserInfo^)].Sex,Session.Param2);
            StrPCopy(Userinfo^[high(UserInfo^)].Handle,Session.Handle);
            StrPCopy(Userinfo^[high(UserInfo^)].ID,Session.Param5);

            if UserMenu.ControlCount =0 then
            begin
              ChatUsersID.Add(Session.Param5);
              if GPFriend.Items.Count <AllowNumber then
              begin
                GPFriend.Update;
                x:=TRZGroupItem(GPFriend.Items.Add);
                with Session do
                  UpdateUserState(x,Param1,Param2,false);
              end
              else if GPFriend.Items.Count =AllowNumber then//往菜单加
              begin
                GPFriend.Update;
                x:=GPFriend.Items.Add;
                x.ImageIndex :=-1;
                x.DisabledIndex :=-1;
                x.Caption:='更多...';
                x.OnClick :=MoreClick;

                y:=TCoolItem95.Create(self);
                UserMenu.Height :=UserMenu.Height +y.Height ;
                with Session do
                  UpDateUserMenu(y,Param1,Param2,false);
                UserMenu.AddItem(y)
              end
            end
            else
            begin
              ChatUsersID.Add(Session.Param5);
              y:=TCoolItem95.Create(self);
              UserMenu.Height :=UserMenu.Height +y.Height ;
              with Session do
                UpDateUserMenu(y,Param1,Param2,false);
              UserMenu.AddItem(y);
            end;
          end;
        end;
      end;

  end;
  //Dispose(RecText);
end;

procedure TfrmMain.RefreshStates;
begin
  GPLogin.Items[0].Enabled :=not Logined;
  GPLogin.Items[1].Enabled :=Logined;
  RzGroup1.Items[3].Enabled :=Logined;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  hResInfo:THandle;
begin
  hResInfo:=FindResource(HInstance,'Sound1','WAV');
  hRes:=LoadResource(HInstance,HresInfo);
  if hRes>32 then
  begin
    pStrSound:=LockResource(hRes);
  end;
  CreateInitData;
  if InitData.OnTop then
    SetWindowPos(handle,HWND_TOPMOST,0,0,0,0,swp_NoSize);
  c.Port:=InitData.Port;
  c.Address:=InitData.IP;
  c.Active:=true;
  GetmyIP(myHost,myAddress);
  RefreshStates;
  RegIni1.Path :=extractFilePath(Application.ExeName)+'\UserID.ini';
  ChatUsersID:=TstringList.Create ;
  FIFOIndex:=TstringList.Create ;
end;

procedure TfrmMain.ItemClick(sender: Tobject);
begin
  if LoseSession then
  begin
    information('服务器的连接已断开，请重新启动程序！');
    abort;
  end;

  GPFriend.Items[GPFriend.ItemIndex].FontColor:=clblack;
  ShowChatFrm(ChatUsersID.Strings[GPFriend.ItemIndex]);
end;


procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  i:integer;
begin
  for i:=low(frmChat) to high(frmChat) do
    if Assigned(frmChat[i]) then
      frmChat[i].Close ;  
  sleep(100);
  if Assigned(frmConfig) then
    frmConfig.close;
  //if Assigned(UserInfo) then
    //Dispose(UserInfo);

  ChatUsersID.Free ;
  FIFOIndex.Free ; 
end;

procedure TfrmMain.RzShapeButton1Click(Sender: TObject);
begin
  Application.Minimize;
  RzFormState1.SaveState;
end;

procedure TfrmMain.MoveIn(var msg: Tmessage);
var
  r:thandle;
begin
  if Top=0 then
    if (mouse.CursorPos.x>left) and (mouse.CursorPos.x<left+width)
      and (mouse.CursorPos.y>top-3) and (mouse.CursorPos.y<top+height+10) then
    begin
      r:=CreateRectRgn(0,0,width,height);
      SetWindowRgn(handle,r,true);
    end;
end;

procedure TfrmMain.MoveOut(var msg: Tmessage);
var
  r:thandle;
begin
  if Top=0 then
    if (mouse.CursorPos.x<left) or (mouse.CursorPos.x>left+width)
      or (mouse.CursorPos.y<top) or (mouse.CursorPos.y>top+height) then
    begin
      r:=CreateRectRgn(0,0,width,3);
      SetWindowRgn(handle,r,true);
    end;
end;

procedure TfrmMain.UpDateUserState(User:TRZGroupItem; Name,Sex: string; Logined:Boolean);
begin
  User.Caption:=Name ;
  User.ImageIndex :=3+strtoint(Sex);
  User.DisabledIndex :=12+strtoint(Sex);
  User.Enabled :=Logined;
  User.OnClick:=ItemClick;
end;

procedure TfrmMain.GetmyIP(var Host, Address: string);
begin
  Host:=c.Socket.LocalHost ;
  Address:=c.Socket.LocalAddress;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_HIDE);
  RefreshStates;
end;

procedure TfrmMain.Tray1LButtonDblClick(Sender: TObject);
var
  r:thandle;
  i,ItemIndex:integer;
begin
  if FIFOIndex.Count >0 then
  begin
    i:=strtoint(FIFOIndex.Strings[0]);
    if (i>=0) and assigned(frmChat[i]) then
    begin
      if FIFOIndex.Count >0 then
        FIFOIndex.Delete(0);
      ItemIndex:=ChatUsersID.IndexOf(frmChat[i].ID);
      if (ItemIndex<>-1) and (ItemIndex<AllowNumber) then
        GPFriend.Items[ItemIndex].FontColor :=clBlack;
      frmIndex:=FindFormByID(frmChat[i].ID);
      if (FIFOIndex.Count<=0) then
      begin
        Tray1.Animate :=false;
        Tray1.IconIndex :=0;
      end;
      if IsIconic(frmChat[frmIndex].Handle) then
        frmChat[frmIndex].WindowState := wsNormal
      else  
        frmChat[frmIndex].show;
    end;
  end
  else
  begin
    if self.Visible then
    begin
      r:=CreateRectRgn(0,0,width,Height);
      SetWindowRgn(handle,r,true);
    end;
    Application.Restore;
    SetForegroundWindow( Application.Handle );
  end;
  ShowWindow(Application.Handle,SW_HIDE);
end;

function TfrmMain.CreateChatFrm(ID:string;Index:integer;ExecGame:Boolean):TfrmChat;
begin
  if Index>-1 then
  begin
    if UserInfo^[Index].Logined='0' then
    begin
      frmmain.Information('连接失败，对方可能下线！');
      abort;
    end;
    if not assigned(frmChat[Index]) then
      result:=TfrmChat.Create(self)
    else
      result:=frmChat[Index];
    if ExecGame then//执行游戏要放在返回用户信息之前
      result.RzBitBtn5.Enabled :=false
    else
      result.RzBitBtn5.Enabled :=true;
    result.UserHandle:=STRPAS(UserInfo^[Index].Handle);
    result.Name :='Frm_'+ID;
    result.ID :=ID;
    result.Index :=Index;
    tray1.IconIndex :=0;
    send('U',myHandle,UserInfo^[Index].Handle,UserInfo^[Index].ID,'','','','');//获得聊天用户IP
  end
  else
    result:=nil;
end;

procedure TfrmMain.ShowChatFrm(ID:string);
begin
  frmIndex:=FindFormByID(ID);
  frmChat[frmIndex]:=CreateChatFrm(ID,frmIndex,false);
  if (FIFOIndex.Count >0) and (FIFOIndex.IndexOf(inttostr(frmIndex))>-1) then
    FIFOIndex.Delete(FIFOIndex.IndexOf(inttostr(frmIndex)));
  if IsIconic(frmChat[frmIndex].Handle) then
    frmChat[frmIndex].WindowState := wsNormal
  else
    frmChat[frmIndex].show;

  if (FIFOIndex.Count<=0) then
  begin
    Tray1.Animate :=false;
    Tray1.IconIndex :=0;
  end;
end;

function TfrmMain.FindFormByID(ID: string): integer;
var
  i:integer;
begin
  result:=-1;
  for i:=0 to high(UserInfo^) do
    if ID=strpas(UserInfo^[i].ID) then
💿 文件大小 273 K
👤 上传用户 my
📂 所属分类软件设计/软件工程
🏷️ 相关标签

#编写 #仓库管理 #小系统
⌨️ 快捷键说明

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