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.

 

全部代码下载