Delphi控件源码

开发平台：
Delphi

SelFaceFrm.pas：源码内容
							unit SelFaceFrm;
interface
uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,RealMessengerUnit,ChatingFrm,Global;
type
  TSelFaceForm = class(TForm)
    ImgFace: TImage;
    procedure FormDeactivate(Sender: TObject);
    procedure ImgFaceMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ImgFaceClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    MX,MY,IconIndex,LastIconIndex:Integer;
  public
    ParentForm:TChatingForm;
    HintWindow:THintWindow;
    { Public declarations }
  end;
Const
  FaceCount=70;
  FacesChar: array[1..FaceCount] of string =
  (
    ':)',':d',';)',':o',':p','(h)',':@',':s',':$',':(',
    ':''(',':|','(a)','Bo|','B-|','+o(',':b','|-)','*-)',':-#',
    ':-*','^o)','B-)','(6)',':^)','(v)','(@)','(&)','(sn)','(bah)',
    '(S)','(*)','(#)','(r)','([)','(])','(k)','(f)','(w)','(o)',
    '(g)','(^)','(p)','(i)','(c)','(t)','(mp)','(au)','(ap)','(co)',
    '(mo)','(~)','(8)','(pi)','(so)','(e)','(z)','(x)','(ip)','(um)',
    ':[','(n)','(y)','(ba)','(st)','(li)','(L)','(u)','($)','(he)'
  );
  
  FacesHit: array[1..FaceCount] of string =
  (
    '笑脸','咧嘴笑脸','眨眼笑脸','惊讶的笑脸','吐舌笑脸','热烈的笑脸','生气的脸','困惑的笑脸','尴尬的笑脸','悲伤的脸',
    '哭泣的脸','失望的脸','天使','咬牙切齿','书呆子','生病的脸','聚会笑脸','困了','正在思考','保守秘密',
    '悄悄话','讽刺的脸','转动眼睛','恶魔','不知道','电视机','猫脸','狗脸','蜗牛','黑羊',
    '沉睡的弯月','星星','太阳','彩虹','左侧拥抱','右侧拥抱','红唇','红玫瑰','凋谢的玫瑰','时钟',
    '礼品盒','生日蛋糕','照相机','灯泡','咖啡','电话听筒','移动电话','汽车','飞机','计算机',
    '金钱','电影胶片','音符','比萨','足球','电子邮件','男孩','女孩','有棕榈树的小岛','雨伞',
    '吸血蝙蝠','太差了','太棒了','篮球','乌云','闪电','红心','破碎的心','美元','向日葵'
  );
var
    FaceStream:TFileStream;
    SelFaceForm: TSelFaceForm;
    FaceHasGeted:Boolean;
    Faces,FaceCodes: array[1..FaceCount] of string; //表情图标字符串
implementation
{$R *.dfm}
{OnDeactivate时关闭窗口}
procedure TSelFaceForm.FormDeactivate(Sender: TObject);
begin
  Close;
end;
{MouseMove时显示Mouse当前所指向的表情的相关信息}
procedure TSelFaceForm.ImgFaceMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  r : TRect;
begin
  MX:=X;
  MY:=Y;
  IconIndex:=(MY div 31)*10+(MX div 31+1);
  if (IconIndex<=Length(Faces)) and (LastIconIndex<>IconIndex)   then
  begin
    r.left := Left +  ((IconIndex-1) mod 10)*30+30;
    r.top  := Top + ((IconIndex-1) div 10)*30+30;
    with HintWindow do
    begin
      r.right := r.left+Canvas.TextWidth(FacesHit[IconIndex]+' '+FacesChar[IconIndex])+10;
      r.bottom := r.top+16;
      Color := clInfoBk;
      ReleaseHandle;
      ActivateHint(r,FacesHit[IconIndex]+' '+FacesChar[IconIndex]);
    end;
    ImgFace.Canvas.Pen.Mode:=pmXor;
    ImgFace.Canvas.Pen.Color:=clYellow;
    ImgFace.Canvas.Pen.Width:=1;
    ImgFace.Canvas.Brush.Style:=bsClear;
    ImgFace.Canvas.Rectangle(((LastIconIndex-1) mod 10)*30+3,((LastIconIndex-1) div 10)*30+3,((LastIconIndex-1) mod 10)*30+30,((LastIconIndex-1) div 10)*30+30);
    ImgFace.Canvas.Rectangle(((IconIndex-1) mod 10)*30+3,((IconIndex-1) div 10)*30+3,((IconIndex-1) mod 10)*30+30,((IconIndex-1) div 10)*30+30);
    LastIconIndex:=IconIndex;
  end;
end;
{窗口关闭时释放已分配的内存}
procedure TSelFaceForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  HintWindow.ReleaseHandle;
  HintWindow.Free;
  Action:=caFree;
  SelFaceForm:=nil;
end;
{选择并插入表情图标}
procedure TSelFaceForm.ImgFaceClick(Sender: TObject);
begin
  if IconIndex<=Length(Faces) then
  begin
    ParentForm.MsgInput.SelText := Faces[IconIndex];
    ParentForm.MsgInput.SelLength := 0;
    ParentForm.MsgInput.SelStart := ParentForm.MsgInput.SelStart + 1;
    ParentForm.MsgInput.SetFocus;
  end;
end;
{OnShow事件，设置弹出的窗口的位置}
procedure TSelFaceForm.FormShow(Sender: TObject);
begin
    SelFaceForm.Left:=ParentForm.Left + ParentForm.PnlLeftBottom.Left + ParentForm.ImgSelFace.Left+4;
    SelFaceForm.Top:=ParentForm.Top + ParentForm.PnlLeftBottom.Top + ParentForm.ImgSelFace.Top - ImgFace.Height + 3;
    LastIconIndex:=-1;
    HintWindow:=THintWindow.Create(Self);
end;
{OnCreate事件,设置DoubleBuffered=True，以防止闪烁}
procedure TSelFaceForm.FormCreate(Sender: TObject);
begin
    Self.DoubleBuffered:=True;
    SetWindowLong( Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;
end.

						