.....

procedure register;

 

impenmetation

 

procedure Register;

.......

 

.....

procedure Register;

 

impenmetation

 

procedure Register;

.......

 

unit ChatEdit;

 

interface

 

uses Controls, Types, SysUtils, Graphics, Classes, Forms, StdCtrls, ExtCtrls;

 

const

  NRSMILIES = 35;

  SMILESIZE = 20;

  SmileCodes:array[0..NRSMILIES-1]of string[4]=

  ('8-|', ':-/', ':O', '>:)', '0:)', ':-&', '(:|', '8-}',

  ':x', 'X-(', ':((', ':-B', ':-$', '=P~', '=D>', ':\">', ':>', ':))',

  '=;', '[-(', ':-?', ':D', ':p', 'B-)', ':|', 'I-)', ':o)', '#-o', ';)o', ':-*', ':-S', '/:)', ':)', ':(', ';)');

 

type

TChatEdit = class(TPaintBox)

protected

  FLines : TStringList;

  DisplayLines : TStringList;

  FFont : TFont;

  FScrollBar : TScrollBar;

  FBkColor,FTextColor1,FTextColor2,FTextColor3,FTextColor4,FTextColor5: TColor;

  FPosition : word;

  FNrLines : integer;

  Smilies : TBitmap;

  FSmiliesFile: string;

  procedure Paint; override;

  procedure SetBkColor(nc:TColor);

  procedure SetTextColor1(nc:TColor);

  procedure SetTextColor2(nc:TColor);

  procedure SetTextColor3(nc:TColor);

  procedure SetTextColor4(nc:TColor);

  procedure SetTextColor5(nc:TColor);

  procedure SetFont(nf : TFont);

  procedure SetPosition(np : Word);

  function GetNrLines : integer;

  procedure ResetCanvas;

  procedure SetScrollBar(ns : TScrollBar);

  procedure Loaded; override;

  procedure ProcessDisplay;

public

    constructor Create(AOwner : TComponent); override;

    destructor destroy; override;

    procedure AddLines(value : TStringList);

    procedure AddLine(ns: String);

    procedure Clear;

    procedure LoadSmilies;

    function TextWidth(s : string):integer;

 published

    property ScrollBar : TScrollBar read FScrollBar write SetScrollBar default nil;

    property NrLines : integer read GetNrLines;

    property Font: TFont read FFont write SetFont;

    property Position : Word read FPosition write SetPosition;

    property BkColor:TColor read FBkColor write SetBkColor;

    property TextColor1:TColor read FTextColor1 write SetTextColor1;

    property TextColor2:TColor read FTextColor2 write SetTextColor2;

    property TextColor3:TColor read FTextColor3 write SetTextColor3;

    property TextColor4:TColor read FTextColor4 write SetTextColor4;

    property TextColor5:TColor read FTextColor5 write SetTextColor5;

    property SmiliesFile : string read FSmiliesFile write FSmiliesFile;

end;

 

procedure register;

 

 

implementation

 

{$R *.res}

 

procedure Register;

begin

  RegisterComponents('Chat', [TChatEdit]);

end;

 

 

//.............Constructor..........................

Constructor TChatEdit.Create(AOwner : TComponent);

begin

inherited Create(aOwner);

FLines := TStringList.Create;

DisplayLines:=TStringList.Create;

FFont:=TFont.Create;

Canvas.Font:=FFont;

Smilies:=TBitmap.Create;

FPosition:=0;

FScrollBar:=nil;

FBkColor:=clWhite;

FTextColor1:=clBlack;

FTextColor2:=clBlack;

FTextColor3:=clBlack;

FTextColor4:=clBlack;

FTextColor5:=clBlack;

end;

 

// ---------------  destructor ---------

destructor TChatEdit.destroy;

begin

 FLines.free;

 DisplayLines.free;

 FFont.Free;

 Smilies.free;

 inherited;

end;

 

//..............Loads the smilies from a bitmap ....

procedure TChatEdit.LoadSmilies;

begin

if FileExists(FSmiliesFile) then Smilies.LoadFromFile(FSmiliesFile);

Smilies.TransparentMode:=tmAuto;

Smilies.Transparent:=true;

end;

 

//..............Calculates the text width considering smiles...

function TChatEdit.TextWidth(s : string):integer;

var

 t,temp : string;

 nrsml, sml : integer;

 j : integer;

begin

t:=s;

nrsml:=0;

  for  j:=0 to NRSMILIES-1 do//finds first smile pos

  begin

  temp:=SmileCodes[j];

  sml:=Pos(temp,t);

  while sml<>0 do

    begin

     inc(nrsml);

     Delete(t,sml,length(temp));

     sml:=Pos(temp,t)

    end;

  end;

result:=Canvas.TextWidth(t)+SMILESIZE*nrsml;

end;

 

//..............Processes the lines to display ....

procedure TChatEdit.ProcessDisplay;

var

  y, i, nl, p, q : integer;

  Line,DLine,t : string;

  revers : TStringList;

begin

  i:=position-1;

  nl:=0;

  revers := TStringList.Create;

  revers.Clear;

  DisplayLines.Clear;

 

while (nl<NrLines)and(i>=0) do

 begin

  Line:=FLines.Strings[i];

 

   if TextWidth(Line)>Width then

    begin

      Delete(Line,1,1);

      revers.Clear;

      while Length(Line)>0 do

       begin

              p:=1;

              while (TextWidth(copy(Line,1,p))<Width-3)and(p<Length(Line)) do inc(p);

              if p>=Length(Line)  then DLine:=copy(Line,1,p)

           else

              begin

               DLine:=copy(Line,1,p-1);

                q:=0;

                q:=LastDelimiter(' ',DLine);

                if q>0 then Delete(DLine,q+1,Length(DLine)-q);

              end;

       Delete(Line, 1,Length(DLine));

       t:=FLines.Strings[i][1];

       DLine:=t+DLine;

       inc(nl);

       revers.Add(DLine);

       end;

      for y:=revers.Count-1 downto 0 do DisplayLines.Add(revers.Strings[y]);

    end

   else

    begin

    DisplayLines.Add(Line);

    inc(nl);

    end;

 dec(i);

 end;

revers.free;

end;

 

//...............Loaded..............

procedure TChatEdit.Loaded;

begin

ResetCanvas;

Canvas.Font.Assign(FFont);

if FileExists(FSmiliesFile) then Smilies.LoadFromFile(FSmiliesFile)

       else Application.MessageBox('Smilies file not found','Error',0);

 

Smilies.TransparentMode:=tmAuto;

Smilies.Transparent:=true;

Position:=1;

inherited Loaded;

end;

 

//.................ResetCanvas........................

procedure TChatEdit.ResetCanvas;

begin

Canvas.Brush.Style:=bsSolid;

Canvas.Brush.Color:=clWindow;

Canvas.Pen.Color:=clBlack;

Canvas.Pen.Mode:=pmCopy;

Canvas.Pen.Style:=psSolid;

end;

 

//............Clears the chat text....................

procedure TChatEdit.Clear;

begin

FLines.Clear;

Position:=0;

end;

 

//...........Add Lines................................

procedure TChatEdit.AddLines(Value : TStringList);

begin

if (Value=nil)or(Value.Count=0) then exit;

 

FLines.AddStrings(Value);

FPosition:=FLines.Count;

if FScrollBar<>nil then

 begin

 FScrollBar.Max:=FLines.Count-1;

 FScrollBar.Position:=FPosition;

 end;

ProcessDisplay;

Repaint;

end;

 

//...........AddLine Lines................................

procedure TChatEdit.AddLine(ns : string);

 begin

  FLines.Add(ns);

  FPosition:=FLines.Count;

  if FScrollBar<>nil then

   begin

     FScrollBar.Max:=FLines.Count-1;

     FScrollBar.Position:=FPosition;

   end;

  ProcessDisplay;

  Repaint;

end;

 

//..................SetPosition.....................

procedure TChatEdit.SetPosition(np : word);

begin

if FPosition=np then exit;

if np>FLines.Count then np:=FLines.Count;

FPosition:=np;

ProcessDisplay;

Repaint;

end;

 

//...........SetFont..............................

procedure TChatEdit.SetFont(NF : TFont);

begin

FFont.Assign(NF);

Canvas.Font:=FFont;

Repaint;

end;

 

//.................GetNrLines......................

function TChatEdit.GetNrLines : integer;

begin

if ClientHeight/Canvas.TextHeight('T')>SMILESIZE then FNrLines:=Canvas.TextHeight('T') else FNrLines:=SMILESIZE;

result:=FNrLines;

end;

 

//...........SetScrollBar.............................

procedure TChatEdit.SetScrollBar(ns : TScrollBar);

begin

FScrollBar:=ns;

FScrollBar.Max:=NrLines;

FScrollBar.Min:=0;

FScrollBar.Kind:=sbVertical;

FScrollBar.Left:=Left+Width;

FScrollBar.Top:=Top;

FScrollBar.Height:=Height;

FScrollBar.LargeChange:=NrLines;

FScrollBar.SmallChange:=1;

end;

 

//.................SetBkColor.....................

procedure TChatEdit.SetBkColor(nc: TColor);

begin

FBkColor:=nc;

Repaint;

end;

 

//.................SetTextColor1.....................

procedure TChatEdit.SetTextColor1(nc: TColor);

begin

FTextColor1:=nc;

Repaint;

end;

 

//.................SetTextColor2.....................

procedure TChatEdit.SetTextColor2(nc: TColor);

begin

FTextColor2:=nc;

Repaint;

end;

 

//.................SetTextColor3.....................

procedure TChatEdit.SetTextColor3(nc: TColor);

begin

FTextColor3:=nc;

Repaint;

end;

 

//.................SetTextColor4.....................

procedure TChatEdit.SetTextColor4(nc: TColor);

begin

FTextColor4:=nc;

Repaint;

end;

 

//.................SetTextColor5.....................

procedure TChatEdit.SetTextColor5(nc: TColor);

begin

FTextColor5:=nc;

Repaint;

end;

 

//...........Paint................................

procedure TChatEdit.Paint;

var

  j,i, minsml, textheight, smilenr : integer;

  offscreen : TBitmap;

  Cursory,Cursorx : integer;  //y position of the text being displayed

  smilepos:array[0..100] of integer;

  smiletype:array[0..100] of integer;

  temp,line:string;

  k,sml,tip : integer;//first smile,curent smile,smile type

  curcar : integer;

  sursa,dest : TRect;

  bbb: TBrush;

begin

  offscreen := TBitmap.Create;

  offscreen.Height:=ClientHeight;

  offscreen.Width:=ClientWidth;

  bbb:=offscreen.Canvas.Brush;

  bbb.Color:=FBkColor;

  offscreen.Canvas.Brush:=bbb;

  offscreen.Canvas.FillRect(ClientRect);

  offscreen.Canvas.Brush:=bbb;

  offscreen.Canvas.FrameRect(ClientRect);

  offscreen.Canvas.Brush:=Canvas.Brush;

  offscreen.Canvas.Font:=Canvas.Font;

  offscreen.Canvas.Brush.Color:=BkColor;

  Canvas.Draw(0,0,offscreen);

  //.............end base display....

  if DisplayLines=nil then exit;

  if DisplayLines.Count=0 then exit;

  textheight:=offscreen.Canvas.TextHeight('T');

  if textheight>SMILESIZE then Cursory:= ClientHeight-5-textheight

    else Cursory:= ClientHeight-5-SMILESIZE;

  i:=0;

 

  //parcurge liniile de text care se afiseaza

  line:='';

 for i:=0 to DisplayLines.Count-1 do

   begin

         Line:=DisplayLines.Strings[i];

         Cursorx:=3;

         smilenr:=0; //nr de smileuri

         minsml:=MAXINT;

          //finds smiles, deletes smiles from string and sets smilepos and smile type

          repeat

            minsml:=MAXINT  ;

            for j:=0 to NRSMILIES-1 do//finds first smile pos

             begin

             temp:=SmileCodes[j];

             sml:=pos(temp,Line);

             if (sml<minsml)and(sml>0) then

                      begin

                      minsml:=sml;

                      tip:=j;

                      end;

             end;

                if minsml<>MAXINT then//eliminates smile and ads smile to list

                 begin

                  temp:=SmileCodes[tip];

                  {Line:=}Delete(Line,minsml,Length(temp));

                  smilepos[smilenr]:=minsml-1;

                  smiletype[smilenr]:=tip;

                  inc(smilenr);

                  end;

            until minsml<>MAXINT;

          //if no smile exist in string

          if smilenr=0 then

           begin

           case Line[1] of

            '1':offscreen.Canvas.Font.Color:=FTextColor1;

            '2':offscreen.Canvas.Font.Color:=FTextColor2;

            '3':offscreen.Canvas.Font.Color:=FTextColor3;

            '4':offscreen.Canvas.Font.Color:=FTextColor4;

            '5':offscreen.Canvas.Font.Color:=FTextColor5;

           end;

           Delete(Line,1,1);

           offscreen.Canvas.TextOut(Cursorx,Cursory,Line);

           Cursorx:=3;

           if textheight>SMILESIZE then Cursory:=Cursory-textheight else Cursory:=Cursory-SMILESIZE;

           end

             else

              begin

              //at this point the smiles should be eliminated and their

              //positions and types stored in smilepos and smiletype

 

              //display

              k:=0;

              curcar:=1;//curent caracter in string (curent substring start)

              case Line[1] of

                    '1':offscreen.Canvas.Font.Color:=FTextColor1;

                    '2':offscreen.Canvas.Font.Color:=FTextColor2;

                    '3':offscreen.Canvas.Font.Color:=FTextColor3;

                    '4':offscreen.Canvas.Font.Color:=FTextColor4;

                    '5':offscreen.Canvas.Font.Color:=FTextColor5;

              end;

                   Delete(Line,1,1);

              for k:=0 to smilenr-1 do

                  begin

                  temp:=copy(Line,curcar,smilepos[k]-curcar);

                  curcar:=smilepos[k];

                  offscreen.Canvas.TextOut(Cursorx,Cursory,temp);

                  Cursorx:=Cursorx+offscreen.Canvas.TextWidth(temp);

                  dest.Left:=Cursorx;

                  if textheight>SMILESIZE then

                        dest.Top:=Cursory+(textheight-SMILESIZE) div 2

                     else

                          dest.Top:=Cursory-(textheight-SMILESIZE) div 2;

                  dest.Right:=dest.Left+SMILESIZE;

                  if dest.Right>ClientWidth-1 then dest.Right:=ClientWidth-1;

                  dest.Bottom:=dest.Top+SMILESIZE;

                  if dest.Bottom>ClientHeight-1 then dest.Bottom:=ClientHeight-1;

                  sursa.Left:=(smiletype[k]mod 5)*SMILESIZE ;

                  sursa.Top:=round((smiletype[k]/5)*SMILESIZE);

                  sursa.Right:=sursa.Left+SMILESIZE;

                  sursa.Bottom:=sursa.Top+SMILESIZE;

                  offscreen.Canvas.BrushCopy(dest,Smilies,sursa,Smilies.TransparentColor);

                  Cursorx:=Cursorx+SMILESIZE;

                  end;

               //this displays the text after the last smile

               temp:=copy(Line,curcar,smilepos[k]-1);

               offscreen.Canvas.TextOut(Cursorx,Cursory,temp);

               //end

               Cursorx:=3;

               if textheight>SMILESIZE then Cursory:=Cursory-textheight  else Cursory:=Cursory-SMILESIZE;

             end;

       end;

 Canvas.Draw(0,0,offscreen);

end;

 

end.