unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.RichEdit, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.ToolWin, Vcl.ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, AES256, MessageConfig, VCL.Themes, VCL.Styles, System.ImageList,
  Vcl.ImgList, Unit2, VFrames, VSample, dmCD_u, EASendMailObjLib_TLB;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    GridPanel1: TGridPanel;
    GridPanel3: TGridPanel;
    Send: TButton;
    MyWebcam: TPageControl;
    TabSheet7: TTabSheet;
    GridPanel2: TGridPanel;
    PaintBox1: TPaintBox;
    Communication: TPageControl;
    TabSheet1: TTabSheet;
    ChatBoundaries: TMemo;
    RichEdit1: TRichEdit;
    TabSheet2: TTabSheet;
    PageControl1: TPageControl;
    TabSheet4: TTabSheet;
    p: TTabSheet;
    TabSheet6: TTabSheet;
    ToolBar6: TToolBar;
    Button15: TButton;
    ToolBar7: TToolBar;
    Button16: TButton;
    ToolBar8: TToolBar;
    Button17: TButton;
    ToolBar5: TToolBar;
    Button14: TButton;
    ToolBar11: TToolBar;
    Button21: TButton;
    ToolBar1: TToolBar;
    Button20: TButton;
    ToolBar12: TToolBar;
    Button19: TButton;
    GridPanel5: TGridPanel;
    ToolBar9: TToolBar;
    Button2: TButton;
    ToolBar14: TToolBar;
    Button3: TButton;
    ToolBar19: TToolBar;
    Button7: TButton;
    ToolBar22: TToolBar;
    EmojiSelect: TButton;
    ToolBar23: TToolBar;
    Button10: TButton;
    ToolBar13: TToolBar;
    Label1: TLabel;
    ToolBar21: TToolBar;
    CheckBox1: TCheckBox;
    ToolBar25: TToolBar;
    EnableCamera: TCheckBox;
    Button22: TButton;
    UserInterface: TPageControl;
    TabSheet9: TTabSheet;
    TabSheet11: TTabSheet;
    Panel3: TPanel;
    TabSheet12: TTabSheet;
    TabSheet13: TTabSheet;
    ToolBar10: TToolBar;
    Button18: TButton;
    RoomList: TPageControl;
    Label2: TLabel;
    Controller: TPanel;
    InputEdit: TEdit;
    MainMenu1: TMainMenu;
    Menu: TMenuItem;
    N1: TMenuItem;
    Disconnect1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    VisiImages: TImageList;
    FontColorSelect: TComboBox;
    FontSizeSelect: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    SelectThemeChange: TComboBox;
    FontStyleSelect: TComboBox;
    PrimaryTabs: TImageList;
    ProfileTabs: TImageList;
    GridPanel4: TGridPanel;
    GridPanel7: TGridPanel;
    Label7: TLabel;
    Label8: TLabel;
    InputUsername: TEdit;
    InputPassword: TEdit;
    Remember: TCheckBox;
    RegisterBtn: TButton;
    LoginBtn: TButton;
    PasswordReset: TButton;
    Label9: TLabel;
    GridPanel8: TGridPanel;
    GridPanel9: TGridPanel;
    Label11: TLabel;
    Cancel: TButton;
    Label10: TLabel;
    Label33: TLabel;
    EmailInput: TEdit;
    ComfirmPassInput: TEdit;
    Label13: TLabel;
    PasswordInput: TEdit;
    UsernameInput: TEdit;
    Label14: TLabel;
    RegisterAct: TButton;
    RecoveryEdit: TEdit;
    RecoverySend: TButton;
    Label12: TLabel;
    VerifyInput: TEdit;
    VerifyBtn: TButton;
    VerifyLabel: TLabel;
    destructor FormDestroy(Sender : TObject);
    procedure FormCreate(Sender : TObject);
    procedure Exit1Click(Sender: TObject);
    procedure DeliverMessage;
    procedure InputEditOnEnter(Sender: TObject; var Key: Char);
    procedure SendClick(Sender: TObject);
    procedure InputEditOnChangeScroll(Sender : TObject);
    procedure SelectThemeChangeClick(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure EmojiSelectClick(Sender: TObject);
    procedure FontSizeSelectOnChange(Sender : TObject);
    procedure FontColorSelectOnChange(Sender : TObject);
    procedure FontStyleSelectOnChange(Sender : TObject);
    procedure EnableCameraOnChange(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure RegisterActClick(Sender: TObject);
    procedure RegisterBtnClick(Sender: TObject);
    procedure LoginBtnClick(Sender: TObject);
    procedure PasswordResetClick(Sender: TObject);
    procedure RecoverySendClick(Sender: TObject);
    procedure VerifyBtnClick(Sender: TObject);
    procedure Button18Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TRichEditStyleHookFix = class(TScrollingStyleHook)
  strict private
    procedure EMSetBkgndColor(var Message: TMessage); message EM_SETBKGNDCOLOR;
  end;

var
  Form1: TForm1;
  I : Integer;
  MessageStr : String;
  TSocketThread : Cardinal;
  FontSize : Integer;
  FontStyle : TFontStyles;
  FontColor : TColor;
  SmileyForm : TForm;

  Cam:TVideoImage;
  CamList:TStringList;
  reslist:TStringList;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender : TObject);
begin
  {Set Style Hook}
  TStyleManager.Engine.RegisterStyleHook(TRichEdit, TRichEditStyleHookFix);
  {Set Defaults}
  FontSize := 8;
  FontStyle := [];
  FontColor := clLime;
end;

{ Connection }
Procedure SocketThread;
begin
  Form1.IdTcpClient1.Host := ServerIP;
  Form1.IdTcpClient1.Port := ServerPort;
  try
  Form1.IDTcpClient1.Connect;

  if Form1.IdTCPClient1.connected then
  begin
    Form1.RichEdit1.Lines.Add('Connected To Server.');
    Form1.GridPanel4.Enabled := False;
    Form1.GridPanel4.Visible := False;
    Form1.GridPanel1.Enabled := True;
    Form1.GridPanel1.Visible := True;
    Form1.Disconnect1.Enabled := True;
  end;
  while Form1.IdTcpClient1.Connected do
    begin
      MessageStr := Form1.IdtcpClient1.Socket.ReadLn();
      //Insert Smileys.
      if MessageStr <> '' then Form1.RichEdit1.Lines.Add(DecryptAES_256(ChatPassword,MessageStr));
      MessageStr := '';
      Sleep(1);
    end;
  Except
    ShowMessage('Invalid username/password provided.');
  end;
end;

procedure TForm1.FontSizeSelectOnChange(Sender: TObject);
begin
  FontSize := StrToInt(FontSizeSelect.Items[FontSizeSelect.ItemIndex]);
end;
procedure TForm1.FontColorSelectOnChange(Sender: TObject);
begin
  FontColor := StringToColor('cl' + FontColorSelect.Items[FontColorSelect.ItemIndex])
end;
procedure TForm1.FontStyleSelectOnChange(Sender : TObject);
begin
  case Form1.FontStyleSelect.ItemIndex of
    0 : FontStyle := [];
    1 : FontStyle := [fsItalic];
    2 : FontStyle := [fsBold];
    3 : FontStyle := [fsUnderline]
  end
end;

{Open Emoji Selection}
procedure TForm1.EmojiSelectClick(Sender: TObject);
begin
  if Unit2.Form2.Visible = False then begin {EmojiForm Position needs adjusting, tweek later}
    if Unit2.Form2.Left <> GridPanel5.Left + Unit2.Form2.Width then
      Unit2.Form2.Left := GridPanel5.Left + Unit2.Form2.Width;

    if Unit2.Form2.Top <> Communication.Height - (Unit2.Form2.Height div 2) then
      Unit2.Form2.Top := Communication.Height - (Unit2.Form2.Height div 2);

    Unit2.Form2.Visible := True
  end else
    Unit2.Form2.Visible := False;
end;

procedure TForm1.RecoverySendClick(Sender: TObject);
begin
  RecoveryEdit.Visible := False;
  RecoverySend.Visible := False;
  RecoveryEdit.Enabled := False;
  RecoverySend.Enabled := False;
  ShowMessage('An email has been delivered to reset your password.');
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
    IDTcpClient1.Disconnect;
    GridPanel1.Enabled := False;
    GridPanel1.Visible := False;
    GridPanel4.Enabled := True;
    GridPanel4.Visible := True;
    Disconnect1.Enabled := False;
end;

procedure TForm1.CancelClick(Sender: TObject);
begin
  GridPanel8.Visible := False;
  GridPanel8.Enabled := False;
  GridPanel4.Enabled := True;
  GridPanel4.Visible := True;
end;

procedure RegisterActClick(Sender: TObject);
begin
  ShowMessage('Verifying Information');
  {Data Module Input}
end;

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
  if Form1.IdTcpClient1.Connected then IDTcpClient1.Disconnect;
  GridPanel1.Enabled := False;
  GridPanel1.Visible := False;
  GridPanel4.Enabled := True;
  GridPanel4.Visible := True;
  Disconnect1.Enabled := False;
end;

{On application close, disconnect user from the chat.}
procedure TForm1.Exit1Click(Sender: TObject);
begin
  if Form1.IdTcpClient1.Connected then IDTcpClient1.Disconnect;
  Exit;
end;
destructor TForm1.FormDestroy(Sender : TObject);
begin
  if Form1.IdTcpClient1.Connected then IDTcpClient1.Disconnect;
  Cam.Free;
  CamList.Free;
  reslist.Free;
end;

procedure TForm1.DeliverMessage;
begin
  if Form1.IdTcpClient1.Connected then begin
    Form1.RichEdit1.SelAttributes.Size := FontSize;
    Form1.RichEdit1.SelAttributes.Style := FontStyle;
    Form1.RichEdit1.SelAttributes.Color := FontColor;
    if InputEdit.Text <> '' then begin {No sending blank messages.}
      IdTcpClient1.Socket.WriteLn(EncryptAES_256(ChatPassword,General_Message_All + Delim + InputEdit.Text));
      InputEdit.Text := '';
    end;
  end;
end;

{Enter Message}
procedure TForm1.InputEditOnEnter(Sender: TObject; var Key: Char);
begin
  if ord(Key) = VK_RETURN then
  begin
    Key := #0; // prevent beeping
      Form1.DeliverMessage;
  end;
end;

procedure TForm1.LoginBtnClick(Sender: TObject);
begin
  CreateThread(nil, 0, @SocketThread, nil, 0, TSocketThread);
end;

procedure TForm1.PasswordResetClick(Sender: TObject);
begin
  if RecoveryEdit.Enabled = False then begin
    RecoveryEdit.Enabled := True;
    RecoverySend.Enabled := True;
    RecoveryEdit.Visible := True;
    RecoverySend.Visible := True;
    ShowMessage('Enter your registered email address to receive a recovery password.');
  end;
end;

{On Activation, send email to user with random verification key to input and activate account.}
procedure TForm1.RegisterActClick(Sender: TObject);
var
  CharList : Array of Char;
  RandomLength, Index, RandomIndex : Integer;
  KeyGenerated : String;
  oSmtp : TMail;
begin
  CharList :=
  [
      '0', '1', '2', '3', '4', '5',
      '6', '7', '8', '9', 'A', 'B',
      'C', 'D', 'E', 'F', 'G', 'H',
      'I', 'J', 'K', 'L', 'M', 'N',
      'O', 'P', 'Q', 'R', 'S', 'T',
      'U', 'V', 'W', 'X', 'Y', 'Z'
  ];
    with dmCD do begin
        if UserDataTable.Active = False then begin
            UserDataTable.Active := True;
      if UserDataTable.Locate('Username', UsernameInput.Text, []) = False then
        if UserDataTable.Locate('UserEmail', EmailInput.Text, []) = False then begin
          {Generate unique key}
          RandomLength := 8 + Random(7);
          for Index := 1 to RandomLength do
          begin
            RandomIndex := 0 + Random(35);
            KeyGenerated := KeyGenerated + CharList[RandomIndex];
          end;
          //
          UserDataTable.Append;
          UserDataTable['UserIP'] := KeyGenerated;
          UserDataTable['Username'] := UsernameInput.Text;
          UserDataTable['UserEmail'] := EmailInput.Text;
          UserDataTable['Verified'] := False;         //Comparison: on ActivateBtnClick, Locate IP(Key).
          UserDataTable.Post;                         //If ActivateInput.Text = IP(Key) found,
          UserDataTable.Active := False;              //Verified := True.
                                                      //Login : If Verified := True, connect.
                                                      //On Connect : if IP <> Context(ClientIP) then IP := Context;
                                                      //Auto updates the IP for each login, and kills 2 birds with 1 stone.
          //On ActivateInput.Enabled, Fire the email event from the server.
          if VerifyInput.Enabled = False then
            VerifyLabel.Enabled := True;
          VerifyInput.Enabled := True;
          VerifyBtn.Enabled := True;

          oSmtp := TMail.Create(Application);
          oSmtp.LicenseCode := 'TryIt';
          oSmtp.FromAddr := 'GlobalChattertainment@gmail.com';
          oSmtp.AddRecipientEx(EmailInput.Text, 0);
          oSmtp.Subject := 'simple email from Delphi project';
          oSmtp.BodyText := 'Activation Key : ' + KeyGenerated + '. Do not reply.';
          oSmtp.ServerAddr := 'smtp.gmail.com';
          oSmtp.UserName := 'GlobalChattertainment@gmail.com';
          oSmtp.Password := 'TempPw!';
          oSmtp.SSL_init();
          if oSmtp.SendMail() = 0 Then
            ShowMessage('An email with your activation key has been sent. Your account will become active after verification.')
          else
            ShowMessage( 'failed to send email with the following error: ' + oSmtp.GetLastErrDescription());
              end else
                    ShowMessage('That email is already in use. Try another one.')
          else
              ShowMessage('That username is already taken. Please choose another.');
    end;
    end;
end;

procedure TForm1.RegisterBtnClick(Sender: TObject);
begin
  GridPanel4.Visible := False;
  GridPanel4.Enabled := False;
  GridPanel8.Enabled := True;
  GridPanel8.Visible := True;
end;

procedure TForm1.SendClick(Sender: TObject); begin
  Form1.DeliverMessage;
end;

procedure TForm1.VerifyBtnClick(Sender: TObject);
begin
  if dmCD.UserDataTable.Active = False then
    dmCD.UserDataTable.Active := True;

  if dmCD.UserDataTable.Locate('UserIP', VerifyInput.Text, []) then
    dmCD.UserDataTable[dmCD.UserDataTable['UserIP']].Verified := True;
end;

{Auto Scroll to last entry of chat}
procedure TForm1.InputEditOnChangeScroll(Sender : TObject);
begin
  SendMessage(RichEdit1.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;

{Change Theme}
procedure TForm1.SelectThemeChangeClick(Sender: TObject);
begin
   TStyleManager.TrySetStyle(SelectThemeChange.Items[SelectThemeChange.ItemIndex]);
end;

{Enable font color change with Themes enabled}
procedure TRichEditStyleHookFix.EMSetBkgndColor(var Message: TMessage);
begin
  Message.LParam := ColorToRGB(StyleServices.GetStyleColor(scEdit));
  Handled := False;
end;

procedure TForm1.EnableCameraOnChange(Sender: TObject);
begin

   Camlist := TStringList.Create ;
   ResList :=TStringList.Create;

   Cam := TVideoImage.Create;
   Cam.GetListOfDevices(camlist);

   Cam.SetDisplayCanvas(PaintBox1.Canvas);

   Cam.VideoStart(camlist.Strings[0]);
   // important

   Cam.GetListOfSupportedVideoSizes(ResList);
   Form1.RichEdit1.Lines.Add(ResList.Strings[0]);
   Cam.SetResolutionByIndex(0);

   //specify your resolution by index using listbox index
   //this will not only lists resolutions but also other features available , so be careful when selecting the index
end;

end.