messengermainformu.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}
{$I jvcl.inc}
unit MessengerMainFormU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, ComCtrls, ToolWin, StdCtrls, JvRichEdit,
  ExtCtrls, JvExStdCtrls;

{ Emoticons are copyright Mozilla (www.mozilla.org) }

type
  TMessengerMainForm = class(TForm)
    Panel1: TPanel;
    JvRichEdit1: TJvRichEdit;
    Panel2: TPanel;
    edtNewText: TEdit;
    Button1: TButton;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ImageList1: TImageList;
    ActionList1: TActionList;
    actCool: TAction;
    actCry: TAction;
    actEmbarressed: TAction;
    actFoot: TAction;
    actFrown: TAction;
    actInnocent: TAction;
    actKiss: TAction;
    actLaughing: TAction;
    actMoney: TAction;
    actSealed: TAction;
    actSurprised: TAction;
    actTongue: TAction;
    actUndecided: TAction;
    actWink: TAction;
    actYell: TAction;
    actSmile: TAction;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    actBold: TAction;
    actItalic: TAction;
    actUnderline: TAction;
    actSend: TAction;
    Timer1: TTimer;
    procedure actBoldExecute(Sender: TObject);
    procedure actItalicExecute(Sender: TObject);
    procedure actUnderlineExecute(Sender: TObject);
    procedure OnEmoticonClick(Sender: TObject);
    procedure actSendExecute(Sender: TObject);
    procedure actBoldUpdate(Sender: TObject);
    procedure actItalicUpdate(Sender: TObject);
    procedure actUnderlineUpdate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FCurrentFont: TFont;
    FHeaderFont: TFont;
    FYourLines: Integer;
    FReadOnlySend: Boolean;
    FReadOnlyHandled: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure HandleReadOnly;
    procedure HandleReadOnlyOff;
    procedure HandleReadOnlyOn;

    procedure AddImageToEdit(const AImageIndex: Integer);
    procedure AddImageToRichEdit(const AImageIndex: Integer);
    procedure AddTextToRichEdit(P: PChar; const ALength: Integer; AFont: TFont);
    procedure ParseString(const S: string);
    procedure SendString(const S: string; const You: Boolean);
  end;

var
  MessengerMainForm: TMessengerMainForm;

implementation

uses
  RichEdit
  {$IFDEF COMPILER6_UP}
  , DateUtils
  {$ENDIF};

{$R *.dfm}

const
  CImageToString: array[0..15] of string = (
 {0}':-@', { Yell }
    '8-)', { Cool }
    ':,(', { Cry }
    '(blush)', { Embarressed }
    ':-&', { Foot }
 {5}':-(', { Frown }
    'O :-)', { Innocent }
    ':*', { Kiss }
    'LOL', { Laughing }
    ':-$', { Money }
{10}':-x', { Sealed }
    ':-)', { Smile }
    ':-o', { Surprised }
    ':-p', { Tongue }
    ':-\', { Undecided }
    ';-)' { Wink }
    );

var
  ReadOnlyMessages: array[0..2] of string = (
    'You can''t resize and/or drag-drop the images because the rich ' +
    'edit control is read-only 8-) Type "readonly" to set the ReadOnly property ' +
    'of the rich edit to false',
    'Try to drag-drop the images, and then to resize the images',
    '(blush) I meant "read-only on" or "read-only off"'
    );

procedure TMessengerMainForm.actBoldExecute(Sender: TObject);
begin
  if fsBold in FCurrentFont.Style then
    FCurrentFont.Style := FCurrentFont.Style - [fsBold]
  else
    FCurrentFont.Style := FCurrentFont.Style + [fsBold];
end;

procedure TMessengerMainForm.actBoldUpdate(Sender: TObject);
begin
  if Sender is TAction then
    TAction(Sender).Checked := fsBold in FCurrentFont.Style;
end;

procedure TMessengerMainForm.actItalicExecute(Sender: TObject);
begin
  if fsItalic in FCurrentFont.Style then
    FCurrentFont.Style := FCurrentFont.Style - [fsItalic]
  else
    FCurrentFont.Style := FCurrentFont.Style + [fsItalic];
end;

procedure TMessengerMainForm.actItalicUpdate(Sender: TObject);
begin
  if Sender is TAction then
    TAction(Sender).Checked := fsItalic in FCurrentFont.Style;
end;

procedure TMessengerMainForm.actSendExecute(Sender: TObject);
begin
  SendString(edtNewText.Text, True);
end;

procedure TMessengerMainForm.actUnderlineExecute(Sender: TObject);
begin
  if fsUnderline in FCurrentFont.Style then
    FCurrentFont.Style := FCurrentFont.Style - [fsUnderline]
  else
    FCurrentFont.Style := FCurrentFont.Style + [fsUnderline];
end;

procedure TMessengerMainForm.actUnderlineUpdate(Sender: TObject);
begin
  if Sender is TAction then
    TAction(Sender).Checked := fsUnderline in FCurrentFont.Style;
end;

procedure TMessengerMainForm.AddImageToEdit(const AImageIndex: Integer);
var
  S: string;
  LSelLength, LSelStart: Integer;
begin
  if (AImageIndex < 0) and (AImageIndex >= 16) then
    Exit;

  S := edtNewText.Text;
  LSelLength := edtNewText.SelLength;
  LSelStart := edtNewText.SelStart;

  if LSelLength > 0 then
  begin
    Delete(S, LSelStart + 1, LSelLength);
    Insert(CImageToString[AImageIndex], S, LSelStart + 1);
    edtNewText.Text := S;
    edtNewText.SelStart := LSelStart;
    edtNewText.SelLength := Length(CImageToString[AImageIndex]);
  end
  else
  begin
    Insert(CImageToString[AImageIndex], S, LSelStart + 1);
    edtNewText.Text := S;
    edtNewText.SelStart := LSelStart + Length(CImageToString[AImageIndex]);
    edtNewText.SelLength := 0;
  end;
end;

procedure TMessengerMainForm.AddImageToRichEdit(const AImageIndex: Integer);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    ImageList1.GetBitmap(AImageIndex, Bitmap);
    JvRichEdit1.InsertGraphic(Bitmap, False);

    { Move cursor }
    with JvRichEdit1.GetSelection do
      JvRichEdit1.SetSelection(cpMin + 1, cpMin + 1, False);
  finally
    Bitmap.Free;
  end;
end;

procedure TMessengerMainForm.AddTextToRichEdit(P: PChar; const ALength: Integer; AFont: TFont);
var
  S: string;
begin
  if ALength < 0 then
    Exit;
  SetString(S, P, ALength);
  JvRichEdit1.InsertFormatText(-1, S, AFont);
  { Move cursor }
  with JvRichEdit1.GetSelection do
    JvRichEdit1.SetSelection(cpMin + ALength, cpMin + ALength, False);
end;

constructor TMessengerMainForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCurrentFont := TFont.Create;
  FHeaderFont := TFont.Create;
  FHeaderFont.Color := clRed;
  FHeaderFont.Style := [fsBold];
  FHeaderFont.Name := 'Verdana';
end;

destructor TMessengerMainForm.Destroy;
begin
  FCurrentFont.Free;
  FHeaderFont.Free;
  inherited Destroy;
end;

procedure TMessengerMainForm.FormShow(Sender: TObject);
begin
  SendString('Hello, how are you doing :)', False);
  FocusControl(edtNewText);
  Randomize;
end;

procedure TMessengerMainForm.HandleReadOnly;
begin
  FReadOnlySend := True;
  ReadOnlyMessages[0] := 'read-only off :-p';
end;

procedure TMessengerMainForm.HandleReadOnlyOff;
begin
  FReadOnlyHandled := True;
  ReadOnlyMessages[0] := 'read-only off :-p';
  if JvRichEdit1.ReadOnly then
  begin
    { cheap effect :-p }
    JvRichEdit1.Color := clYellow;
    Application.ProcessMessages;
    Sleep(50);
    JvRichEdit1.ReadOnly := False;
    JvRichEdit1.Color := clWindow;
  end;
end;