Einzelnen Beitrag anzeigen

Benutzerbild von mr47
mr47

Registriert seit: 6. Dez 2004
Ort: Stuttgart
644 Beiträge
 
Delphi 2005 Personal
 
#6

Re: Hat jemand einen Chat oder Messenger der OS is ?

  Alt 7. Jan 2005, 20:07
Hi hier hab ich einen SEHR EINFACHEN Chat. Nicht besonders komfortabel, aber funktioniert einwand frei:

Source

Delphi-Quellcode:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, Buttons, CoolTrayIcon, StdCtrls, Menus,stc, IdTCPServer,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    XPManifest1: TXPManifest;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Tray: TCoolTrayIcon;
    Memo1: TMemo;
    Edit1: TEdit;
    SpeedButton4: TSpeedButton;
    PopupMenu1: TPopupMenu;
    Optionen1: TMenuItem;
    Anzeigelschen1: TMenuItem;
    Client: TIdTCPClient;
    Server: TIdTCPServer;
    Copyright1: TMenuItem;
    AndereUsersuchen1: TMenuItem;
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TrayDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure Optionen1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ServerExecute(AThread: TIdPeerThread);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Anzeigelschen1Click(Sender: TObject);
    procedure Copyright1Click(Sender: TObject);
    procedure AndereUsersuchen1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses netSetting, searchUser;
var open: boolean;
    ip,cn,nn: string;

{$R *.dfm}

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  Tray.HideMainForm;
  open:=false;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  open:=true;
end;

procedure TForm1.TrayDblClick(Sender: TObject);
begin
  Tray.ShowMainForm;
  Open:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Server.Active:=true;
  memo1.text:='DirectChat 2.0 © CW 05';
  ip:=Stc.GetText(ExtractFilePath(Application.Exename)+'\netSet',line,1,1);
  nn:=Stc.GetText(ExtractFilePath(Application.Exename)+'\UserSet',line,1,1);
  if stc.TcError=true then
    ShowMessage('Bitte konfigurieren Sie ihr Netzwerk richtig! (Name und Netzwerk)');

end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  popupMenu1.Popup(round(form1.Left+form1.Width/2),round(form1.Top+form1.Height/2));
end;

procedure TForm1.Optionen1Click(Sender: TObject);
begin
  netSet.ShowModal;
  ip:=Stc.GetText(ExtractFilePath(Application.Exename)+'\netSet',line,1,1);
  nn:=Stc.GetText(ExtractFilePath(Application.Exename)+'\UserSet',line,1,1);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  cn:=ip+InputBox('Verbinden','Bitte geben Sie eine IP oder eine Computernummer ein!(Neztwerkbedingt)','');
  memo1.Lines.add('Verbinde zu '+cn+'....');
  if Client.Connected then Client.Disconnect;
  Client.Host:=cn;
  try
    Client.Connect(500);
    Client.WriteLn('Verbunden mit '+nn);
    memo1.Lines.add('Verbindung steht!');
  except
    memo1.Lines.add('Verbindung nicht möglich! (CE01)');
  end;
  
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Server.Active:=false;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  try
    Client.WriteLn(nn+' hat die Verbindung beendet!');
    memo1.lines.Add('Information senden');
    memo1.Lines.Add('Verbindung beendet!');
    Client.Disconnect;
  except
    memo1.Lines.Add('Verbindungsfehler: CE02');
  end;
end;

procedure TForm1.ServerExecute(AThread: TIdPeerThread);
var ms: string;
begin
  ms:=(Athread.Connection.ReadLn('',500));
  memo1.Lines.add(ms);
  if Open=false then tray.ShowBalloonHint('Neue Meldung: ',ms,bitInfo,10);
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  try
    Client.WriteLn(nn+': '+edit1.Text);
    memo1.Lines.Add('>>'+edit1.Text);
    edit1.Clear;
  except
    memo1.Lines.add('Verbindungsfehler: 03');
  end;
end;

procedure TForm1.Anzeigelschen1Click(Sender: TObject);
begin
  memo1.Clear;
end;

procedure TForm1.Copyright1Click(Sender: TObject);
begin
  memo1.Lines.add(' Dieses Produkt ist Freeware, und darf weitergegeben werden');
  memo1.Lines.add(' © Constantin Weißer 2005 - DirectChat Version 2.0');
end;

procedure TForm1.AndereUsersuchen1Click(Sender: TObject);
begin
  search.ShowModal;
end;

end.
(PS: Dafür setze ich CoolTrayIcon von Torry.net ein.)
  Mit Zitat antworten Zitat