Funktion Copy verwenden - wie?

[Lyan]

oh ehm, hat zwar geklappt,. aber dadurch das es nun formated ist, sind die Farben durcheinander!

Also wenn ich im colordialog user nun Gelb wähle ,kommt limegreen bei raus ect.!

[DeddyH]

Das kann ich hier nicht nachvollziehen. Hast Du die GetXValue-Aufrufe evtl. vertauscht?

[Lyan]

Client Source:

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, inifiles, ComCtrls, Character, unit2;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Client: TClientSocket;
    Button4: TButton;
    Button2: TButton;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Memo2: TMemo;
    GroupBox1: TGroupBox;
    TabSheet2: TTabSheet;
    ColorDialoguser: TColorDialog;
    Button3: TButton;
    GroupBox3: TGroupBox;
    labelUsername: TLabel;
    Labelhost: TLabel;
    Labelport: TLabel;
    Labelcolor: TLabel;
    Editusername: TEdit;
    Edithost: TEdit;
    Editport: TEdit;
    ButtonColor: TButton;
    Buttonconnect: TButton;
    Edit1: TEdit;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    RichEdit1: TRichEdit;
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TabSheet2ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure ButtonconnectClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonColorClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private-Deklarationen }
    inifileuser: Tinifile;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var c: Integer;
var Farbstring: String;
begin
with richedit1.selattributes do
begin
  c := colordialoguser.color;
  Farbstring := Format('%.2x%.2x%.2x', [GetBValue(c), GetGValue(c), GetRValue(c)]);
  if strtoint(memo2.Text) <> 0 then
  richedit1.SelAttributes.Style := [fsBold];
  client.socket.SendText(inttostr(c) + editusername.text + ' -> ' + memo2.text);
  memo2.Clear;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
memo2.Clear;
memo2.lines.Add('Client 1.0 - Lyan');
end;

procedure TForm1.ButtonColorClick(Sender: TObject);
var c: Integer;
var Farbstring: String;
begin
  c := colordialoguser.color;
  Farbstring := Format('%.2x%.2x%.2x', [GetBValue(c), GetGValue(c), GetRValue(c)]);
  if colordialoguser.Execute then
  begin
    inifileuser.WriteString('Userinfo','Farbe',IntToStr(c));
    Edit1.Color := c;
  end;
end;

procedure TForm1.ButtonconnectClick(Sender: TObject);
var iLength: Integer;
begin
Inifileuser.WriteString('Userinfo', 'Username', Editusername.text );
Inifileuser.WriteString('Userinfo', 'Host', Edithost.text );
Inifileuser.WriteString('Userinfo', 'Port', Editport.text );
Inifileuser.WriteString('Userinfo', 'Chatfarbe', IntToStr(ColorDialoguser.Color));

if (editusername.Text <> '') AND (editport.Text <> '') AND (edithost.Text <> '') then
  begin
    iLength := Length(editusername.Text);
    if (iLength > 3) then
    begin
      try
        client.Host := edithost.text;
        client.Port := strtoint(editport.text);
        client.Active := True;
        pagecontrol1.ActivePage := tabsheet1;
        unit2.Form2.Show;
      except
        ShowMessage('Connection failed! Please check your Host or Port number!');
      end;
    end;
  end
  else
  begin
    Showmessage('Entweder haben sie vergessen ein Feld auszufüllen, oder ihr Username ist zu kurz!');
  end;
end;


procedure TForm1.ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
richedit1.Lines.Add('Status: verbunden mit ' + socket.RemoteAddress);
end;

procedure TForm1.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
richedit1.Lines.Add('Status: getrennt mit ' + socket.RemoteAddress);
end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
richedit1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.FormCreate(Sender: TObject);
var suserpath: String;
sFarbe: String;
begin
  PageControl1.ActivePage := TabSheet2;
  suserpath := ExtractFilePath(ParamStr(0));
  if not DirectoryExists('Usersettings') then
    CreateDir('Usersettings');

  inifileuser:=Tinifile.Create(suserpath + ('\Usersettings\Usersettings.ini'));
  editusername.Text:=inifileuser.ReadString('Userinfo', 'Username', '');
  editHost.Text:=inifileuser.ReadString('Userinfo', 'Host', '');
  editPort.Text:=inifileuser.ReadString('Userinfo', 'Port', '');
  sFarbe := inifileuser.ReadString('Userinfo', 'Farbe', InttoStr(clBlack));
  sFarbe := inifileuser.ReadString('Userinfo', 'Chatfarbe', InttoStr(clBlack));
  try
    Color := StrToInt(sFarbe);
  except
    Color := clBlack;
  end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  try
  inifileuser.free
  except
  end;
end;


procedure TForm1.TabSheet2ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
  var sFarbe: String; suserpath: String;

begin
    suserpath := ExtractFilePath(ParamStr(0));
  if not DirectoryExists('Usersettings') then
    CreateDir('Usersettings');

  inifileuser:=Tinifile.Create(suserpath + ('\Usersettings\Usersettings.ini'));
  editusername.Text:=inifileuser.ReadString('Userinfo', 'Username', '');
  editHost.Text:=inifileuser.ReadString('Userinfo', 'Host', '');
  editPort.Text:=inifileuser.ReadString('Userinfo', 'Port', '');
  sFarbe := inifileuser.ReadString('Userinfo', 'Farbe', InttoStr(clBlack));
  sFarbe := inifileuser.ReadString('Userinfo', 'Chatfarbe', InttoStr(clBlack));
  try
    Color := StrToInt(sFarbe);
  except
    Color := clBlack;
  end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  label1.Caption := inttostr(trackbar1.Position);
  form1.AlphaBlendValue := strtoint(label1.Caption);
end;

end.

Client:

Code:

unit UnitServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Inifiles, ScktComp, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    EditPort: TEdit;
    Label1: TLabel;
    GroupBoxProtokoll: TGroupBox;
    ButtonStarten: TButton;
    ButtonAnhalten: TButton;
    ButtonClear: TButton;
    ButtonSenden: TButton;
    ButtonBeenden: TButton;
    EditSenden: TEdit;
    LabelUser: TLabel;
    Server: TServerSocket;
    ListBoxUser: TListBox;
    RichEditMaster: TRichEdit;
    procedure ButtonStartenClick(Sender: TObject);
    procedure ButtonAnhaltenClick(Sender: TObject);
    procedure ButtonClearClick(Sender: TObject);
    procedure ButtonBeendenClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ButtonSendenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure EditPortExit(Sender: TObject);
  private
    { Private-Deklarationen }
    inifilemain: TIniFile;
  public
    { Public-Deklarationen }
  end;

var
  {Variablen}
  Form1: TForm1;
  Userzahl:Integer;
  i:Integer;

implementation

{$R *.dfm}

procedure TForm1.ButtonStartenClick(Sender: TObject);
begin
{Server Verbindung (Port) wird aus Edit1 gelesen on button1.click}
  Server.Port:= strtoint(EditPort.Text);
  Server.Active:=True;
  Buttonstarten.Enabled:=False;
  Buttonanhalten.Enabled:=True;
  RicheditMaster.Lines.Add('Status: Server gestartet.');

end;

procedure TForm1.ButtonAnhaltenClick(Sender: TObject);
begin
{Server.Active wird auf false gesetzt wenn der Server angehalten wird}
  Server.Port:= strtoint(Editport.Text);
  Server.Active:=False;
  Buttonstarten.Enabled:=True;
  Buttonanhalten.Enabled:=False;
  RicheditMaster.Lines.Add('Status: Server angehalten.');
end;

procedure TForm1.ButtonClearClick(Sender: TObject);
begin
{Protokoll wird "gelöscht"}
  RicheditMaster.Lines.Clear;
  RicheditMaster.Lines.Add('Server 1.0');
end;

procedure TForm1.ButtonSendenClick(Sender: TObject);
var i:integer;
begin
{Server schickt eine Nachricht an alle User}
  for i := 0 to server.Socket.ActiveConnections - 1 do
  server.Socket.Connections[i].SendText('Nachricht von Server: ' + editsenden.Text);
  RicheditMaster.Lines.Add('Nachricht von Server: ' + editsenden.Text);
end;


procedure TForm1.ButtonBeendenClick(Sender: TObject);
begin
        {Anwendung schließen}
  server.Active:=false;
  application.Terminate;
end;


procedure TForm1.EditPortExit(Sender: TObject);
begin
    InifileMain.WriteString('Port', 'Portvalue', editport.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
var Inifilepath: String;
begin
  inifilepath:=extractfilepath(ParamStr(0));
  InifileMain:=TIniFile.Create(inifilepath + ('startup.ini'));
  Editport.Text:=InifileMain.ReadString('Port', 'portvalue', '');
end;


procedure TForm1.FormDestroy(Sender: TObject);
var sExeVerzeichnis: string;
begin
  server.Active:=false;
  sExeVerzeichnis := ExtractFilePath(ParamStr(0));
  if not DirectoryExists(sExeVerzeichnis+'VerlaufProtokoll') then
  CreateDir(sExeVerzeichnis+'VerlaufProtokoll')
  else
    begin
         RicheditMaster.lines.SaveToFile(sExeVerzeichnis+'\VerlaufProtokoll\TEst1337.txt');
    end;
  try
    InifileMain.free;
  except
  end;
end;

procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  RicheditMaster.Lines.Add('Status: Client ' + Socket.RemoteAddress + ' verbunden.');
  Userzahl:=Userzahl +1;
  labeluser.caption:='User: ' + inttostr(Userzahl);
  ListBoxUser.Items.Add(Socket.RemoteAddress );
end;

procedure TForm1.ServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RicheditMaster.Lines.Add('Status: Client ' + Socket.RemoteAddress + ' getrennt.');
  Userzahl:=Userzahl -1;
  labeluser.caption:='User: ' + inttostr(Userzahl);
end;

procedure TForm1.ServerClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  RicheditMaster.Lines.Add('Status: Client ' + socket.RemoteAddress + 'hat den Fehler' + inttostr(Errorcode));
  Userzahl:=Userzahl -1;
  labeluser.caption:='User: ' + inttostr(Userzahl);
end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var i:integer;
    Nachricht: AnsiString;
    Color: TColor;
    c: string;
begin
    Nachricht:= Socket.ReceiveText;
    c := copy(Nachricht, 1,6);
    delete(Nachricht, 1,6);
    Color:=StrToInt(('$' + c));
    for i := 0 to server.Socket.ActiveConnections - 1 do
    server.socket.Connections[i].SendText(Nachricht);

  end;
end.

Versuch es bitte Ich blick nicht durch!

[DeddyH]

Zitat:

client.socket.SendText(inttostr(c)...

Wozu den Farbstring erstellen, wenn Du doch IntToStr(c) sendest? Ersetz das mal.

[Lyan]

kommt beim senden vom client immer "testnachricht" ist kein gültiger integer-wert.

[DeddyH]

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var c: Integer;
    Farbstring: String;
begin
  c := colordialoguser.color;
  Farbstring := Format('%.2x%.2x%.2x', [GetBValue(c), GetGValue(c), GetRValue(c)]);
  if strtoint(memo2.Text) <> 0 then
    richedit1.SelAttributes.Style := [fsBold];
  client.socket.SendText(Farbstring + editusername.text + ' -> ' + memo2.text);
  memo2.Clear;
end;

[Lyan]

http://imageshack.us/f/846/deddy.jpg/