/ProSnooperFx_src/ProSnooper200b202src/mainform.pas

(*

This program is licensed under the rndware License, which can be found in LICENSE.TXT

Copyright (c) Simon Hughes 2007-2008

*)
unit mainform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, Menus, StrUtils, vortex,
  CoolTrayIcon, Registry, IdHTTP, ShellAPI, DockPanel, nickdock, gamedock,
  ImgList, IdCmdTCPClient, IdContext, IdAntiFreezeBase,
  IdAntiFreeze, RichEditURL, DBCtrls, richedit;

type

  TWords = class
  private
    FText: string;
    FWords: TStringList;
    procedure Parse;
    function GetWord(Index: Integer): string;
    procedure SetText(const Value: string);
    function GetCount: integer;
  public
    constructor Create;
    destructor Destroy; override;
    function ConcatToEnd(From: integer): string;
    property Text: string
      read  FText
      write SetText;
    property Words[Index: Integer]: string
      read  GetWord;
      default;
    property Count: integer
      read  GetCount;
  end;

  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    Files1: TMenuItem;
    Exit1: TMenuItem;
    About1: TMenuItem;
    Panel1: TPanel;
    rechat: TRichEditURL;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    Connection1: TMenuItem;
    SaveDialog1: TSaveDialog;
    Saveas1: TMenuItem;
    N1: TMenuItem;
    irc: TVortex;
    CoolTrayIcon1: TCoolTrayIcon;
    Autologin1: TMenuItem;
    tmrGames: TTimer;
    pmChatEditBox: TPopupMenu;
    Copy1: TMenuItem;
    N4: TMenuItem;
    SelectAll1: TMenuItem;
    http: TIdHTTP;
    DockPanel1: TDockPanel;
    Settings1: TMenuItem;
    DockPanel2: TDockPanel;
    DockPanel3: TDockPanel;
    DockPanel4: TDockPanel;
    Games1: TMenuItem;
    JoindirectIP1: TMenuItem;
    N2: TMenuItem;
    N5: TMenuItem;
    lbIgnore: TListBox;
    N6: TMenuItem;
    HostWormnet1: TMenuItem;
    pnAway: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Channellist1: TMenuItem;
    IdAntiFreeze1: TIdAntiFreeze;
    Label3: TLabel;
    lblHiLites: TLabel;
    Label5: TLabel;
    lblMsgs: TLabel;
    tmrWhoCompat: TTimer;
    lbIgnoreAway: TListBox;
    Icons: TImageList;
    FD: TFindDialog;
    N3: TMenuItem;
    Find1: TMenuItem;
    Clear1: TMenuItem;
    Image1: TImage;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure rechatMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbnicksMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Saveas1Click(Sender: TObject);
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ircMOTD(Line: String; EndOfMotd: Boolean);
    procedure ircNickInUse(Nickname: String);
    procedure ircChannelMessage(Channelname, Content, Nickname, Ident,
      Mask: String);
    procedure ircAfterPrivateMessage(Nickname, Ident, Mask,
      Content: String);
    procedure ircAfterUserJoin(Nickname, Hostname, Channel: String);
    procedure ircAfterUserPart(Nickname, Hostname, Channelname,
      Reason: String);
    procedure ircAfterUserQuit(Nickname, Reason: String);
    procedure ircNames(Commanicks, Channel: String; endofnames: Boolean);
    procedure ircAfterUserKick(KickedUser, Kicker, Channel,
      Reason: String);
    procedure ircConnect;
    procedure ircDisconnect;
    procedure ircAfterAction(NickName, Content, Destination: String);
    procedure About1Click(Sender: TObject);
    procedure CoolTrayIcon1Click(Sender: TObject);
    procedure CoolTrayIcon1MinimizeToTray(Sender: TObject);
    procedure lbGamesMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure Autologin1Click(Sender: TObject);
    procedure tmrGamesTimer(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Settings1Click(Sender: TObject);
    procedure AddRichLine(RichEdit: TRichEdit; const StrToAdd: String);
    procedure JoindirectIP1Click(Sender: TObject);
   procedure ircQuoteServer(Command: String);
    function FindListViewItem(lv: TListView; const S: string; column: Integer): TListItem;
    procedure ircWho(Channel, Nickname, Username, Hostname, Name,
      Servername, status, other: String; EndOfWho: Boolean);
    procedure ircAfterJoined(Channelname: String);
    procedure HostWormnet1Click(Sender: TObject);
    procedure GoAway(Reason: String);
    procedure FormDestroy(Sender: TObject);
    procedure ircServerError(ErrorString: String);
    procedure Label2Click(Sender: TObject);
    procedure Channellist1Click(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure tmrWhoCompatTimer(Sender: TObject);
    procedure ircAfterUserNickChange(Oldnick, Newnick: String);
    procedure rechatURLClick(Sender: TObject; const URL: String);
    procedure Find1Click(Sender: TObject);
    procedure FDFind(Sender: TObject);
    function FindText(const SearchStr: string;
               StartPos, FindLength : LongInt; Options: TSearchTypes;
               SearchDown: Boolean = TRUE): Integer;
    procedure Clear1Click(Sender: TObject);
    procedure ircNoSuchNickChannel(Value: String);
    procedure ircAfterInvited(NickName, Channel: String);
    procedure ircMode(Nickname, Destination, Mode: String);
    procedure SetFlagRank(Flag, Rank: Integer; Nickname: String);
    procedure ircAfterTopic(ChannelName, Nickname, Topic: String);
  private
    procedure AppException(Sender: TObject; E: Exception);
  public
    IsAway: Boolean;
    function MakeTimeStamp: String;
    function MakeTimeStampNoTags: String;
  end;

var
  frmMain: TfrmMain;
  PreviousFoundPos: integer;
  nickfrm: TfrmdkNickList;
  gmfrm: TfrmdkGmList;
  AwayReason: String;

implementation

uses loginform, aboutform, preferform, joinform, hostform,
  chanlistform, messagesform;


{$R *.dfm}

procedure TfrmMain.AppException(Sender: TObject; E: Exception);
begin
  AddRichLine(rechat,MakeTimeStamp+'ProSnooperFx error: '+e.Message+' ['+Sender.ClassName+']');
end;

constructor TWords.Create;
begin
  inherited;
  FWords := TStringList.Create;
end;

destructor TWords.Destroy;
begin
  FWords.Free;
  inherited;
end;

function TWords.GetCount: integer;
begin
  Result := FWords.Count;
end;

function TWords.GetWord(Index: Integer): string;
begin
  if index >= Count then
    Result := ''
  else
    Result := FWords[index];
end;

procedure TWords.Parse;
var
  i: integer;
  w: string;
begin
  FWords.Clear;
  w := '';
  for i := 1 to Length(FText) do
  begin
    case FText[i] of
    #9, #10, #13, #32: // whitespace
      if w <> '' then
      begin
        FWords.Add(w);
        w := '';
      end;
    else
      w := w + FText[i]
    end;
  end;
  if w <> '' then
    FWords.Add(w);
end;

procedure TWords.SetText(const Value: string);
begin
  if Value <> FText then
  begin
    FText := Value;
    Parse;
  end;
end;

function TWords.ConcatToEnd(From: integer): string;
var
  i: integer;
begin
  result := '';
  for i := From to Count-1 do
  begin
    if i <> From then
      Result := Result + ' ';
    Result := Result + Words[i];
  end;
end;

procedure TfrmMain.AddRichLine(RichEdit: TRichEdit; const StrToAdd: String);
var
   StrLeft: String;
   TempStyle: TFontStyles;
   TempStr: String;
   changed: boolean;
   HadFocus: Boolean;
   WasHideSel: Boolean;
   SelSt, SelL: Integer;

   function FromLeftUntilStr(var OriginalStr: String; const UntilStr: String; const ToEndIfNotFound, Trim: Boolean): String;
   var
      TempPos: Integer;
   begin
      TempPos := Pos(UntilStr, OriginalStr);
      If TempPos > 0 Then
         Begin
            Result := Copy(OriginalStr, 1, TempPos - 1);
            If Trim Then
               Delete(OriginalStr, 1, TempPos - 1);
         End
            Else
         Begin
            If ToEndIfNotFound Then
               Begin
                  Result := OriginalStr;
                  If Trim Then
                     OriginalStr := '';
               End
                  Else
               Result := '';
         End;
   end;

   function FromLeftUntilStrX(var OriginalStr: String; const UntilStr: String; const ToEndIfNotFound, Trim: Boolean): String;
   var
      xStr : String;
   begin
      xStr := Copy(OriginalStr,2,Length(OriginalStr));
      result := '<' + FromLeftUntilStr(xStr,UntilStr,ToEndIfNotFound,Trim);
      OriginalStr := xStr;
   end;

   function StrStartsWith(var OriginalStr: String; const StartsWith: String; const IgnoreCase, Trim: Boolean): Boolean;
   var
      PartOfOriginalStr: String;
      NewStartsWith: String;
   begin
      PartOfOriginalStr := Copy(OriginalStr, 1, Length(StartsWith));
      NewStartsWith := StartsWith;

      If IgnoreCase Then Begin
         PartOfOriginalStr := LowerCase(PartOfOriginalStr);
         NewStartsWith := LowerCase(NewStartsWith);
      End;

      Result := PartOfOriginalStr = NewStartsWith;

      If (Result = True) And (Trim = True) Then
         Delete(OriginalStr, 1, Length(NewStartsWith));
   end;

   procedure AddToStyle(var Style: TFontStyles; AStyle: TFontStyle);
   begin
      If Not (AStyle In Style) Then
         Style := Style + [AStyle];
   end;

   procedure RemoveFromStyle(var Style: TFontStyles; AStyle: TFontStyle);
   begin
      If AStyle In Style Then
         Style := Style - [AStyle];
   end;
begin
   // ProSnooperFx hack: don't move the scrollbar
   if frmSettings.cbDisableScroll.Checked then begin
     HadFocus := GetFocus = RichEdit.Handle;
     if HadFocus then Windows.SetFocus(0);
      WasHideSel := RichEdit.HideSelection;
     RichEdit.HideSelection := true;
     SelSt := RichEdit.SelStart;
     SelL := RichEdit.SelLength;
   end;

   TempStyle := RichEdit.Font.Style;
   StrLeft := StrToAdd;
   RichEdit.SelStart := Length(RichEdit.Text);
   
   if Pos('\',StrLeft) <> 0 then begin
   StrLeft := StringReplace(StrLeft,'\r','<pcol=clRed>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\b','<pcol=clAqua>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\g','<pcol=clLime>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\k','<pcol=clGray>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\n','<pcol=clMedGray>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\p','<pcol=$00FCB6F4>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\w','<pcol=clWhite>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\y','<pcol=clYellow>',[rfReplaceAll, rfIgnoreCase]);
   StrLeft := StringReplace(StrLeft,'\m','<pcol=clMoneyGreen>',[rfReplaceAll, rfIgnoreCase]);
   end;

   While StrLeft > '' Do Begin

      If StrStartsWith(StrLeft, '<', True, False) then
         Begin
            changed := false;
            // Bold Style
            If StrStartsWith(StrLeft, '<b>', True, True) Then
               begin AddToStyle(TempStyle, fsBold); changed := true; end;
            If StrStartsWith(StrLeft, '</b>', True, True) Then
               begin RemoveFromStyle(TempStyle, fsBold); changed := true; end;

            // Italic Style
            If StrStartsWith(StrLeft, '<i>', True, True) Then
               begin AddToStyle(TempStyle, fsItalic); changed := true; end;
            If StrStartsWith(StrLeft, '</i>', True, True) Then
               begin RemoveFromStyle(TempStyle, fsItalic); changed := true; end;

            // Underline Style
            If StrStartsWith(StrLeft, '<u>', True, True) Then
               begin AddToStyle(TempStyle, fsUnderline); changed := true; end;
            If StrStartsWith(StrLeft, '</u>', True, True) Then
               begin RemoveFromStyle(TempStyle, fsUnderline); changed := true; end;

            // Strikeout Style
            If StrStartsWith(StrLeft, '<s>', True, True) Then
               begin AddToStyle(TempStyle, fsStrikeOut); changed := true; end;
            If StrStartsWith(StrLeft, '</s>', True, True) Then
               begin RemoveFromStyle(TempStyle, fsStrikeOut); changed := true; end;

            // Color
            If StrStartsWith(StrLeft, '</color>', True, True) Then
               begin RichEdit.SelAttributes.Color := RichEdit.Font.Color; changed := true; end;
            If StrStartsWith(StrLeft, '<color=', True, True) Then Begin
               TempStr := FromLeftUntilStr(StrLeft, '>', False, True); changed := true;
               Try
                  RichEdit.SelAttributes.Color := StringToColor('cl'+TempStr);
               Except
                  RichEdit.SelAttributes.Color := RichEdit.Font.Color;
               End;
               Delete(StrLeft, 1, 1);
            End;

            If StrStartsWith(StrLeft, '</pcol>', True, True) Then
               begin RichEdit.SelAttributes.Color := RichEdit.Font.Color; changed := true; end;
            If StrStartsWith(StrLeft, '<pcol=', True, True) Then Begin
               TempStr := FromLeftUntilStr(StrLeft, '>', False, True); changed := true;
               Try
                  RichEdit.SelAttributes.Color := StringToColor(TempStr);
               Except
                  RichEdit.SelAttributes.Color := RichEdit.Font.Color;
               End;
               Delete(StrLeft, 1, 1);
            End;
            
            if not changed then
            begin
                RichEdit.SelAttributes.Style := TempStyle;
                RichEdit.Font.Color := frmSettings.colText2.Selected;
                RichEdit.SelAttributes.Size := StrToInt(frmSettings.edFntSize.Text);
                RichEdit.SelText := FromLeftUntilStrX(StrLeft, '<', True, True);

            end;
         End
         Else
         Begin
            RichEdit.SelAttributes.Style := TempStyle;
            RichEdit.Font.Color := frmSettings.colText2.Selected;
            RichEdit.SelAttributes.Size := StrToInt(frmSettings.edFntSize.Text);
            RichEdit.SelText := FromLeftUntilStr(StrLeft, '<', True, True);
         End;

      RichEdit.SelStart := Length(RichEdit.Text);
   End;
   RichEdit.SelText := #13#10;

   if frmSettings.cbDisableScroll.Checked then begin
      RichEdit.SelStart := SelSt;
      RichEdit.SelLength := SelL;
      if not WasHideSel then
       RichEdit.HideSelection := false;
      if HadFocus then
       Windows.SetFocus(RichEdit.Handle);
   end;
end;

function TfrmMain.MakeTimeStamp: String;
begin
  if frmSettings.cbTimeStamps.Checked = True then
   Result := '<pcol='+ColorToString(frmSettings.colText2.Selected)+'>['+FormatDateTime(frmSettings.edTimeStamp.Text,now)+']</pcol> '
  else
   Result := '';
end;

function TfrmMain.MakeTimeStampNoTags: String;
begin
  if frmSettings.cbTimeStamps.Checked = True then
    Result := '['+FormatDateTime(frmSettings.edTimeStamp.Text,now)+'] '
  else
   Result := '';
end;

procedure TfrmMain.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
W: TWords;
S: String;
begin
 if Key = VK_RETURN then begin
  W := TWords.Create;
  W.Text := Memo1.Text;

  if LowerCase(W[0]) = '/me' then begin
   irc.SendCTCP(frmLogin.cbchan.Text, 'ACTION '+W.ConcatToEnd(1)+#1);
   AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colActions.Selected)+'><i>* <b>'+irc.IrcOptions.MyNick+' '+W.ConcatToEnd(1)+'</i></b></pcol>');
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if LowerCase(W[0]) = '/quote' then begin
   IRC.Quote(W.ConcatToEnd(1));
   AddRichLine(rechat,MakeTimeStamp+'Command to server: '+W.ConcatToEnd(1));
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if LowerCase(W[0]) = '/msg' then begin
   irc.Say(W[1], W.ConcatToEnd(2));
   AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colPrivate.Selected)+'>-> <b>['+W[1]+'] '+W.ConcatToEnd(2)+'</pcol></b>');
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if LowerCase(W[0]) = '/away' then begin
   GoAway(w.ConcatToEnd(1));
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if LowerCase(W[0]) = '/sex' then begin
   try
    S := http.Get('http://djlol.dk/sex/');
   finally
    irc.Say(frmLogin.cbchan.Text,S);
    AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colText1.Selected)+'><b>['+irc.IrcOptions.Mynick+'] '+S+'</b></pcol>');
   end;
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if LowerCase(W[0]) = '/buddymsg' then begin
   irc.Say(frmSettings.lbBuddies.Items.CommaText,W.ConcatToEnd(1));
   AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colPrivate.Selected)+'>-> <b>[*All buddies*] '+W.ConcatToEnd(1)+'</b></pcol>');
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  if Copy(W[0],1,1) = '/' then begin
   AddRichLine(rechat,MakeTimeStamp+'Unknown command.');
   W.Free;
   Memo1.Clear;
   Exit;
  end;

  irc.Say(frmLogin.cbchan.Text,Memo1.Text);
  AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colText1.Selected)+'><b>['+irc.IrcOptions.Mynick+'] '+Memo1.Text+'</b></pcol>');

  W.Free;
  Memo1.Clear;

 end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   function  GetAppVersion:string;
   var
    Size, Size2: DWord;
    Pt, Pt2: Pointer;
   begin
     Size := GetFileVersionInfoSize(PChar (ParamStr (0)), Size2);
     if Size > 0 then
     begin
       GetMem (Pt, Size);
       try
          GetFileVersionInfo (PChar (ParamStr (0)), 0, Size, Pt);
          VerQueryValue (Pt, '\', Pt2, Size2);
          with TVSFixedFileInfo (Pt2^) do
          begin
            Result:= IntToStr (HiWord (dwFileVersionMS)) + '.' +
                     IntToStr (LoWord (dwFileVersionMS)) + '.' +
                     IntToStr (HiWord (dwFileVersionLS)) + ' build ' +
                     IntToStr (LoWord (dwFileVersionLS));
         end;
       finally
         FreeMem (Pt);
       end;
     end;
   end;

var
ans: Word;
begin
ans := MessageDlg('Do you really want to quit?', mtConfirmation,[mbYes, mbNo], 0);
 if ans = mrNo then
  CanClose := false
 else begin
  DockHandler.SaveDesktop('\Software\ProSnooperFx');
  
  if frmMain.WindowState <> wsMaximized then begin
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','Pos1',rdInteger,Height);
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','Pos2',rdInteger,Top);
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','Pos3',rdInteger,Left);
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','Pos4',rdInteger,Width);
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','Buddies',rdString,frmSettings.lbBuddies.Items.CommaText);
  end;

  if frmMain.WindowState = wsMaximized then
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','WindowState',rdString,'Maximized')
  else if frmMain.WindowState = wsMinimized then
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','WindowState',rdString,'Minimized')
  else
   frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','WindowState',rdString,'Normal');

  irc.Quit('ProSnooperFx');

  Application.Terminate;
 end;
end;

procedure TfrmMain.GoAway(Reason: String);
begin
 if IsAway = False then begin
     if Reason = '' then
      AwayReason := 'No reason specified'
     else
      AwayReason := Reason;

     AddRichLine(rechat,MakeTimeStamp+'You have been marked as being away: '+AwayReason);
     IsAway := True;

     pnAway.Show;

     tmrGames.Interval := 60000;

     if frmSettings.cbAwayAnnounce.Checked then begin
      irc.SendCTCP(frmLogin.cbchan.Text, 'ACTION is away ('+AwayReason+')'+#1);
      AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colActions.Selected)+'><i>* '+irc.IrcOptions.MyNick+' is going away ('+AwayReason+')</i></pcol>');
     end;
 end else begin
     if Reason <> '' then begin //change away reason while away
       AddRichLine(rechat,MakeTimeStamp+'Away reason changed to: '+AwayReason);
       AwayReason := Reason;
     end else begin
       AddRichLine(rechat,MakeTimeStamp+'You are not marked as being away any longer.');
       IsAway := False;
       AwayReason := '';

       lblMsgs.Caption := '0';
       lblHiLites.Caption := '0';
       frmMessages.Memo1.Clear;
       lbIgnoreAway.Clear;

       pnAway.Hide;

       tmrGames.Interval := 10000;
       tmrGames.OnTimer(nil);

       if frmSettings.cbResumeAnnounce.Checked then begin
        irc.SendCTCP(frmLogin.cbchan.Text, 'ACTION is no longer marked as being away.'+#1);
        AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colActions.Selected)+'><i>* '+irc.IrcOptions.MyNick+' is no longer marked as being away.</i></pcol>');
       end;
     end;
 end;
end;

procedure TfrmMain.rechatMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 StatusBar1.Panels[1].Text := 'Chat window: Messages are displayed here.';
end;

procedure TfrmMain.lbnicksMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 StatusBar1.Panels[1].Text := 'User list: Users on the current channel are listed here.';
end;

procedure TfrmMain.Saveas1Click(Sender: TObject);
begin
 if SaveDialog1.Execute then
  rechat.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TfrmMain.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 StatusBar1.Panels[1].Text := 'Message field: Enter your message and press ''Return'' to send.';
end;

procedure TfrmMain.ircMOTD(Line: String; EndOfMotd: Boolean);
begin
 if Endofmotd then begin
  irc.Join(frmLogin.cbchan.Text,'');
  tmrGames.OnTimer(nil);
 end;
end;

procedure TfrmMain.ircNickInUse(Nickname: String);
begin
 irc.Nick(Nickname+'-PrSnp');
end;

procedure TfrmMain.ircChannelMessage(Channelname, Content, Nickname, Ident,
  Mask: String);
begin
 if lbIgNore.Items.IndexOf(NickName) = -1 then begin

  if Pos(Lowercase(frmLogin.cbUser.Text),Lowercase(Content)) <> 0 then begin  // if highlighted
   if IsAway = True then begin
    lblHiLites.Caption := IntToStr(StrToInt(lblHiLites.Caption) + 1);
    frmMessages.Memo1.Lines.Add(MakeTimeStampNoTags+Nickname+' highlighted you: '+Content);
    if lbIgnoreAway.Items.IndexOf(NickName) = -1 then
     if frmSettings.cbSendAwayHiLite.Checked then begin
      lbIgnoreAway.Items.Add(Nickname);
      irc.Say(NickName,'Away: '+AwayReason);
     end;
   end;
   if frmSettings.cbBlink.Checked then
   CoolTrayIcon1.CycleIcons := True;
   if frmSettings.edsndHiLite.Text <> '' then begin
     frmSettings.mp.Close;
     frmSettings.mp.FileName := frmSettings.edsndHiLite.Text;
     frmSettings.mp.Open;
     frmSettings.mp.Play;
   end;

   CoolTrayIcon1.ShowBalloonHint('ProSnooperFx',Nickname+' highlighted you.',bitInfo,10);
  end; //end highlight

  AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colText1.Selected)+'>['+Nickname+'] '+Content+'</pcol>');
 end;
end;

procedure TfrmMain.ircAfterPrivateMessage(Nickname, Ident, Mask,
  Content: String);
begin
   if lbIgnore.Items.IndexOf(NickName) = -1 then begin
     if frmSettings.edsndMsg.Text <> '' then begin
       frmSettings.mp.Close;
       frmSettings.mp.FileName := frmSettings.edsndMsg.Text;
       frmSettings.mp.Open;
       frmSettings.mp.Play;
     end;

     if IsAway = True then begin // away message
      if lbIgnoreAway.Items.IndexOf(NickName) = -1 then
       if frmSettings.cbSendAwayPriv.Checked then begin
        lbIgnoreAway.Items.Add(Nickname);
        irc.Say(NickName,'Away: '+AwayReason);
       end;
       lblMsgs.Caption := IntToStr(StrToInt(lblMsgs.Caption) + 1);
       frmMessages.Memo1.Lines.Add(MakeTimeStampNoTags+Nickname+' messaged you: '+Content);
     end;

     CoolTrayIcon1.ShowBalloonHint('ProSnooperFx','You received a private message.',bitInfo,10);
     if frmSettings.cbBlink.Checked then
     CoolTrayIcon1.CycleIcons := True;

     AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colPrivate.Selected)+'><- ['+Nickname+'] '+Content+'</pcol>');
  end;
end;

procedure TfrmMain.ircAfterUserJoin(Nickname, Hostname, Channel: String);
begin
  if frmSettings.lbBuddies.Items.IndexOf(NickName) <> -1 then begin
    if frmSettings.edsndBuddy.Text <> '' then begin
      frmSettings.mp.Close;
      frmSettings.mp.FileName := frmSettings.edsndBuddy.Text;
      frmSettings.mp.Open;
      frmSettings.mp.Play;
    end;


    if frmSettings.cbBlink.Checked then
      CoolTrayIcon1.CycleIcons := True;

    CoolTrayIcon1.ShowBalloonHint('ProSnooperFx',Nickname+' logged on.',bitInfo,10);
  end;

  if frmSettings.cbJoins.Checked = True then
   AddRichLine(rechat,MakeTimeStamp+'<b><pcol='+ColorToString(frmSettings.colJoins.Selected)+'>Join: </b>'+Nickname+'.</pcol>');

  with nickfrm.lvNicks.Items.Add do begin
   ImageIndex := 49;
   SubItemImages[Subitems.Add('')] := 74;
   SubItems.Add(NickName);
   irc.whois(NickName,'');
  end;


end;

procedure TfrmMain.ircAfterUserPart(Nickname, Hostname, Channelname,
  Reason: String);
begin
 if FindListViewItem(nickfrm.lvNicks,nickname,2) <> nil then begin
     if frmSettings.cbParts.Checked = True then begin
         AddRichLine(rechat,MakeTimeStamp+'<b><pcol='+ColorToString(frmSettings.colParts.Selected)+'>Part: </b>'+Nickname+'</pcol>');
     end;

  nickfrm.lvNicks.Items[FindListViewItem(nickfrm.lvNicks,NickName,2).Index].Delete;
 end;
  
end;

procedure TfrmMain.ircAfterUserQuit(Nickname, Reason: String);
var
 ReasonTemp: String;
begin

  if FindListViewItem(nickfrm.lvNicks,nickname,2) <> nil then begin // TheCyberShadow's IRC server sends a QUIT even if the nick is not on the channel
    if frmSettings.cbJoins.Checked = True then begin
         if Reason <> '' then
          ReasonTemp := ' ('+Reason+')'
         else
          ReasonTemp := '';

         AddRichLine(rechat,MakeTimeStamp+'<b><pcol='+ColorToString(frmSettings.colQuits.Selected)+'>Quit: </b>'+Nickname+ReasonTemp+'</pcol>');
    end;

    nickfrm.lvNicks.Items[FindListViewItem(nickfrm.lvNicks,NickName,2).Index].Delete;
 end;
end;



procedure TfrmMain.ircAfterUserKick(KickedUser, Kicker, Channel,
  Reason: String);
begin
 if FindListViewItem(nickfrm.lvNicks,kickeduser,2) <> nil then begin
  AddRichLine(rechat,MakeTimeStamp+'<b><pcol='+ColorToString(frmSettings.colQuits.Selected)+'> Kick: '+KickedUser+' was kicked by '+Kicker+' ('+Reason+')</pcol>');
  nickfrm.lvNicks.Items[FindListViewItem(nickfrm.lvNicks,KickedUser,2).Index].Delete;
 end;
end;

procedure TfrmMain.ircConnect;
begin
 StatusBar1.Panels[0].Text := 'Connected.';
end;

procedure TfrmMain.ircDisconnect;
begin
 StatusBar1.Panels[0].Text := 'Disconnected.';
 AddRichLine(rechat,'You have been disconnected.');
 tmrGames.Enabled := True;
end;

procedure TfrmMain.ircAfterAction(NickName, Content, Destination: String);
begin
 if lbIgNore.Items.IndexOf(NickName) = -1 then begin


    if Pos(Lowercase(frmLogin.cbUser.Text),Lowercase(Content)) <> 0 then begin  // if highlighted
     if IsAway = True then begin
      lblHiLites.Caption := IntToStr(StrToInt(lblHiLites.Caption) + 1);
      frmMessages.Memo1.Lines.Add(MakeTimeStampNoTags+Nickname+' highlighted you: * '+Content);

      if lbIgnoreAway.Items.IndexOf(NickName) = -1 then
       if frmSettings.cbSendAwayHiLite.Checked then begin
        lbIgnoreAway.Items.Add(Nickname);
        irc.Say(NickName,'Away: '+AwayReason);
       end;
     end;

     CoolTrayIcon1.ShowBalloonHint('ProSnooperFx',Nickname+' highlighted you.',bitInfo,10);
     if frmSettings.cbBlink.Checked then
     CoolTrayIcon1.CycleIcons := True;

     if frmSettings.edsndHiLite.Text <> '' then begin
       frmSettings.mp.Close;
       frmSettings.mp.FileName := frmSettings.edsndHiLite.Text;
       frmSettings.mp.Open;
       frmSettings.mp.Play;
     end;

    end;  //end highlight


   AddRichLine(rechat,MakeTimeStamp+'<pcol='+ColorToString(frmSettings.colActions.Selected)+'><i>* '+Nickname+' '+Content+'</i></pcol>')
 end;
end;

procedure TfrmMain.About1Click(Sender: TObject);
begin
 frmAbout.ShowModal;
end;

procedure TfrmMain.CoolTrayIcon1Click(Sender: TObject);
begin
 Application.Restore;
 CoolTrayIcon1.IconVisible := False;
 CoolTrayIcon1.IconIndex := 0;
 CoolTrayIcon1.CycleIcons := False;
 frmMain.Show;
 ShowWindow(Application.Handle, SW_SHOW);
end;

procedure TfrmMain.CoolTrayIcon1MinimizeToTray(Sender: TObject);
begin
 CoolTrayIcon1.ShowBalloonHint('ProSnooperFx','ProSnooperFx has been minimized to the tray.',bitInfo,10);
 frmMain.Hide;
end;

procedure TfrmMain.lbGamesMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
StatusBar1.Panels[1].Text := 'The Game List: A list of games on the current channel. Right-click for menu.';
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
 tmrGames.Enabled := True;
 if frmLogin.cbServer.Text <> 'wormnet1.team17.com' then tmrWhoCompat.Enabled := True;
 frmLogin.Hide;
 frmSettings.SetColors;
end;

procedure TfrmMain.Autologin1Click(Sender: TObject);
begin
  frmLogin.SetRegistryData(HKEY_CURRENT_USER,'\Software\ProSnooperFx','AutoLogin',rdString,BoolToStr(AutoLogin1.Checked))
end;

procedure TfrmMain.tmrGamesTimer(Sender: TObject);
var
W: TWords;
Sl: TStringList;
I, ITemp: Integer;
begin
  Sl := TStringList.Create;
  W := TWords.Create;
   try
     Sl.Text := http.Get('http://'+frmLogin.cbServer.Text+'/wormageddonweb/GameList.asp?Channel='+StringReplace(frmLogin.cbchan.Text,'#','',[]));
     Itemp := gmfrm.lvGames.ItemIndex;
     gmfrm.lvGames.Clear;
   //  gmfrm.lvGames.Items.BeginUpdate;
     for I := 1 to Sl.Count-2 do begin
        if Pos('<GAMELIST',Sl[I]) = 0 then
        if Sl[I] <> '' then begin
          W.Text := Sl[I];
          with gmfrm.lvGames.Items.Add do begin
           if W[6] = '1' then
            ImageIndex := 63
           else
            ImageIndex := 62;
           SubItemImages[Subitems.Add('')] := StrToInt(W[4]);
           SubItems.Add(W[1]);
           SubItems.Add(W[2]);
           SubItems.Add(W[3]);
           SubItems.Add(W[7]);
          end;
        end;
      end;
    //  gmfrm.lvGames.Items.EndUpdate;
      gmfrm.lvGames.ItemIndex := Itemp;
   except
   end;
  W.Free;
  Sl.Free;
end;

procedure TfrmMain.Copy1Click(Sender: TObject);
begin
 rechat.CopyToClipboard;
end;

procedure TfrmMain.SelectAll1Click(Sender: TObject);
begin
 rechat.SelectAll;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 Application.OnException := AppException;

 IsAway := False;

 DockHandler.ShowGrabberBars  := True;
 gmfrm                        := TfrmdkGmList.Create(self);
 nickfrm                      := TfrmdkNickList.Create(self);

 DockHandler.LoadDesktop('\Software\ProSnooperFx');

  if DockHandler.bLoadSuccess = False then begin
   gmfrm.ManualDock(DockPanel1);
   nickfrm.ManualDock(DockPanel1);
   gmfrm.Show;
   nickfrm.Show;
  end;
  
 DockHandler.Refresh;
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
 frmMain.Close;
end;

procedure TfrmMain.Settings1Click(Sender: TObject);
begin
 frmSettings.ShowModal;
end;

procedure TfrmMain.JoindirectIP1Click(Sender: TObject);
begin
 frmJoinGame.Show;
end;

function TfrmMain.FindListViewItem(lv: TListView; const S: string; column: Integer): TListItem;
var
  i: Integer;
  found: Boolean;
begin
  Assert(Assigned(lv));
  Assert((lv.viewstyle = vsReport) or (column = 0));
  Assert(S > '');
  for i := 0 to lv.Items.Count - 1 do
  begin
    Result := lv.Items[i];
    if column = 0 then
      found := AnsiCompareText(Result.Caption, S) = 0
    else if column > 0 then
      found := AnsiCompareText(Result.SubItems[column - 1], S) = 0
    else
      found := False;
    if found then
      Exit;
  end;
  // No hit if we get here
  Result := nil;
end;

procedure TfrmMain.SetFlagRank(Flag, Rank: Integer; Nickname: String);
var
I: Integer;
begin
 I  := FindListViewItem(nickfrm.lvNicks,NickName,2).Index;

 if (Rank > 74) or (Rank < 0) then Rank := 74; // can't get buddyflag or ignoreflag
 if (Flag > 61) or (Flag < 0) then Flag := 49; // can't get ranks as flags

 nickfrm.lvNicks.Items.Item[I].ImageIndex := Flag;

 if frmSettings.lbBuddies.Items.IndexOf(NickName) <> -1 then
  nickfrm.lvNicks.Items.Item[I].SubItemImages[0] := 75
 else
 if lbIgnore.Items.IndexOf(NickName) <> -1 then // if ignored
  nickfrm.lvNicks.Items.Item[I].SubItemImages[0] := 76
 else
  nickfrm.lvNicks.Items.Item[I].SubItemImages[0] := Rank;
end;

procedure TfrmMain.ircQuoteServer(Command: String);
var
 W: TWords;
begin
 W := TWords.Create;
 W.Text := Command;

 if W[1] = '311' then begin
  SetFlagRank(StrToIntDef(StringReplace(W[7], ':', '',[]),49),
              StrToIntDef(W[8],12)+62,
              W[3]);
 end;

 if W[1] = '403' then begin  // if channel doesn't exist
  frmChanList.lvChans.Clear;
  frmChanList.Show;
  irc.Quote('LIST');
  frmChanList.DoPart := False;  //some servers send a 403 if the parted channel doesnt exist
 end;

 if W[1] = '437' then begin  // if channel doesn't exist
  frmChanList.lvChans.Clear;
  frmChanList.Show;
  irc.Quote('LIST');
  frmChanList.DoPart := False;
 end;

 if (W[1] = '461') and (W[3] = 'JOIN') then begin  // if channel not specified
  frmChanList.lvChans.Clear;
  frmChanList.Show;
  irc.Quote('LIST');
  frmChanList.DoPart := False;
 end;

 if W[1] = '322' then begin  // on list event
    with frmChanList.lvChans.Items.Add do begin
     Caption := W[3];
     SubItems.Add(w[4]);
     SubItems.Add(StringReplace(W.ConcatToEnd(5),':','',[]));
    end;
 end;

 if W[1] = '432' then begin
  ShowMessage('Invalid nickname. Please choose another.');
  irc.Quit('');
  frmMain.Hide;
  frmLogin.Show;
 end;

 W.Free;
end;

procedure TfrmMain.ircNames(Commanicks, Channel: String;
  endofnames: Boolean);
var
Sl: TStringList;
I: Integer;
begin
 nickfrm.lvNicks.Clear;
 Sl := TStringList.Create;
 Sl.CommaText := irc.GetUsersFromChannel(Channel);
 nickfrm.lvNicks.Items.BeginUpdate;
   for I := 0 to Sl.Count-1 do
    with nickfrm.lvNicks.Items.Add do begin
     ImageIndex := 49;
     SubItemImages[Subitems.Add('')] := 74;
     SubItems.Add(StringReplace(Sl[I], '@','',[]));
     SubItems.Add('lol');
    end;
 nickfrm.lvNicks.Items.EndUpdate;
end;

procedure TfrmMain.ircWho(Channel, Nickname, Username, Hostname, Name,
  Servername, status, other: String; EndOfWho: Boolean);
var
 W: TWords;
begin
    if EndOfWho = False then begin
     W := TWords.Create;
     W.Text := Name;
      if Channel = frmLogin.cbchan.Text then begin
        SetFlagRank(StrToIntDef(StringReplace(W[0], ':', '',[]), 49),
                    StrToIntDef(W[1],12)+62,
                    Nickname);
      end;
     W.Free;
    end;
end;

procedure TfrmMain.ircAfterJoined(Channelname: String);
begin
   irc.Quote('WHO '+Channelname);
end;

procedure TfrmMain.HostWormnet1Click(Sender: TObject);
begin
frmHost.Show;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
 Application.OnException := nil;
end;

procedure TfrmMain.ircServerError(ErrorString: String);
begin
AddRichLine(rechat, 'IRC Error: '+ErrorString);
end;

procedure TfrmMain.Label2Click(Sender: TObject);
begin
 GoAway('');
end;

procedure TfrmMain.Channellist1Click(Sender: TObject);
begin
  frmChanList.Show;
  frmChanList.lvChans.Clear;
  irc.Quote('LIST');
  frmChanList.DoPart := True;
end;

procedure TfrmMain.Label3Click(Sender: TObject);
begin
 frmMessages.Show;
end;

procedure TfrmMain.tmrWhoCompatTimer(Sender: TObject);
begin
  // TheCyberShadow's server can't handle WHOIS, so we send out a WHO once in a while to sync the nicklist
  irc.Quote('WHO '+frmLogin.cbchan.Text);
end;

procedure TfrmMain.ircAfterUserNickChange(Oldnick, Newnick: String);
begin
 if FindListViewItem(nickfrm.lvNicks,oldnick,2) <> nil then begin
  nickfrm.lvNicks.Items.Item[FindListViewItem(nickfrm.lvNicks,oldnick,2).Index].SubItems[1] := NewNick;
  AddRichLine(rechat,MakeTimeStamp+'<b><pcol='+ColorToString(frmSettings.colJoins.Selected)+'>Nick: </b>'+OldNick+' -> '+NewNick+'.</pcol>');
 end;
end;

procedure TfrmMain.rechatURLClick(Sender: TObject; const URL: String);
begin
 Shellexecute(Handle,PChar('Open'),PChar(URL),nil,nil,SW_SHOW);
end;

procedure TfrmMain.Find1Click(Sender: TObject);
begin
  FD.Execute;
end;

function TfrmMain.FindText(const SearchStr: string; // custom find routine
               StartPos, FindLength : LongInt; Options: TSearchTypes;
               SearchDown: Boolean = TRUE): Integer;
var
  Find: TFindText;
  Flags: Word;
begin
  with Find do begin
    chrg.cpMin := StartPos;
    chrg.cpMax := StartPos + FindLength;
    lpstrText := PChar(SearchStr);
  end;
 
  Flags := 0;

  if stWholeWord in Options then
   Flags := Flags or FT_WHOLEWORD
  else
   Flags := Flags and not FT_WHOLEWORD;

  if stMatchCase in Options then
   Flags := Flags or FT_MATCHCASE
  else
   Flags := Flags and not FT_MATCHCASE;

  if SearchDown then
   Flags := Flags OR $01
  else
   Flags := Flags OR $01;

  Result := -1;
 
  if SearchDown then
   Result := SendMessage(rechat.Handle, EM_FINDTEXT, Flags, LongInt(@Find))
  else // Search up doesn't work at all, so we loop through the text backwards
   while (StartPos > -1) and (result = -1) do begin
    //result := RichEdit1.Perform(EM_FindText, Flags, LongInt(@Find));
    Result := SendMessage(rechat.Handle, EM_FINDTEXT, Flags, LongInt(@Find));
    Dec(StartPos);
    Find.chrg.cpMin := StartPos;
   end;
end;

procedure TfrmMain.FDFind(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, FindLength: LongInt;
  TheFindOptions: TFindOptions;
  TheSearchTypes: TSearchTypes;
begin
  TheFindOptions := [];
  TheSearchTypes := [];

  if frDown in FD.Options then begin
    StartPos := rechat.SelStart + rechat.SelLength;
    FindLength := Length(rechat.Text) - StartPos;
  end else begin
    StartPos := rechat.SelStart;
    FindLength := 0;
  end;
 
  with Sender as TFindDialog do begin
   if frMatchCase in Options then
    TheSearchTypes := TheSearchTypes + [stMatchCase];
   if frWholeWord in Options then
    TheSearchTypes := TheSearchTypes + [stWholeWord];
  end;

  FoundAt := FindText(FD.FindText, StartPos, FindLength, TheSearchTypes,  (frDown in FD.Options) );

  if FoundAt <> -1 then begin
      rechat.SetFocus;
      rechat.SelStart := FoundAt;
      rechat.SelLength := Length(FD.FindText);
      rechat.Perform(EM_SCROLLCARET, 0, 0); //scroll to found line
  end else
      MessageDlg('"' + FD.FindText + '" could not be found.', mtInformation, [mbOk], 0);
end;

procedure TfrmMain.Clear1Click(Sender: TObject);
begin
 rechat.Clear;
end;

procedure TfrmMain.ircNoSuchNickChannel(Value: String);
begin
 AddRichLine(rechat, MakeTimeStamp+'No such nick/channel.');
end;

procedure TfrmMain.ircAfterInvited(NickName, Channel: String);
begin
 AddRichLine(rechat, MakeTimeStamp+Nickname+' invites you to join '+Channel);
end;

procedure TfrmMain.ircMode(Nickname, Destination, Mode: String);
begin
AddRichLine(rechat, MakeTimeStamp+Nickname+' sets mode: ['+Destination+'] '+Mode);
end;

procedure TfrmMain.ircAfterTopic(ChannelName, Nickname, Topic: String);
begin
if NIckname = '' then
 AddRichLine(rechat, MakeTimeStamp+'Topic is: ['+ChannelName+'] '+Topic)
else
 AddRichLine(rechat, MakeTimeStamp+Nickname+' changes topic: ['+ChannelName+'] '+Topic);
end;

end.