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.