在首页区,看到很多实现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.
全部代码下载
|
请发表评论