lazarus/components/chatcontrol/demo/frmmain.pas

unit frmmain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, IniPropStorage, Menus, chatcontrol, typingindicator;

type
  { TMainChatForm }

  TMainChatForm = class(TForm)
    Button1: TButton;
    btnAdd: TButton;
    Button2: TButton;
    cbLeft: TCheckBox;
    cbCtrlSelects: TCheckBox;
    ccMain: TChatControl;
    GBChat: TGroupBox;
    MIDelete: TMenuItem;
    MICopy: TMenuItem;
    pmChat: TPopupMenu;
    psChat: TIniPropStorage;
    lblText: TLabel;
    mPrompt: TMemo;
    pnlPrompt: TPanel;
    Splitter1: TSplitter;
    tmrTyping: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure cbCtrlSelectsChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure handlePrompt(Sender: TObject);
    procedure MICopyClick(Sender: TObject);
    procedure MIDeleteClick(Sender: TObject);
    procedure mPromptChange(Sender: TObject);
    procedure pmChatPopup(Sender: TObject);
    procedure psChatRestoreProperties(Sender: TObject);
    procedure psChatSaveProperties(Sender: TObject);
    procedure tmrTypingTimer(Sender: TObject);
    procedure ChatMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure DoOnItemClick(Sender: TObject; aItem: TChatItem);
  private

  end;

var
  MainChatForm: TMainChatForm;

implementation

uses clipbrd;

{$R *.lfm}

{ TMainChatForm }

procedure TMainChatForm.FormCreate(Sender: TObject);
begin
  ccMain.Width:=ClientWidth div 2;
  ccMain.PopupMenu:=pmChat;
  ccMain.LeftTypingIndicator.DotRadius:=4;
  ccMain.RightTypingIndicator.DotRadius:=4;
  psChat.IniFileName:=GetAppConfigFile(False);
  psChat.Active:=True;
end;

procedure TMainChatForm.ChatMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//  mPrompt.Text:=Format('Click at (%d,%d)',[X,Y]);
end;

procedure TMainChatForm.DoOnItemClick(Sender: TObject; aItem: TChatItem);
begin
  ShowMessage('You clicked on text:'+sLineBreak+aItem.Text);
end;

procedure TMainChatForm.Button2Click(Sender: TObject);
begin
  With ccMain do
    begin
    AddText('Hello, how are you?',tsRight);
    AddText('Fine, thanks for asking. How are you?',tsLeft);
    AddText('Also fine. Can I ask you a question?',tsRight);
    AddText('Sure, go right ahead...',tsLeft);
    AddText('How does this program actually work?',tsRight);
    AddText('Or is that too difficult to explain?',tsRight);
    AddText('No, it is actually quite easy to make using lazarus:',tsLeft);
    AddText('There is a control that makes this a breeze...',tsLeft);
    end;
end;

procedure TMainChatForm.cbCtrlSelectsChange(Sender: TObject);
begin
  ccMain.CtrlSelects:=cbCtrlSelects.Checked;
end;

procedure TMainChatForm.handlePrompt(Sender: TObject);

var
  S : String;

begin
  S:=mPrompt.Text;
  if CBLeft.Checked then
    begin
    ccMain.AddText(S,tsLeft);
    ccMain.LeftTyping:=False;
    end
  else
    begin
    ccMain.AddText(S,tsRight);
    ccMain.RightTyping:=False;
    end;
end;

procedure TMainChatForm.MICopyClick(Sender: TObject);
var
  lPt : TPoint;
  Item : TChatItem;
  HaveItem : Boolean;

begin
  lPt:=pmChat.PopupPoint;
  lpt:=ccMain.ScreenToClient(lpt);
  Item:=ccMain.GetItemAt(lPt.X,lPt.Y);
  HaveItem:=Item<>Nil;
  if HaveItem then
    Clipboard.AsText:=Item.Text;
end;

procedure TMainChatForm.MIDeleteClick(Sender: TObject);
var
  lPt : TPoint;
  Item : TChatItem;
begin
  lPt:=pmChat.PopupPoint;
  lpt:=ccMain.ScreenToClient(lpt);
  Item:=ccMain.GetItemAt(lPt.X,lPt.Y);
  if Item<>Nil then
    ccMain.DeleteItem(Item);
end;

procedure TMainChatForm.mPromptChange(Sender: TObject);
begin
  if cbLeft.Checked then
    ccMain.LeftTyping:=True
  else
    ccMain.RightTyping:=True;
  tmrTyping.Enabled:=False;
  tmrTyping.Enabled:=True;
end;

procedure TMainChatForm.pmChatPopup(Sender: TObject);

var
  lPt : TPoint;
  Item : TChatItem;
  HaveItem : Boolean;

begin
  lPt:=pmChat.PopupPoint;
  lpt:=ccMain.ScreenToClient(lpt);
  Item:=ccMain.GetItemAt(lPt.X,lPt.Y);
  HaveItem:=Item<>Nil;
  MICopy.Enabled:=HaveItem;
  MIDelete.Enabled:=HaveItem;
end;

procedure TMainChatForm.psChatRestoreProperties(Sender: TObject);
begin
end;

procedure TMainChatForm.psChatSaveProperties(Sender: TObject);
begin
end;

procedure TMainChatForm.tmrTypingTimer(Sender: TObject);
begin
  ccMain.IsTyping[tsLeft]:=False;
  ccMain.IsTyping[tsRight]:=False;
end;



end.