mainfrm.pas

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

    begin
      result:=i;
      break;
    end
end;

procedure TfrmMain.Write(AfileName: string;var Text:string);
begin
  if fileexists(AfileName) then
    FileStream:=TFileStream.Create(AfileName,fmOpenReadWrite)
  else
  begin
    if not DirectoryExists(InitData.Path) then
     if not CreateDir(InitData.Path) then
       raise Exception.Create('保存聊天记录失败！');
    FileStream:=TFileStream.Create(AfileName,fmCreate)
  end;
  FileStream.Write(Text[1],length(Text));
  FileStream.Free;
end;

function TfrmMain.Read(AfileName: string): string;
var
  s:string;
begin
  if fileexists(AfileName) then
  begin
    FileStream:=TFileStream.Create(AfileName,fmOpenReadWrite);
    setlength(s,FileStream.Size);
    FileStream.Read(s[1],FileStream.Size);
    FileStream.Free;
  end;
  Result:=s;
end;

procedure TfrmMain.RzGroup1Items0Click(Sender: TObject);
begin
  if not assigned(frmConfig) then
  begin
    frmConfig:=TfrmConfig.Create(self);
    frmConfig.Show;
  end;
end;

procedure TfrmMain.CreateInitData;
begin
  if not fileexists('jjyy.dat') then
  begin
    FileStream:=TFileStream.Create('jjyy.dat',fmCreate);
    InitData.IP:='127.0.0.1';
    InitData.Port:=10111;
    InitData.AutoSave:=true;
    InitData.OnTop:=false;
    InitData.ShowOnHint :=true;
    InitData.ShowOffHint :=true;
    InitData.PlayWave :=false;
    InitData.Path :=extractFilePath(Application.ExeName);
    FileStream.Write(InitData,Sizeof(TInitData));
    FileStream.Free;
  end
  else
  begin
    FileStream:=TFileStream.Create('jjyy.dat',fmOpenReadWrite);
    FileStream.Read(InitData,Sizeof(TInitData));
    FileStream.Free ;
  end;
end;

procedure TfrmMain.cConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  LoseSession:=false;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  i:integer;
  Index,Index1:integer;
begin
  if FiFOIndex.Count =0 then
  begin
    for i:=0 to GPFriend.Items.Count-1 do
      GPFriend.Items[i].FontColor:=clBlack;
    Timer1.Enabled :=false;
    exit;
  end;

  index1:=strtoint(FIFOIndex.Strings[0]);
  index1:=ChatUsersID.IndexOf(UserInfo^[index1].ID);
  if (index1<>-1) and (index1<AllowNumber) then
    if GPFriend.Items[Index1].FontColor=clblack then
      GPFriend.Items[Index1].FontColor:=clBlue
    else
      GPFriend.Items[Index1].FontColor:=clblack;

  for i:=0 to FiFOIndex.Count-1 do
  begin
    if i<>0 then
    begin
      index:=strtoint(FIFOIndex.Strings[i]);
      index:=ChatUsersID.IndexOf(UserInfo^[index].ID);
      if (index<>-1) and (index<AllowNumber) then
        GPFriend.Items[Index].FontColor:=GPFriend.Items[Index1].FontColor;
    end;
  end;
end;

procedure TfrmMain.RzGroup1Items2Click(Sender: TObject);
begin
  if not Assigned(frmmail) then
    frmmail:=Tfrmmail.Create(self);
  frmmail.show;
end;


procedure TfrmMain.WMQueryEndSession(var Msg: TMessage);
begin
//  if Logined and (not LoseSession) then
//    send('C',Session.Handle,myName,inttostr(mySex),myID,myHost,myAddress,'');
  inherited;
end;

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

  if not assigned(frmAdmin) then
  begin
    frmAdmin:=TfrmAdmin.Create(self);
    frmAdmin.Show ;
  end;
end;

procedure TfrmMain.Information(msg: string);
begin
  if not assigned(frmInfo) then
  begin
    frmInfo:=TfrmInfo.Create(self);
    frmInfo.Label1.Caption :=msg;
    frmInfo.ShowModal ;
  end;
end;

procedure TfrmMain.MoreClick(sender: TObject);
begin
  UserMenu.ShowMenu(GPFriend,3,GPFriend.Height);
end;

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

  ShowChatFrm(ChatUsersID.Strings[UserMenu.SelectedItem.CoolItemIndex+AllowNumber]);
end;

procedure TfrmMain.UpdateUserMenu(User: TCoolItem95; Name, Sex: string;
  Logined: Boolean);
begin
  User.Caption :=Name;
  User.SelectedColor :=$00E8DCC1;
  User.SelectedFont.Color :=clblue;
  User.SelectedFont.Style :=[fsUnderline];
  User.Enabled :=Logined;
  if User.Enabled then
    User.ImageIndex :=3+strtoint(Sex)
  else
    User.ImageIndex :=12+strtoint(Sex);
  User.OnClick :=MenuItemClick;
end;

procedure TfrmMain.UMDestroy(var Message: TMessage);
begin
//
end;

function TfrmMain.GetTextID(Text, BreakSymbol: string): string;
var
  I: Integer;
begin
  I := Pos(BreakSymbol, Text);
  if I > 0 then
    Result := Copy(Text, 1, I - 1)
  else Result := Text;
end;

function TfrmMain.GetTextName(Text, BreakSymbol: string): string;
var
  I: Integer;
begin
  I := Pos(BreakSymbol, Text);
  if I > 0 then
    Result := Copy(Text, I + Length(BreakSymbol),
      Length(Text) - I - Length(BreakSymbol) + 1)
  else Result := Text;
end;

procedure TfrmMain.DisplayText(Lines:TStrings;NewText, UserName:string);
begin
  Lines.Add(UserName+'('+datetimetoStr(Now)+'): '+#13#10+'  '+NewText);
end;

procedure TfrmMain.DisplayText(Lines:TStrings;NewText:string);
begin
  Lines.add(NewText);
end;

procedure TfrmMain.GameExec(frm:TfrmChat;Index:integer;Flag, Style, extr, CommandText,
  Station, AUserHandle: string);
var
  i:integer;
  CommandList:TStrings;
  GameHandle,GameComm:string;
  function OcttoBin(value:integer):string;
  var
    i:integer;
    tmpx:integer;
    s:array[0..13] of char;//俄罗斯方块的长度为14
  begin
    fillchar(s,14,'0');
    i:=13;
    while value<>0 do
    begin
      tmpx:=value mod 2;
      value:=value div 2;
      if tmpx=0 then
        s[i]:='0'
      else
        s[i]:='1';
      dec(i);
    end;
    result:=s;
  end;
begin
  CommandList:=TStringList.Create;
  CommandList.Text :=CommandText;
  with frmChat[Index] do
  begin
    for i:=0 to CommandList.Count-1 do
    begin
      GameHandle:=GetTextID(CommandList.Strings[i]);
      GameComm:=GetTextName(CommandList.Strings[i]);

      if Pos('Start',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=myHandle) then
        begin
          Russfrm.sPrim.New(strtoint(GetTextID(Flag)),strtoint(GetTextID(Style)),false);
          Russfrm.sPrimV.New(strtoint(GetTextName(Flag)),strtoint(GetTextName(Style)),false);
        end;

        if (Station='Secd') and (GameHandle=AUserHandle) then
        begin
          Russfrm.sSec.New(strtoint(GetTextID(Flag)),strtoint(GetTextID(Style)),false);
          Russfrm.sSecV.New(strtoint(GetTextName(Flag)),strtoint(GetTextName(Style)),false);
        end;

        Russfrm.OldFlag:=Russfrm.sPrimV.Flag;
        Russfrm.OldStyle:=Russfrm.sPrimV.NowStyle;
      end
      else if Pos('Down',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=MyHandle) then
          Russfrm.sPrim.ToDown(strtoint(GetTextID(Flag)),strtoint(GetTextID(Style)),false);

        if (Station='Secd') and (GameHandle=AUserHandle) then
          Russfrm.sSec.ToDown(strtoint(GetTextID(Flag)),strtoint(GetTextID(Style)),false);

        //Russfrm.OldFlag:=Russfrm.sPrimV.Flag;
        //Russfrm.OldStyle:=Russfrm.sPrimV.NowStyle;
      end
      else if Pos('Left',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=MyHandle) then
          Russfrm.sPrim.ToRight;

        if (Station='Secd') and (GameHandle=AUserHandle) then
          Russfrm.sSec.ToRight;
      end
      else if Pos('Right',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=MyHandle) then
          Russfrm.sPrim.ToLeft;

        if (Station='Secd') and (GameHandle=AUserHandle) then
          Russfrm.sSec.ToLeft;
      end
      else if Pos('Change',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=MyHandle) then
          Russfrm.sPrim.Changed;

        if (Station='Secd') and (GameHandle=AUserHandle) then
          Russfrm.sSec.Changed;
      end
      else if Pos('Stop',GameComm)<>0 then
      begin
        if (Station='Prim') and (GameHandle=MyHandle) then
        begin
          Russfrm.sPrimV.New(strtoint(GetTextID(extr)),strtoint(GetTextID(GetTextName(extr),';')),false);
        end;

        if (Station='Secd') and (GameHandle=AUserHandle) then
        begin
          Russfrm.sSecV.New(strtoint(GetTextID(extr)),strtoint(GetTextID(GetTextName(extr),';')),false);
        end;
        Russfrm.OldFlag:=Russfrm.sPrimV.Flag;
        Russfrm.OldStyle:=Russfrm.sPrimV.NowStyle;
      end
      else if Pos('Build',GameComm)<>0 then
      begin
        if (Station='Prim') and (Russfrm.UserStarted) and (GameHandle=MyHandle) then
        begin
          Russfrm.sSec.BuildLine(OcttoBin(strtoint(GetTextName(extr,';'))));
        end;

        if (Station='Secd') and (Russfrm.Started) and (GameHandle=AUserHandle) then
        begin
          Russfrm.sPrim.BuildLine(OcttoBin(strtoint(GetTextName(extr,';'))));
        end;
      end;
    end;
  end;
  CommandList.Free;
end;

procedure TfrmMain.PopupMenu1Popup(Sender: TObject);
begin
  N6.Enabled :=not frmmain.Logined;
  if not frmmain.Logined then
    N6.ImageIndex :=0
  else
    N6.ImageIndex :=10;

  N7.Enabled :=frmmain.Logined;
  if frmmain.Logined then
    N7.ImageIndex :=1
  else
    N7.ImageIndex :=11;

  N4.Enabled :=frmmain.Logined;
  //if frmmain.Logined then
    //N4.ImageIndex :=22
  //else
    //N4.ImageIndex :=23;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Logined and (not LoseSession) then
  begin
    send('C',myHandle,myName,inttostr(mySex),myID,myHost,myAddress,'');
    //if Assigned(UserInfo) then
      //UserInfo^:=nil;
  end;
end;

end.