Delphi QQ表情框管理控件的实现源码

在首页区，看到很多实现QQ表情列表管理功能的代码，但是貌似没发现Delphi的实现版本，这里我将我以前写的IM中的表情管理的一个表情框控件共享出来，提供给对Delphi还有感情的爱好者参考使用。介绍我就不多说了，有兴趣的直接下代码看吧，用法也简单，直接使用TDxFaceGrid就行。代码中集合了表情包的实现逻辑（包括表情包的导入和导出等），具体例子我是没写，有兴趣的可以参考参考！

代码

{ ******************************************************* }
{ }
{ 表情编辑框控件 }
{ 作者：不得闲 }
{ 日期: 2009.06.18 }
{ 版权所有 (C) 2009 得闲工作室 }
{ }
{ ******************************************************* }

unit DxFaceControl;

interface
uses Windows,SysUtils,Messages,Classes,Controls,Graphics,GIFImg,ExtCtrls,Nativexml,frxmd5,AES;

type
// 表情节点
TDxFace = class
private
FFaceFileName: string ;
FFaceFileMD5: string ;
FFaceTags: TStringList;
procedure SetFaceFileName( const Value: string );
procedure SetFaceTags( const Value: TStringList);
public
constructor Create;
destructor Destroy; override ;
// 表情文件的MD5码
property FaceFileMD5: string read FFaceFileMD5;
property FaceFileName: string read FFaceFileName write SetFaceFileName; // 表情文件的位置
property FaceTags: TStringList read FFaceTags write SetFaceTags;
end ;

TDxFaces = class
private
FacesList: TList;
FPackageName: string ;
Width: Integer;
Height: Integer;
RowCount: Integer;
ColCount: Integer;
FaceFilePack: string ;
procedure InitFaces(FilePackName: string );
procedure clearFace;
function GetFaces(index: integer): TDxFace;
procedure SetFaces(index: integer;Value: TDxFace);
function GetCount: Integer;
public
constructor Create(FilePackName: string );
destructor Destroy; override ;
property PackageName: string read FPackageName;
property Faces[index: integer]: TDxFace read GetFaces write SetFaces;
property Count: Integer read GetCount;
procedure AddFaces(FaceFile: string ;FaceName: string ); // 添加表情信息
end ;

// 表情包列表
TDxFacePackages = class
private
FacePackages: TStringList; // 表情包列表
UserId: string ;
procedure ClearPackages;
procedure LoadPacks;
function GetCount: Integer;
function GetFaces(index: integer): TDxFaces;
public
constructor Create(ClientUserId: string ); // 根据进入的用户来获得表情包
destructor Destroy; override ;
procedure DeleteFacePackage(PakName: string );
procedure AddPackage(FacePack: TDxFaces); overload ; // 添加表情包
function AddPackage(PackFileName: string ): TDxFaces; overload ; // 通过xml文件来创建添加包
property Count: Integer read GetCount;
property Faces[index: integer]: TDxFaces read GetFaces;
end ;

TOnGetFaceEvent = procedure (Sender: TObject;Face: TDxFace) of object ;
TDxFaceGrid = class (TCustomControl)
private
FFaceWidth: Integer;
FFaceHeight: Integer;
FRowCount: Integer;
FColCount: Integer;
FImages: TList;
Faces: TDxFaces;
CurSelectRect: TRect;
FFrameColor: TColor;
FGridLineColor: TColor;
FSelFrameColor: TColor;
FOnGetFace: TOnGetFaceEvent;
FPageIndex: Integer;
TotalCount: Integer;
FaceSelfCreate: Boolean;
procedure SetFaceWidth( const Value: Integer);
procedure SetFaceHeight( const Value: Integer);
procedure SetRowCount( const Value: Integer);
procedure SetColCount( const Value: Integer);
function GetImage(ACol, ARow: Integer): TImage;
procedure SetFrameColor( const Value: TColor);
procedure SetGridLine( const Value: TColor);
procedure SetSelFrameColor( const Value: TColor);
function GetPageCount: Integer;
procedure SetPageIndex( const Value: Integer);
protected
procedure CreateWnd; override ;
procedure CalcWH;
procedure InitImageItems;
procedure Paint; override ;
procedure DoImgEnter(Sender: TObject);
procedure DoImgLeave(Sender: TObject);
procedure DoImgClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); overload ; override ;
constructor Create(AOwner: TComponent;PackFileName: string ); reintroduce ; overload ;
constructor Create(AOwner: TComponent;FacePack: TDxFaces); reintroduce ; overload ;
destructor Destroy; override ;
property FaceWidth: Integer read FFaceWidth write SetFaceWidth default 24 ;
property FaceHeight: Integer read FFaceHeight write SetFaceHeight default 24 ;
property RowCount: Integer read FRowCount write SetRowCount default 8 ;
property ColCount: Integer read FColCount write SetColCount default 15 ;
property Image[ACol,ARow: Integer]: TImage read GetImage;
property FrameColor: TColor read FFrameColor write SetFrameColor default $AEAEAE;
property GridLine: TColor read FGridLineColor write SetGridLine default $F6E6DF;
property SelFrameColor: TColor read FSelFrameColor write SetSelFrameColor default clBlue;
property OnGetFace: TOnGetFaceEvent read FOnGetFace write FOnGetFace;
property PageCount: Integer read GetPageCount; // 页面数量
property PageIndex: Integer read FPageIndex write SetPageIndex default 0 ;
end ;
implementation
end .

 

全部代码下载