Changeset 15
- Timestamp:
- Feb 18, 2008, 2:00:19 PM (17 years ago)
- Location:
- trunk
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 6 6 Network.cfg 7 7 Error.txt 8 ProjectGroup1.bdsgroup 9 ProjectGroup1.bdsgroup.local
-
- Property svn:ignore
-
trunk/SunriseChat.bdsproj
r9 r15 33 33 <Compiler Name="O">1</Compiler> 34 34 <Compiler Name="P">1</Compiler> 35 <Compiler Name="Q"> 0</Compiler>36 <Compiler Name="R"> 0</Compiler>35 <Compiler Name="Q">1</Compiler> 36 <Compiler Name="R">1</Compiler> 37 37 <Compiler Name="S">0</Compiler> 38 38 <Compiler Name="T">0</Compiler> -
trunk/SunriseChat.dpr
r13 r15 1 1 program SunriseChat; 2 2 3 3 {$WARN SYMBOL_PLATFORM OFF} 4 4 5 5 uses -
trunk/SunriseChatCoreUnit.pas
r13 r15 592 592 end; 593 593 end; 594 if Assigned(ProtocolMessageLogForm) then595 ProtocolMessageLogForm.Memo1.Lines.Add('SendCommand: ' + Data);596 if Assigned(FOnSendCommand) then FOnSendCommand(Data + #13);594 //if Assigned(ProtocolMessageLogForm) then 595 // ProtocolMessageLogForm.Memo1.Lines.Add('SendCommand: ' + Data); 596 if Assigned(FOnSendCommand) then FOnSendCommand(Data); 597 597 end; 598 598 end; -
trunk/SunriseChatNetworkCoreUnit.pas
r13 r15 7 7 Forms, StdCtrls, ExtCtrls, SunriseChatCoreUtils, DateUtils, SunriseChatCoreUnit, 8 8 cWindows, cSockets, cSocketsUDP, cTCPClient, cTCPServer, cUtils, WinSock, 9 cWinSock, Registry, UEthernetAddress; 9 cWinSock, Registry, UEthernetAddress, IdUDPBase, IdUDPServer, IdUDPClient, 10 IdBaseComponent, IdComponent, IdGlobal, IdSocketHandle, IdCustomTCPServer, 11 IdTCPServer, IdTCPConnection, IdTCPClient, IdContext, IdAntiFreeze; 10 12 11 13 const 12 14 DefaultUdpPort = 55557; 15 BroadcastIPAddress = '255.255.255.255'; 13 16 14 17 type … … 16 19 17 20 TSunriseChatNetworkCore = class; 21 22 TReadingThread = class(TThread) 23 protected 24 FConnection: TIdTCPConnection; 25 FParent: TSunriseChatNetworkCore; 26 procedure Execute; override; 27 public 28 constructor Create(AParent: TSunriseChatNetworkCore; AConnection: TIdTCPConnection); reintroduce; 29 end; 18 30 19 31 TNetworkInterface = class … … 33 45 TSunriseChatNetworkCore = class(TSunriseChatCore) 34 46 private 35 fndTCPServer1: TfndTCPServer; 36 fndTCPClient1: TfndTCPClient; 37 fndUDPClientSocket1: TfndUDPClientSocket; 47 IdTCPServer1: TIdTCPServer; 48 IdTCPClient1: TIdTCPClient; 49 IdUDPServer1: TIdUDPServer; 50 IdUDPClient1: TIdUDPClient; 38 51 FConnected: Boolean; 39 52 FOnChangeNetworkState: TClassMethod; … … 44 57 FAutoReconnect: Boolean; 45 58 FTimer2: TTimer; 59 FReadingThread: TReadingThread; 46 60 procedure Timer2Timer(Sender: TObject); 47 procedure fndTCPServer1DataAvailable(Sender: TTCPServerClient);48 procedure fndTCPClient1DataAvailable(Sender: ATCPClient);49 procedure fndUDPClientSocket1DataAvailable(Sender: AUDPSocket);50 procedure fndTCPClient1Close(Sender: ATCPClient);51 61 function GetLocalIPAddress: string; 52 62 procedure SetLocalIPAddress(const Value: string); … … 55 65 procedure StopNetwork; 56 66 procedure SendCommandToNetwork(const S: string); 67 procedure IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); 68 procedure IdTCPServer1Execute(AContext: TIdContext); 69 procedure IdTCPClient1Connected(Sender: TObject); 70 procedure IdTCPClient1Disconnect(Sender: TObject); 71 procedure SetAutoReconnect(const Value: Boolean); 57 72 property OnSendCommand; 58 procedure SetAutoReconnect(const Value: Boolean);59 73 public 60 NetworkInterfaces: TList; // of TNetworkInterface;74 NetworkInterfaces: TList; // TList<TNetworkInterface>; 61 75 constructor Create(AOwner: TComponent); override; 62 76 function IPAddrToStr(Addr: Cardinal): string; … … 80 94 81 95 uses 82 IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog ;96 IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog, IdIOHandlerSocket; 83 97 84 98 procedure Register; 85 99 begin 86 100 RegisterComponents('Chronosoft', [TSunriseChatNetworkCore]); 101 end; 102 103 { TReadingThread } 104 105 constructor TReadingThread.Create(AParent: TSunriseChatNetworkCore; 106 AConnection: TIdTCPConnection); 107 begin 108 FConnection := AConnection; 109 FParent := AParent; 110 inherited Create(False); 111 end; 112 113 procedure TReadingThread.Execute; 114 var 115 Text: string; 116 begin 117 try 118 while not Terminated and FConnection.Connected do 119 begin 120 Text := FConnection.IOHandler.Readln; 121 //ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data); 122 FParent.ProcessCommand(Text); 123 end; 124 except 125 end; 87 126 end; 88 127 … … 93 132 inherited; 94 133 NetworkInterfaces := TList.Create; 95 fndTCPServer1 := TfndTCPServer.Create(Self); 96 fndTCPServer1.OnDataAvailable := fndTCPServer1DataAvailable; 97 fndTCPClient1 := TfndTCPClient.Create(Self); 98 fndTCPClient1.OnDataAvailable := fndTCPClient1DataAvailable; 99 fndTCPClient1.OnClose := fndTCPClient1Close; 100 fndUDPClientSocket1 := TfndUDPClientSocket.Create(Self); 101 fndUDPClientSocket1.OnDataAvailable := fndUDPClientSocket1DataAvailable; 134 IdTCPServer1 := TIdTCPServer.Create(Self); 135 IdTCPServer1.OnExecute := IdTCPServer1Execute; 136 IdTCPClient1 := TIdTCPClient.Create(Self); 137 IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect; 138 IdTCPClient1.OnConnected := IdTCPClient1Connected; 139 IdUDPServer1 := TIdUDPServer.Create(Self); 140 IdUDPServer1.OnUDPRead := IdUDPServer1UDPRead; 141 IdUDPClient1 := TIdUDPClient.Create(Self); 102 142 FUdpPort := DefaultUdpPort; 103 143 FActive := False; … … 112 152 I: Integer; 113 153 begin 114 fndTCPClient1.OnClose := nil; 154 // IdTCPClient1.OnDisconnected := nil; 155 OnChangeNetworkState := nil; 115 156 Active := False; 116 157 for I := 0 to NetworkInterfaces.Count - 1 do 117 158 TNetworkInterface(NetworkInterfaces[I]).Free; 118 159 NetworkInterfaces.Free; 160 IdTCPServer1.Destroy; 161 IdTCPClient1.Destroy; 162 IdUDPServer1.Destroy; 163 IdUDPClient1.Destroy; 119 164 inherited; 120 165 end; 121 166 122 procedure TSunriseChatNetworkCore.fndTCPClient1Close(Sender: ATCPClient); 167 procedure TSunriseChatNetworkCore.IdTCPClient1Connected(Sender: TObject); 168 begin 169 FReadingThread := TReadingThread.Create(Self, IdTCPClient1); 170 FReadingThread.FreeOnTerminate := True; 171 end; 172 173 procedure TSunriseChatNetworkCore.IdTCPClient1Disconnect(Sender: TObject); 123 174 begin 124 175 FConnected := False; … … 130 181 end; 131 182 132 procedure TSunriseChatNetworkCore.fndTCPClient1DataAvailable( 133 Sender: ATCPClient); 134 var 135 Data, Text: string; 136 begin 137 if Sender.Socket.InBufferSize > 0 then begin 138 Data := Sender.Socket.ReadAvailable; 139 ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data); 140 if Pos(#13, Data) > 0 then begin 141 repeat 142 Text := Copy(Data, 1, Pos(#13, Data)-1); 143 Delete(Data, 1, Length(Text)+1); 144 ProcessCommand(Text); 145 until (Data = '') or (Pos(#13, Data) = 0); 146 end else ProcessCommand(Data); 147 end; 148 end; 149 150 procedure TSunriseChatNetworkCore.fndTCPServer1DataAvailable( 151 Sender: TTCPServerClient); 183 procedure TSunriseChatNetworkCore.IdTCPServer1Execute(AContext: TIdContext); 184 var 185 Text: string; 186 begin 187 Text := AContext.Connection.IOHandler.ReadLn; 188 (* 189 if AContext.Connection.Connected then begin 190 Text := ''; // AContext.Connection.IOHandler.AllData; 191 *) 192 // ProtocolMessageLogForm.Memo1.Lines.Add('TCPServerDataAvailable: ' + Text); 193 if BroadcastType = btGlobal then 194 IdUDPClient1.Broadcast(Text, UDPPort) else 195 IdUDPClient1.Send(FActiveNetworkInterface.BroadcastIPAddress, UDPPort, Text); 196 // end; 197 end; 198 199 procedure TSunriseChatNetworkCore.IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); 152 200 var 153 201 Text: string; 154 202 I: Integer; 155 begin 156 if Sender.Socket.InBufferSize > 0 then begin 157 Text := Sender.Socket.ReadAvailable; 158 for I := 0 to fndTCPServer1.ClientCount - 1 do 159 fndTCPServer1.Client[I].Socket.SendStr(Text); 160 ProtocolMessageLogForm.Memo1.Lines.Add('TCPServerDataAvailable: ' + Text); 161 if BroadcastType = btGlobal then 162 fndUDPClientSocket1.Broadcast(IntToStr(UDPPort), Text) else 163 fndUDPClientSocket1.SendStr(Text); 164 end; 165 end; 166 167 procedure TSunriseChatNetworkCore.fndUDPClientSocket1DataAvailable( 168 Sender: AUDPSocket); 169 var 170 Text: string; 171 Address : TSockAddr; 172 I: Integer; 173 begin 174 ProtocolMessageLogForm.Memo1.Lines.Add('UDBClientDataAvailable: ' + Text); 203 ClientList: TList; 204 begin 205 SetLength(Text, Length(AData)); 206 for I := 0 to Length(AData) - 1 do 207 Text[I + 1] := Chr(AData[I]); 208 //ProtocolMessageLogForm.Memo1.Lines.Add('UDPServerDataAvailable: ' + Text); 209 210 // Send data to all clients 175 211 if FConnected then begin 176 Sender.ReadPacket(Text, Address); 177 for I := 0 to fndTCPServer1.ClientCount - 1 do 178 with fndTCPServer1.Client[I] do Socket.SendStr(Text); 212 ClientList := IdTCPServer1.Contexts.LockList; 213 try 214 for I := 0 to ClientList.Count - 1 do 215 TIdContext(ClientList.Items[I]).Connection.IOHandler.WriteLn(Text); 216 finally 217 IdTCPServer1.Contexts.UnlockList; 218 end; 179 219 end; 180 220 end; … … 274 314 procedure TSunriseChatNetworkCore.SendCommandToNetwork(const S: string); 275 315 begin 276 if FConnected then fndTCPClient1.Socket.SendStr(S);316 if FConnected then IdTCPClient1.IOHandler.WriteLn(S); 277 317 end; 278 318 … … 301 341 var 302 342 I, II: Integer; 343 SocketBinding: TIdSocketHandle; 303 344 const 304 345 Stav: array [0..6] of string = ('Closed', 'Resolving', 'Resolved', 'Connecting', 305 346 'Negotiating', 'Connected', 'Listening'); 306 347 begin 307 fndTCPClient1.OnClose:= nil;348 IdTCPClient1.OnDisconnected := nil; 308 349 FConnected := False; 309 350 try 310 fndTCPClient1.Active := False;311 with fndTCPServer1 do begin351 IdTCPClient1.Disconnect; 352 with IdTCPServer1 do begin 312 353 Active := False; 313 ListenPort := IntToStr(UDPPort+1); 314 LocalHost := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 354 SocketBinding := IdTCPServer1.Bindings.Add; 355 SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine); 356 SocketBinding.Port := UDPPort + 1; 315 357 try 316 358 Active := True; … … 318 360 end; 319 361 // ShowMessage(Stav[Integer(fndTCPServer1.Socket.State)]); 320 321 fndUDPClientSocket1.Terminate; 322 fndUDPClientSocket1.LocalHost := IPAddrToStr(LocalUser.Id.Machine); 323 fndUDPClientSocket1.LocalPort := IntToStr(UDPPort); 324 fndUDPClientSocket1.Host := FActiveNetworkInterface.BroadcastIPAddress; 325 fndUDPClientSocket1.Port := IntToStr(UDPPort); 326 fndUDPClientSocket1.BroadcastOption := True; 362 end; 363 IdUDPServer1.Active := False; 364 SocketBinding := IdUDPServer1.Bindings.Add; 365 SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine); 366 SocketBinding.Port := UDPPort; 367 IdUDPServer1.BroadcastEnabled := True; 327 368 try 328 fndUDPClientSocket1.Bind;369 IdUDPServer1.Active := True; 329 370 except 330 // on EWinSock do begin 331 // ShowMessage('Nelze inicializovat síť!'); 332 // Application.Terminate; 333 // end; 334 end; 335 end; 336 with fndTCPClient1 do begin 337 Active := False; 371 end; 372 IdUDPClient1.Disconnect; 373 IdUDPClient1.Host := FActiveNetworkInterface.BroadcastIPAddress; 374 IdUDPClient1.Port := UdpPort; 375 IdUDPClient1.BroadcastEnabled := True; 376 try 377 IdUDPClient1.Connect; 378 except 379 end; 380 with IdTCPClient1 do begin 381 Disconnect; 338 382 Host := IPAddrToStr(LocalUser.Id.Machine); // 'localhost'; 339 Port := IntToStr(UDPPort + 1); 340 LocalHost := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 383 Port := UDPPort + 1; 384 BoundIP := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 385 Connect; 386 (* 341 387 I := 2; 342 388 repeat 343 Active := False;344 LocalPort := IntToStr(UDPPort+I);389 Disconnect; 390 //BoundPort := UDPPort + I; 345 391 I := I + 1; 346 392 try 347 Active := True;393 Connect; 348 394 except 349 395 end; 350 396 II := 0; 351 while ( Socket.State in [ssResolving, ssNegotiating, ssConnecting]) and (II<100) do begin397 while (not Connected and (II < 100)) do begin 352 398 Application.ProcessMessages; 353 //Sleep(10);399 Sleep(10); 354 400 II := II + 1; 355 401 end; 356 402 // ShowMessage(Stav[Integer(fndTCPClient1.Socket.State)]); 357 until (Socket.State in [ssConnected, ssResolved]) or (I>30); //or (fndTCPServer1.Socket.State = ssClosed); 358 FConnected := not (fndUDPClientSocket1.Bound xor (fndTCPServer1.Socket.State = ssListening)) and 359 (fndTCPClient1.Socket.State in [ssConnected, ssResolved]); 403 until (Connected) or (I > 30); //or (fndTCPServer1.Socket.State = ssClosed); 404 *) 405 FConnected := IdUDPServer1.Active and IdUDPClient1.Active and 406 IdTCPServer1.Active and IdTCPClient1.Connected; 360 407 //ShowMessage(IntToStr(Integer(fndTCPClient1.Socket.State))+','+BoolToStr(fndUDPClientSocket1.Bound) 361 408 //+','+BoolToStr(FConnected)+','+BoolToStr(fndTCPClient1.Socket.Connected)); … … 367 414 end; 368 415 finally 369 fndTCPClient1.OnClose := fndTCPClient1Close;416 IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect; 370 417 end; 371 418 end; … … 374 421 begin 375 422 FAutoReconnect := False; 376 fndTCPClient1.Active := False;; 377 fndTCPServer1.Active := False; 378 fndUDPClientSocket1.Bound := False; 423 if IdTCPClient1.Connected then IdTCPClient1.Disconnect; 424 IdTCPServer1.Active := False; 425 IdUDPClient1.Active := False; 426 IdUDPServer1.Active := False; 379 427 end; 380 428 -
trunk/UMainWindow.dfm
r13 r15 3 3 Top = 296 4 4 Caption = 'SunriseChat' 5 ClientHeight = 3 725 ClientHeight = 392 6 6 ClientWidth = 471 7 7 Color = clBtnFace … … 28 28 Top = 0 29 29 Width = 471 30 Height = 3 7230 Height = 392 31 31 Align = alClient 32 32 BevelOuter = bvNone 33 33 FullRepaint = False 34 34 TabOrder = 0 35 ExplicitHeight = 3 5235 ExplicitHeight = 372 36 36 object Splitter3: TSplitter 37 37 Left = 323 38 38 Top = 0 39 39 Width = 2 40 Height = 3 4240 Height = 362 41 41 Align = alRight 42 42 ExplicitLeft = 322 … … 45 45 object Panel4: TPanel 46 46 Left = 0 47 Top = 3 4247 Top = 362 48 48 Width = 471 49 49 Height = 30 … … 52 52 FullRepaint = False 53 53 TabOrder = 0 54 ExplicitTop = 3 2254 ExplicitTop = 342 55 55 DesignSize = ( 56 56 471 … … 91 91 Top = 0 92 92 Width = 26 93 Height = 3 4293 Height = 362 94 94 Align = alRight 95 95 BevelOuter = bvNone 96 96 TabOrder = 1 97 ExplicitHeight = 3 2297 ExplicitHeight = 342 98 98 object ToolBar1: TToolBar 99 99 Left = 0 100 Top = 188100 Top = 208 101 101 Width = 26 102 102 Height = 154 … … 109 109 TabOrder = 0 110 110 Transparent = False 111 ExplicitTop = 1 68111 ExplicitTop = 188 112 112 object ToolButton1: TToolButton 113 113 Left = 0 … … 182 182 Top = 0 183 183 Width = 120 184 Height = 3 42184 Height = 362 185 185 Align = alRight 186 186 BevelOuter = bvNone 187 187 FullRepaint = False 188 188 TabOrder = 2 189 ExplicitHeight = 3 22189 ExplicitHeight = 342 190 190 DesignSize = ( 191 191 120 192 3 42)192 362) 193 193 object Label1: TLabel 194 194 Left = 2 … … 202 202 Top = 20 203 203 Width = 116 204 Height = 3 19204 Height = 339 205 205 Hint = 'Seznam online u'#382'ivatel'#367 206 206 Anchors = [akLeft, akTop, akRight, akBottom] … … 217 217 OnClick = ListView1Click 218 218 OnInfoTip = ListView1InfoTip 219 ExplicitHeight = 299219 ExplicitHeight = 319 220 220 end 221 221 end … … 224 224 Top = 0 225 225 Width = 323 226 Height = 3 42226 Height = 362 227 227 Align = alClient 228 228 BevelOuter = bvNone 229 229 FullRepaint = False 230 230 TabOrder = 3 231 ExplicitHeight = 3 22231 ExplicitHeight = 342 232 232 DesignSize = ( 233 233 323 234 3 42)234 362) 235 235 object Label2: TLabel 236 236 Left = 8 … … 253 253 Top = 0 254 254 Width = 317 255 Height = 2 50255 Height = 270 256 256 ActivePage = TabSheet1 257 257 Anchors = [akLeft, akTop, akRight, akBottom] … … 266 266 TabOrder = 1 267 267 OnChange = TabControl1Change 268 ExplicitHeight = 2 30268 ExplicitHeight = 250 269 269 object TabSheet1: TTabSheet 270 270 Caption = 'TabSheet1' … … 276 276 ImageIndex = 1 277 277 ParentFont = False 278 ExplicitHeight = 2 01278 ExplicitHeight = 221 279 279 end 280 280 end … … 283 283 Top = 20 284 284 Width = 317 285 Height = 3 20285 Height = 340 286 286 Anchors = [akLeft, akTop, akRight, akBottom] 287 287 BevelOuter = bvNone … … 291 291 TabOrder = 0 292 292 OnResize = Panel6Resize 293 ExplicitHeight = 3 00293 ExplicitHeight = 320 294 294 object ListView2: TListView 295 295 Left = 0 296 296 Top = 0 297 297 Width = 317 298 Height = 3 20298 Height = 340 299 299 Align = alClient 300 300 Columns = <> 301 301 TabOrder = 1 302 ExplicitHeight = 3 00302 ExplicitHeight = 320 303 303 end 304 304 object RichView1: TRichView … … 2018 2018 Top = 112 2019 2019 end 2020 object fndUDPSocket1: TfndUDPSocket2021 Left = 482022 Top = 2162023 end2024 object fndUDPClientSocket1: TfndUDPClientSocket2025 Left = 1442026 Top = 2322027 end2028 2020 end -
trunk/UMainWindow.pas
r13 r15 11 11 StdActns, ULogExceptions, RVScroll, RichView, RVStyle, UTextFileStream, 12 12 ShellAPI, SunriseChatCoreUnit, SunriseChatNetworkCoreUnit, IdBaseComponent, 13 IdComponent, IdUDPBase, IdUDPServer, XPMan; 13 IdComponent, IdUDPBase, IdUDPServer, XPMan, IdUDPClient, IdCustomTCPServer, 14 IdTCPServer, IdTCPConnection, IdTCPClient, IdAntiFreezeBase, IdAntiFreeze; 14 15 15 16 const … … 180 181 XPManifest1: TXPManifest; 181 182 Log1: TMenuItem; 182 fndUDPSocket1: TfndUDPSocket;183 fndUDPClientSocket1: TfndUDPClientSocket;184 183 procedure FormCreate(Sender: TObject); 185 184 procedure FormShow(Sender: TObject); … … 1422 1421 Text: string; 1423 1422 begin 1424 SetLength(AppEventsOptions, Length(AppEvents));1425 for I := 0 to High(AppEventsOptions) do begin1423 SetLength(AppEventsOptions, Length(AppEvents)); 1424 for I := 0 to High(AppEventsOptions) do begin 1426 1425 //if not Assigned(AppEventsOptions[I]) then 1427 AppEventsOptions[I] := TAutoRegistry.Create(RegistryPath+'\'+SettingsName+'\AppEvents\'+IntToStr(I)); 1426 AppEventsOptions[I] := TAutoRegistry.Create(RegistryPath + '\' + SettingsName + 1427 '\AppEvents\' + IntToStr(I)); 1428 1428 with AppEventsOptions[I], AppEvents[I] do begin 1429 Include('ShowWindow', ShowWindow,ShowWindow);1430 Include('ShowAlertIcon', ShowAlertIcon,ShowAlertIcon);1431 Include('ShowBaloonHint', ShowBalloonHint,ShowBalloonHint);1432 Include('PlayBeep', PlayBeep,PlayBeep);1433 Include('PlaySound' ,PlaySound,PlaySound);1434 Include('SoundFile', SoundFile,'');1435 Include('ExecuteApplication', ExecuteApplication,False);1436 Include('ApplicationFile', ApplicationFile,'');1437 Include('ShowMessage', ShowMessage,ShowMessage);1438 Include('MessageText', MessageText,MessageText);1439 Include('IconFile', IconFile,'Envelope.ico');1429 Include('ShowWindow', ShowWindow, ShowWindow); 1430 Include('ShowAlertIcon', ShowAlertIcon, ShowAlertIcon); 1431 Include('ShowBaloonHint', ShowBalloonHint, ShowBalloonHint); 1432 Include('PlayBeep', PlayBeep, PlayBeep); 1433 Include('PlaySound' ,PlaySound, PlaySound); 1434 Include('SoundFile', SoundFile, ''); 1435 Include('ExecuteApplication', ExecuteApplication, False); 1436 Include('ApplicationFile', ApplicationFile, ''); 1437 Include('ShowMessage', ShowMessage, ShowMessage); 1438 Include('MessageText', MessageText, MessageText); 1439 Include('IconFile', IconFile, 'Envelope.ico'); 1440 1440 // Font 1441 Include('FontColor', MessageFontTemp.Color,Integer(clBlack));1442 Include('FontStyle', MessageFontTemp.Style,'');1443 Include('FontCharset', MessageFontTemp.Charset,1);1441 Include('FontColor', MessageFontTemp.Color, Integer(clBlack)); 1442 Include('FontStyle', MessageFontTemp.Style, ''); 1443 Include('FontCharset', MessageFontTemp.Charset, 1); 1444 1444 Include('FontSize', MessageFontTemp.Size, 8); 1445 1445 Include('FontName', MessageFontTemp.Name, 'MS Sans Serif'); 1446 1446 LoadFromRegistry; 1447 1447 MessageFont.Color := MessageFontTemp.Color; 1448 while Pos(',', MessageFontTemp.Style) >0 do begin1449 Text := Copy(MessageFontTemp.Style, 1, Pos(',', MessageFontTemp.Style)-1);1450 System.Delete(MessageFontTemp.Style, 1, Length(Text) +1);1448 while Pos(',', MessageFontTemp.Style) > 0 do begin 1449 Text := Copy(MessageFontTemp.Style, 1, Pos(',', MessageFontTemp.Style) - 1); 1450 System.Delete(MessageFontTemp.Style, 1, Length(Text) + 1); 1451 1451 if Text = 'Bold' then MessageFont.Style := MessageFont.Style + [fsBold]; 1452 1452 if Text = 'Italic' then MessageFont.Style := MessageFont.Style + [fsItalic]; … … 1467 1467 SetLength(AppUserEventsOptions, AppUserEventsCount); 1468 1468 SetLength(AppUserEvents, AppUserEventsCount); 1469 for I := 0 to AppUserEventsCount -1 do begin1469 for I := 0 to AppUserEventsCount - 1 do begin 1470 1470 //if not Assigned(AppEventsOptions[I]) then 1471 AppUserEventsOptions[I] := TAutoRegistry.Create(RegistryPath+'\'+SettingsName+'\AppUserEvents\'+IntToStr(I)); 1471 AppUserEventsOptions[I] := TAutoRegistry.Create(RegistryPath + '\' + 1472 SettingsName + '\AppUserEvents\' + IntToStr(I)); 1472 1473 with AppUserEventsOptions[I], AppUserEvents[I] do begin 1473 1474 Update := UpdateOnly; … … 1476 1477 Include('ConditionUserEnable', ConditionUserEnable, ConditionUserEnable); 1477 1478 Include('ConditionUser', ConditionUser, ConditionUser); 1478 Include('ConditionAppEventEnable', ConditionAppEventEnable, ConditionAppEventEnable);1479 Include('ConditionAppEvent', ConditionAppEvent,ConditionAppEvent);1480 Include('ShowWindow', ShowWindow,ShowWindow);1481 Include('ShowAlertIcon', ShowAlertIcon,ShowAlertIcon);1482 Include('IconFile', IconFile,'Envelope.ico');1483 Include('ShowBaloonHint', ShowBalloonHint,ShowBalloonHint);1484 Include('PlayBeep', PlayBeep,PlayBeep);1485 Include('PlaySound', PlaySound,PlaySound);1486 Include('SoundFile', SoundFile,'');1487 Include('ExecuteApplication', ExecuteApplication,False);1488 Include('ApplicationFile', ApplicationFile,'');1489 Include('ShowImage', ShowImage,ShowImage);1490 Include('ImageFile', ImageFile,ImageFile);1491 Include('EventName', EventName,EventName);1479 Include('ConditionAppEventEnable', ConditionAppEventEnable, ConditionAppEventEnable); 1480 Include('ConditionAppEvent', ConditionAppEvent, ConditionAppEvent); 1481 Include('ShowWindow', ShowWindow, ShowWindow); 1482 Include('ShowAlertIcon', ShowAlertIcon, ShowAlertIcon); 1483 Include('IconFile', IconFile, 'Envelope.ico'); 1484 Include('ShowBaloonHint', ShowBalloonHint, ShowBalloonHint); 1485 Include('PlayBeep', PlayBeep, PlayBeep); 1486 Include('PlaySound', PlaySound, PlaySound); 1487 Include('SoundFile', SoundFile, ''); 1488 Include('ExecuteApplication', ExecuteApplication, False); 1489 Include('ApplicationFile', ApplicationFile, ''); 1490 Include('ShowImage', ShowImage, ShowImage); 1491 Include('ImageFile', ImageFile, ImageFile); 1492 Include('EventName', EventName, EventName); 1492 1493 LoadFromRegistry; 1493 1494 end; … … 1506 1507 Settings: string; 1507 1508 begin 1508 if SettingsName = 'Default' then Settings:= '' else Settings:= '('+SettingsName+')'; 1509 if SunriseChatNetworkCore1.Connected then NewCaption:= '' else NewCaption:= ' (Offline)'; 1510 Caption:= ApplicationName+Settings+' - '+SunriseChatNetworkCore1.LocalUser.Nick+NewCaption; 1509 if SettingsName = 'Default' then Settings:= '' else Settings:= '(' + SettingsName + ')'; 1510 if SunriseChatNetworkCore1.Connected then NewCaption := '' 1511 else NewCaption := ' (Offline)'; 1512 Caption := ApplicationName + Settings + ' - ' + 1513 SunriseChatNetworkCore1.LocalUser.Nick + NewCaption; 1511 1514 end; 1512 1515 … … 1514 1517 var InfoTip: String); 1515 1518 begin 1516 InfoTip := TUser(SunriseChatNetworkCore1.UserList[Item.Index]).DetailInfo;1519 InfoTip := TUser(SunriseChatNetworkCore1.UserList[Item.Index]).DetailInfo; 1517 1520 end; 1518 1521 … … 1526 1529 //if Pos(':',ComboBox1.Text) = 0 then 1527 1530 DoplnitJmeno; 1528 ComboBox1.SelStart := ComboBox1.SelStart + 1;1531 ComboBox1.SelStart := ComboBox1.SelStart + 1; 1529 1532 end; 1530 1533 … … 1554 1557 procedure TMainWindow.SearchFind1BeforeExecute(Sender: TObject); 1555 1558 begin 1556 SearchFind1.Dialog.Options := [frHideUpDown];1559 SearchFind1.Dialog.Options := [frHideUpDown]; 1557 1560 end; 1558 1561 … … 1562 1565 begin 1563 1566 with SunriseChatNetworkCore1 do begin 1564 for I := 0 to ActiveRoom.Count -1 do1567 for I := 0 to ActiveRoom.Count - 1 do 1565 1568 TRoomLine(ActiveRoom.Lines[I]).Font.Free; 1566 1569 ActiveRoom.Count := 0; … … 1694 1697 I: Integer; 1695 1698 begin 1696 ComboBox1.Style := csDropDown;1699 ComboBox1.Style := csDropDown; 1697 1700 with SunriseChatNetworkCore1, ComboBox1.Items do begin 1698 1701 BeginUpdate; 1699 1702 Clear; 1700 for I := 0 to UserList.Count -1 do with TUser(UserList[I]) do begin1701 if Copy(Nick, 1,Length(ComboBox1.Text)) = ComboBox1.Text then Add(Nick+': ');1703 for I := 0 to UserList.Count - 1 do with TUser(UserList[I]) do begin 1704 if Copy(Nick, 1, Length(ComboBox1.Text)) = ComboBox1.Text then Add(Nick + ': '); 1702 1705 end; 1703 1706 Update; 1704 1707 EndUpdate; 1705 if ComboBox1.Items.Count >0 then ComboBox1.DroppedDown:= True;1708 if ComboBox1.Items.Count > 0 then ComboBox1.DroppedDown:= True; 1706 1709 end; 1707 1710 end; … … 1714 1717 procedure TMainWindow.ComboBox1DropDown(Sender: TObject); 1715 1718 begin 1716 ComboBox1.Style := csSimple;1719 ComboBox1.Style := csSimple; 1717 1720 end; 1718 1721 1719 1722 procedure TMainWindow.ComboBox1CloseUp(Sender: TObject); 1720 1723 begin 1721 ComboBox1.Style := csSimple;1722 ComboBox1.SelStart := -1;1724 ComboBox1.Style := csSimple; 1725 ComboBox1.SelStart := -1; 1723 1726 end; 1724 1727 … … 1733 1736 begin 1734 1737 RichView1.Clear; 1735 for I := 0 to High(AppUserEvents) do1738 for I := 0 to High(AppUserEvents) do 1736 1739 if Assigned(AppUserEvents[I].Image) then FreeAndNil(AppUserEvents[I].Image); 1737 1740 TabControl1Change(Self); … … 1767 1770 Clear; 1768 1771 AddStrings(StringList); 1769 if Count >0 then DroppedDown:= True;1772 if Count > 0 then DroppedDown:= True; 1770 1773 Update; 1771 1774 EndUpdate; … … 1819 1822 SoundDisable := True; 1820 1823 SunriseChatNetworkCore1.SendCommand(scDisconnect); 1824 SunriseChatNetworkCore1.Free; 1821 1825 Options.Free; 1822 1826 for I := 0 to High(AppEvents) do
Note:
See TracChangeset
for help on using the changeset viewer.