unit Textures;

interface

uses
  Windows, Graphics, Classes, Math, SysUtils, DIB , DXClass;

type
  TTexture = class(TObject)
  private
    FHeight: Integer; //高度
    FWidth: Integer;  //宽度
    FPitch: Integer;
    FPBits: Pointer;  //数据指针
    FBitCount: Byte;  //位宽
    FTransparentColor: TColor; //透明色
    procedure SetWidth(Value: Integer);
    procedure SetHeight(Value: Integer);
    function GetPBits: Pointer;
    procedure SetTransparentColor(Value: TColor);
    function GetClientRect(): TRect;
    function GetPixel(X, Y: Integer): Dword;
    procedure SetPixel(X, Y: Integer; Value: Dword);
    function GetPixel16(X, Y: Integer): Word;
    procedure SetPixel16(X, Y: Integer; Value: Word);
    procedure ChangeSize(AWidth, AHeight: Integer);
    function GetScanLine(Y: Integer): Pointer;
  public
    constructor Create();
    destructor Destroy; override;
    property ClientRect: TRect read GetClientRect;
    property BitCount: Byte read FBitCount;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    property Pitch: Integer read FPitch;
    property PBits: Pointer read GetPBits;
    property ScanLine[Y: Integer]: Pointer read GetScanLine;
    property Pixels[X, Y: Integer]: DWord read GetPixel write SetPixel;
    property Pixels16[X, Y: Integer]: Word read GetPixel16 write SetPixel16;
    property TransparentColor: TColor read FTransparentColor write FTransparentColor;
    procedure SetSize(AWidth, AHeight: Integer);
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromDIB(const Source: TDIB);
    procedure SaveToFile(const FileName: string);
    procedure Assign(Source: TTexture);
    procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TTexture; TRANSPARENT: Boolean = True; MIRRORUPDOWN: Boolean = FALSE); overload;
    procedure Draw(X, Y: Integer; Source: TTexture; TRANSPARENT: Boolean = True); overload;
    procedure DrawAlpha(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean; Alpha: Integer);
    procedure DrawSurface(SrcR, DestR: TRect; DestP: PByte; DestPitch, BitCount: Integer);
    procedure FastDrawAlpha(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean = True);
    procedure StretchDraw(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean); overload;
    procedure StretchDraw(const Dest: TRect; Source: TTexture; TRANSPARENT: Boolean = True); overload;
    procedure Filter(const Rect: TRect; DevColor: TColor);
    procedure Fill(DevColor: TColor);
    procedure FillRect(const Rect: TRect; DevColor: TColor);
    procedure FillRectAlpha(const Rect: TRect; Color: TColor; Alpha: Integer);
    procedure FrameRect(const Rect: TRect; DevColor: TColor);
    procedure Line(X1, Y1, X2, Y2: Integer; DevColor: TColor);
    function TextWidth(const Text: string): Integer;
    function TextHeight(const Text: string): Integer;
    procedure TextOut(X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = clBlack);
    procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = clBlack);
    procedure BoldTextOut(X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = $00050505);
    procedure BoldTextRect(Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = $00050505);
    procedure Noise(Color: TColor);
    procedure Side(Source, MarkColor: TColor);
  end;

  TTextureList = class
  private
    function GetCount: Integer;
    function GetTexture(Index: Integer): TTexture;
  public
    List: TList;
    constructor Create();
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TTexture read GetTexture;
  end;

  pTTextureFont = ^TTextureFont;

  TTextureFont = packed record
    Data: PByte;
    Text: string;
    Time: LongWord;
    Name: TFontName;
    Size: Integer;
    Style: TFontStyles;
    Width: Integer;
    Height: Integer;
  end;

  pTFontText = ^TFontText;

  TFontText = packed record
    Font: TTexture;
    Text: string;
    Time: LongWord;
    Name: TFontName;
    Size: Integer;
    Style: TFontStyles;
    FColor: TColor;
    Bcolor: TColor;
  end;

  TImageFont = class //字体
  private
    FontList: TList;
    FontTextList: TList;
    FreeOutTimeTick: LongWord;
    FreeFontTextOutTimeTick: LongWord;
    procedure FreeOutTime;
    procedure FreeFontTextOutTime;
    function GetCount: Integer;
    function GetTextData(Text: string): pTTextureFont;
    procedure DrawFont(pSrc, pDst: PByte; nPitch, nWidth, nHeight: Integer; Color: TColor);
  public
    constructor Create();
    destructor Destroy; override;
    procedure Clear;
    function TextHeight(const Text: string): Integer;
    function TextWidth(const Text: string): Integer;
    procedure DrawRect(DIB: TTexture; Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor = clWhite; BColor: TColor = clBlack);
    procedure BoldDrawRect(DIB: TTexture; Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor = clWhite; BColor: TColor = clBlack);
    procedure Draw(DIB: TTexture; X, Y: Integer; const Text: string; FColor: TColor = clWhite; BColor: TColor = clBlack);
    procedure BoldDraw(DIB: TTexture; X, Y: Integer; const Text: string; FColor: TColor = clWhite; BColor: TColor = clBlack);
    procedure DrawEditText(DIB: TTexture; const X, Y: Integer; const ARect, BRect, CRect: TRect; const AText, BText, CText: string; FontColor: TColor = clBlack; SelFontColor: TColor = clWhite; SelBackColor: TColor = clBlue);
    function GetTextDIB(Text: string; FColor, BColor: TColor): TTexture;
    property Count: Integer read GetCount;
  end;

procedure Move(const Source; var Dest; count: Integer);

function RGB32(c: Word): TColor;

function RGB16(r, G, b: Integer): Word; overload;

function RGB16(c: TColor): Word; overload;

function Bit16To64(Val: Word): Int64;

function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;

function ClipRect2(var DestRect, SrcRect: TRect; const DestRect2, SrcRect2: TRect): Boolean;

var
  ImageFont: TImageFont = nil;
  Background: TTexture = nil;
  ImageCanvas: TTexture = nil;
  MainForm: TDxForm = nil;
  IsMMX: Boolean = true;
  IsSSE: Boolean = true;

implementation

const
  mask_r: Int64 = $F800F800F800F800; // 红色掩码
  mask_g: Int64 = $07E007E007E007E0; // 绿色掩码
  mask_b: Int64 = $001F001F001F001F; // 蓝色掩码

function RGB32(c: Word): TColor;
begin
  Result := RGB(c and $F800 shr 8, c and $07E0 shr 3, c and $001F shl 3);
end;

procedure Move(const Source; var Dest; count: Integer);
asm
        cmp     eax, edx
        je      @@Exit {Source = Dest}
        cmp     ecx, 32
        ja      @@LargeMove {Count > 32 or Count < 0}
        sub     ecx, 8
        jg      @@SmallMove

@@TinyMove: {0..8 Byte Move}
        jmp     dword ptr[@@JumpTable + 32 + ecx * 4]

@@SmallMove: {9..32 Byte Move}
        fild    qword ptr[eax + ecx] {Load Last 8}
        fild    qword ptr[eax] {Load First 8}
        cmp     ecx, 8
        jle     @@Small16
        fild    qword ptr[eax + 8] {Load Second 8}
        cmp     ecx, 16
        jle     @@Small24
        fild    qword ptr[eax + 16] {Load Third 8}
        fistp   qword ptr[edx + 16] {Save Third 8}

@@Small24:
        fistp   qword ptr[edx + 8] {Save Second 8}

@@Small16:
        fistp   qword ptr[edx] {Save First 8}
        fistp   qword ptr[edx + ecx] {Save Last 8}

@@exit:
        ret
        nop {4-Byte Align JumpTable}
        nop

@@JumpTable: {4-Byte Aligned}
        dd      @@Exit, @@M01, @@M02, @@M03, @@M04, @@M05, @@M06, @@M07, @@M08

@@LargeForwardMove: {4-Byte Aligned}
        push    edx
        fild    qword ptr[eax] {First 8}
        lea     eax, [eax + ecx - 8]
        lea     ecx, [ecx + edx - 8]
        fild    qword ptr[eax] {Last 8}
        push    ecx
        neg     ecx
        AND     edx,  - 8 {8-Byte Align Writes}
        lea     ecx, [ecx + edx + 8]
        pop     edx

@FwdLoop:
        fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        add     ecx, 8
        jl      @FwdLoop
        fistp   qword ptr[edx] {Last 8}
        pop     edx
        fistp   qword ptr[edx] {First 8}
        ret

@@LargeMove:
        jng     @@LargeDone {Count < 0}
        cmp     eax, edx
        ja      @@LargeForwardMove
        sub     edx, ecx
        cmp     eax, edx
        lea     edx, [edx + ecx]
        jna     @@LargeForwardMove
        sub     ecx, 8 {Backward Move}
        push    ecx
        fild    qword ptr[eax + ecx] {Last 8}
        fild    qword ptr[eax] {First 8}
        add     ecx, edx
        AND     ecx,  - 8 {8-Byte Align Writes}
        sub     ecx, edx

@BwdLoop:
        fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        sub     ecx, 8
        jg      @BwdLoop
        pop     ecx
        fistp   qword ptr[edx] {First 8}
        fistp   qword ptr[edx + ecx] {Last 8}

@@LargeDone:
        ret

@@M01:
        movzx   ecx, [eax]
        mov     [edx], cl
        ret

@@M02:
        movzx   ecx, word ptr[eax]
        mov     [edx], cx
        ret

@@M03:
        mov     cx, [eax]
        mov     al, [eax + 2]
        mov     [edx], cx
        mov     [edx + 2], al
        ret

@@M04:
        mov     ecx, [eax]
        mov     [edx], ecx
        ret

@@M05:
        mov     ecx, [eax]
        mov     al, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], al
        ret

@@M06:
        mov     ecx, [eax]
        mov     ax, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], ax
        ret

@@M07:
        mov     ecx, [eax]
        mov     eax, [eax + 3]
        mov     [edx], ecx
        mov     [edx + 3], eax
        ret

@@M08:
        fild    qword ptr[eax]
        fistp   qword ptr[edx]
end;


// 将红，绿，蓝三分量转换为COLOR
function RGB16(r, G, b: Integer): Word;
begin
  Result := Word((b and $F8) shr 3 or (G and $FC) shl 3 or (r and $F8) shl 8);
end;

// 将32位GDI颜色值转换为COLOR
function RGB16(c: TColor): Word;
begin
  Result := Word((c shl 8 and $F800) or (c shr 5 and $7E0) or (c shr 19 and $1F));
end;

function Bit16To64(Val: Word): Int64;
var
  bit64: Int64;
begin
  bit64 := Val;
  Result := bit64 or (bit64 shl 16) or (bit64 shl 32) or (bit64 shl 48);
end;

function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
begin
  with DestRect do
  begin
    Left := Max(Left, DestRect2.Left);
    Right := Min(Right, DestRect2.Right);
    Top := Max(Top, DestRect2.Top);
    Bottom := Min(Bottom, DestRect2.Bottom);

    Result := (Left < Right) and (Top < Bottom);
  end;
end;

function ClipRect2(var DestRect, SrcRect: TRect; const DestRect2, SrcRect2: TRect): Boolean;
begin
  if DestRect.Left < DestRect2.Left then
  begin
    SrcRect.Left := SrcRect.Left + (DestRect2.Left - DestRect.Left);
    DestRect.Left := DestRect2.Left;
  end;

  if DestRect.Top < DestRect2.Top then
  begin
    SrcRect.Top := SrcRect.Top + (DestRect2.Top - DestRect.Top);
    DestRect.Top := DestRect2.Top;
  end;

  if SrcRect.Left < SrcRect2.Left then
  begin
    DestRect.Left := DestRect.Left + (SrcRect2.Left - SrcRect.Left);
    SrcRect.Left := SrcRect2.Left;
  end;

  if SrcRect.Top < SrcRect2.Top then
  begin
    DestRect.Top := DestRect.Top + (SrcRect2.Top - SrcRect.Top);
    SrcRect.Top := SrcRect2.Top;
  end;

  if DestRect.Right > DestRect2.Right then
  begin
    SrcRect.Right := SrcRect.Right - (DestRect.Right - DestRect2.Right);
    DestRect.Right := DestRect2.Right;
  end;

  if DestRect.Bottom > DestRect2.Bottom then
  begin
    SrcRect.Bottom := SrcRect.Bottom - (DestRect.Bottom - DestRect2.Bottom);
    DestRect.Bottom := DestRect2.Bottom;
  end;

  if SrcRect.Right > SrcRect2.Right then
  begin
    DestRect.Right := DestRect.Right - (SrcRect.Right - SrcRect2.Right);
    SrcRect.Right := SrcRect2.Right;
  end;

  if SrcRect.Bottom > SrcRect2.Bottom then
  begin
    DestRect.Bottom := DestRect.Bottom - (SrcRect.Bottom - SrcRect2.Bottom);
    SrcRect.Bottom := SrcRect2.Bottom;
  end;

  Result := (DestRect.Left < DestRect.Right) and (DestRect.Top < DestRect.Bottom) and (SrcRect.Left < SrcRect.Right) and (SrcRect.Top < SrcRect.Bottom);
end;

procedure TTexture.SetWidth(Value: Integer);
begin
  if Value <> FWidth then
  begin
    ChangeSize(Value, FHeight);
  end;
end;

procedure TTexture.SetHeight(Value: Integer);
begin
  if Value <> FHeight then
  begin
    ChangeSize(FWidth, Value);
  end;
end;

function TTexture.GetPBits: Pointer;
begin
  Result := FPBits;
end;

procedure TTexture.SetTransparentColor(Value: TColor);
begin
  FTransparentColor := Value;
end;

function TTexture.GetClientRect(): TRect;
begin
  Result := Bounds(0, 0, Width, Height);
end;

function TTexture.GetPixel(X, Y: Integer): Dword;
begin
  Result := 0;
  if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    Result := RGB32(PWord(Integer(FPBits) + Y * Pitch + X * 2)^);
end;

procedure TTexture.SetPixel(X, Y: Integer; Value: Dword);
begin
  if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    PWord(Integer(FPBits) + Y * Pitch + X * 2)^ := RGB16(Value);
end;

function TTexture.GetPixel16(X, Y: Integer): Word;
begin
  Result := 0;
  if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    Result := PWord(Integer(FPBits) + Y * Pitch + X * 2)^;
end;

procedure TTexture.SetPixel16(X, Y: Integer; Value: Word);
begin
  if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    PWord(Integer(FPBits) + Y * Pitch + X * 2)^ := Value;
end;

procedure TTexture.ChangeSize(AWidth, AHeight: Integer);
begin
  if (FWidth <> AWidth) or (FHeight <> AHeight) then
  begin
    FWidth := AWidth;
    FHeight := AHeight;
    FPitch := (((FWidth * BitCount) + 31) shr 5) * 4;

    if Assigned(FPBits) then
    begin
      FreeMem(FPBits);
      FPBits := nil;
    end;
    FPBits := AllocMem(FPitch * FHeight);
  end;
end;

function TTexture.GetScanLine(Y: Integer): Pointer;
begin
  if (Y >= 0) and (Y < Height) then
    Result := Pointer(Integer(FPBits) + Y * FPitch)
  else
    Result := nil;
end;

constructor TTexture.Create();
begin
  inherited;
  FTransparentColor := $0000;
  FWidth := 0;
  FHeight := 0;
  FPitch := 0;
  FPBits := nil;
  FBitCount := 16;
end;

destructor TTexture.Destroy;
begin
  if Assigned(FPBits) then
    FreeMem(FPBits);
  inherited;
end;

procedure TTexture.SetSize(AWidth, AHeight: Integer);
begin
  ChangeSize(AWidth, AHeight);
end;

procedure TTexture.LoadFromFile(const FileName: string);
var
  I: Integer;
  Source: TDIB;
  pSrc, pDst: PByte;
begin
  Source := TDIB.Create; //dib文件
  try
    Source.LoadFromFile(FileName); //载入dib
    Source.PixelFormat := MakeDIBPixelFormat(5, 6, 5); //设置
    Source.BitCount := 16;                             //位宽
    SetSize(Source.Width, Source.Height);              //设置大小
    for I := 0 to Source.Height - 1 do                 //遍历
    begin
      pSrc := PByte(Integer(Source.PBits) + (Source.Height - 1 - I) * Source.WidthBytes);
      pDst := PByte(Integer(PBits) + I * Pitch);       // dst is PBits FPBits
      Move(pSrc^, pDst^, Pitch);                       //src to dst
    end;
  finally
    Source.Free;
  end;
end;

procedure TTexture.LoadFromDIB(const Source: TDIB);
var
  I: Integer;
  pSrc, pDst: PByte;
begin
  SetSize(Source.Width, Source.Height);
  Source.PixelFormat := MakeDIBPixelFormat(5, 6, 5);
  Source.BitCount := 16;
  for I := 0 to Source.Height - 1 do
  begin
    pSrc := PByte(Integer(Source.PBits) + (Source.Height - 1 - I) * Source.WidthBytes);
    pDst := PByte(Integer(PBits) + I * Pitch);
    Move(pSrc^, pDst^, Min(Pitch, Source.WidthBytes));
  end;
end;

procedure TTexture.SaveToFile(const FileName: string);
var
  I: Integer;
  Source: TDIB;
  pSrc, pDst: PByte;
begin
  Source := TDIB.Create;
  try
    Source.PixelFormat := MakeDIBPixelFormat(5, 6, 5);
    Source.SetSize(Width, Height, 16);
    for I := 0 to Source.Height - 1 do
    begin
      pSrc := PByte(Integer(PBits) + (Source.Height - I - 1) * Pitch);
      pDst := PByte(Integer(Source.PBits) + I * Source.Width * 2);
      Move(pSrc^, pDst^, Pitch);
    end;
    Source.SaveToFile(FileName);
  finally
    Source.Free;
  end;
end;

procedure TTexture.Assign(Source: TTexture);
begin
  SetSize(Source.Width, Source.Height);
  TransparentColor := Source.TransparentColor;
  Draw(0, 0, Source, False);
end;

procedure TTexture.Draw(X, Y: Integer; SrcRect: TRect; Source: TTexture; TRANSPARENT: Boolean = True; MIRRORUPDOWN: Boolean = FALSE);
var
  DestRect: TRect;
  j, k, L: Integer;
  nX, nY: Integer;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  nCol64: Int64;
  wColor: Word;
  nSLeft: Integer;
  nDLeft: Integer;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  if Source <> nil then
  begin
    if (X > Width) or (Y > Height) then
      Exit;
    with SrcRect do
      DestRect := Bounds(X, Y, Right - Left, Bottom - Top);

    if not MIRRORUPDOWN then
    begin

      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
      begin
        nWidth := SrcRect.Right - SrcRect.Left;
        nHeight := SrcRect.Bottom - SrcRect.Top;
        if TRANSPARENT then
        begin

          wColor := RGB16(Source.TransparentColor);
          nCol64 := Bit16To64(wColor);
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;

          if IsSSE then
          begin
            nSSEM := nWidth mod 8;
            nSSEW := nWidth div 8;
          end
          else
          begin
            nSSEM := 0;
            nSSEW := 0;
          end;

          if nSSEW > 0 then
          begin
            nMMXM := nSSEM mod 4;
            nMMXW := nSSEM div 4;
          end
          else
          begin
            nMMXM := nWidth mod 4;
            nMMXW := nWidth div 4;
          end;

          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
            k := nWidth;

            if IsSSE then
            begin
              for nX := 0 to nSSEW - 1 do
              begin
                asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movlps  xmm7, nCol64		// 64位颜色键
        movhps  xmm7, nCol64		// 64位颜色键
        movdqu  xmm0, [ecx]		// 从源地址取8象素数据
        movdqu  xmm2, [edx]		// 从源地址取8象素数据
        movdqu  xmm1, xmm0		// 源数据给mm1
        pcmpeqw xmm0, xmm7	// mm0为透明掩码
        psubusw xmm1, xmm0	// 源数据透明点置0
        pand    xmm0, xmm2		// 目的数据非透明点置0
        por     xmm0, xmm1		// 相与得结果数据
        movdqu  [edx], xmm0		// 结果送目的地址
        add     ecx, 16
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                end;
              end;
            end;

            for nX := 0 to nMMXW - 1 do
            begin
              asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movq    mm7, nCol64		// 64位颜色键
        movq    mm0, [ecx]		// 从源地址取4象素数据
        movq    mm2, [edx]		// 从源地址取8象素数据
        movq    mm1, mm0		// 源数据给mm1
        pcmpeqw mm0, mm7	// mm0为透明掩码
        psubusw mm1, mm0	// 源数据透明点置0
        pand    mm0, mm2		// 目的数据非透明点置0
        por     mm0, mm1		// 相与得结果数据
        movq    [edx], mm0		// 结果送目的地址
        add     ecx, 8
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
              end;
            end;

            asm
        emms
            end;

            for nX := 0 to k - 1 do
            begin //剩余处理
              if PWord(pSrc)^ <> wColor then
                PWord(pDst)^ := PWord(pSrc)^;
              Inc(pSrc, 2);
              Inc(pDst, 2);
            end;
          end;

        end
        else
        begin
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;
          nWidth := nWidth * 2;
          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
            Move(pSrc^, pDst^, nWidth);
          end;
        end;
      end;

    end
    else
    begin //if not MIRRORUPDOWN then begin
      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
      begin
        nWidth := SrcRect.Right - SrcRect.Left;
        nHeight := SrcRect.Bottom - SrcRect.Top;
        if TRANSPARENT then
        begin
          wColor := RGB16(Source.TransparentColor);
          nCol64 := Bit16To64(wColor);
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;

          if IsSSE then
          begin
            nSSEM := nWidth mod 8;
            nSSEW := nWidth div 8;
          end
          else
          begin
            nSSEM := 0;
            nSSEW := 0;
          end;

          if nSSEW > 0 then
          begin
            nMMXM := nSSEM mod 4;
            nMMXW := nSSEM div 4;
          end
          else
          begin
            nMMXM := nWidth mod 4;
            nMMXW := nWidth div 4;
          end;

          for nY := nHeight - 1 downto 0 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nHeight - nY - 1) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
            k := nWidth;

            if IsSSE then
            begin
              for nX := 0 to nSSEW - 1 do
              begin
                asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movlps  xmm7, nCol64		// 64位颜色键
        movhps  xmm7, nCol64		// 64位颜色键
        movdqu  xmm0, [ecx]		// 从源地址取8象素数据
        movdqu  xmm2, [edx]		// 从源地址取8象素数据
        add     ecx, 16
        movdqu  xmm1, xmm0		// 源数据给mm1
        pcmpeqw xmm0, xmm7	// mm0为透明掩码
        psubusw xmm1, xmm0	// 源数据透明点置0
        pand    xmm0, xmm2		// 目的数据非透明点置0
        por     xmm0, xmm1		// 相与得结果数据
        movdqu  [edx], xmm0		// 结果送目的地址
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                end;
              end;
            end;

            for nX := 0 to nMMXW - 1 do
            begin
              asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movq    mm7, nCol64		// 64位颜色键
        movq    mm0, [ecx]		// 从源地址取4象素数据
        movq    mm2, [edx]		// 从源地址取8象素数据
        add     ecx, 8
        movq    mm1, mm0		// 源数据给mm1
        pcmpeqw mm0, mm7	// mm0为透明掩码
        psubusw mm1, mm0	// 源数据透明点置0
        pand    mm0, mm2		// 目的数据非透明点置0
        por     mm0, mm1		// 相与得结果数据
        movq    [edx], mm0		// 结果送目的地址
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
              end;
            end;

            asm
        emms
            end;

            for nX := 0 to k - 1 do
            begin //剩余处理
              if PWord(pSrc)^ <> wColor then
                PWord(pDst)^ := PWord(pSrc)^;
              Inc(pSrc, 2);
              Inc(pDst, 2);
            end;
          end;

        end
        else
        begin
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;
          nWidth := nWidth * 2;
          for nY := nHeight - 1 downto 0 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nHeight - nY - 1) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);

            Move(pSrc^, pDst^, nWidth);
          end;
        end;
      end;
    end;
  end;
end;

procedure TTexture.Draw(X, Y: Integer; Source: TTexture; TRANSPARENT: Boolean = True);
begin
  Draw(X, Y, Source.ClientRect, Source, TRANSPARENT);
end;

procedure TTexture.DrawAlpha(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean; Alpha: Integer);
var
  DestRect, SrcRect: TRect;
  nX, nY, j, k, L: Integer;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  nCol64: Int64;
  wColor: Word;
  nAlpha64: Int64;
  nSLeft: Integer;
  nDLeft: Integer;
  r, G, b, dr, dg, db: byte;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  if Source <> nil then
  begin
    DestRect := Dest;
    SrcRect := Src;
    if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
    begin
      if (Alpha >= 0) and (Alpha <= 256) then
      begin
        wColor := RGB16(Source.TransparentColor);
        nCol64 := Bit16To64(wColor);
        nAlpha64 := Bit16To64(Alpha shr 3);
        nWidth := SrcRect.Right - SrcRect.Left;
        nHeight := SrcRect.Bottom - SrcRect.Top;

        if TRANSPARENT then
        begin
          k := nWidth mod 4;
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;

          if IsSSE then
          begin
            nSSEM := nWidth mod 8;
            nSSEW := nWidth div 8;
          end
          else
          begin
            nSSEM := 0;
            nSSEW := 0;
          end;

          if nSSEW > 0 then
          begin
            nMMXM := nSSEM mod 4;
            nMMXW := nSSEM div 4;
          end
          else
          begin
            nMMXM := nWidth mod 4;
            nMMXW := nWidth div 4;
          end;

          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
            k := nWidth;

            if IsSSE then
            begin
              for nX := 0 to nSSEW - 1 do
              begin
                asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movlps  xmm1, nCol64
        movhps  xmm1, nCol64
                 {  movd eax, xmm1
                   cmp [ecx], eax
                   jnz @notequal_sse
                   cmp [ecx+8], eax
                   jnz @notequal_sse
                   jmp @finishone_sse   }
             //  @notequal_sse:
        movdqu  xmm3, [edx]
        movdqu  xmm0, [ecx]
        movlps  xmm7, nAlpha64
        movhps  xmm7, nAlpha64
        pcmpeqw xmm1, xmm0
        psubusw xmm7, xmm1
                   // 调用Alpha混合
                   {$include SSE.inc}
        movdqu  [edx], xmm0
               //@finishone_sse:
        add     ecx, 16
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                end;
              end;
            end;

            for nX := 0 to nMMXW - 1 do
            begin
              asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movq    mm1, nCol64
        movd    eax, mm1
        cmp     [ecx], eax
        jnz     @notequal
        cmp     [ecx + 4], eax
        jnz     @notequal
        jmp     @finishone

@notequal:
        movq    mm3, [edx]
        movq    mm0, [ecx]
        movq    mm7, nAlpha64
        pcmpeqw mm1, mm0
        psubusw mm7, mm1
                 {$INCLUDE MMX.inc}
        movq    [edx], mm0

@finishone:
        add     ecx, 8
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
              end;
            end;

            asm
        emms
            end;

            for nX := 0 to k - 1 do
            begin //剩余处理
              if PWord(pSrc)^ <> wColor then
              begin
                r := PWord(pSrc)^ and $F800 shr 8;
                G := PWord(pSrc)^ and $07E0 shr 3;
                b := PWord(pSrc)^ and $001F shl 3;

                dr := PWord(pDst)^ and $F800 shr 8;
                dg := PWord(pDst)^ and $07E0 shr 3;
                db := PWord(pDst)^ and $001F shl 3;

                r := (r * (Alpha) + dr * (256 - Alpha)) shr 8;
                G := (G * (Alpha) + dg * (256 - Alpha)) shr 8;
                b := (b * (Alpha) + db * (256 - Alpha)) shr 8;

                PWord(pDst)^ := (r shl 8 and $F800) or (G shl 3 and $07E0) or (b shr 3 and $001F);
              end;
              Inc(pSrc, 2);
              Inc(pDst, 2);
            end;
          end;

        end
        else
        begin
          nSLeft := SrcRect.Left * 2;
          nDLeft := DestRect.Left * 2;
          k := nWidth mod 4;

          if IsSSE then
          begin
            nSSEM := nWidth mod 8;
            nSSEW := nWidth div 8;
          end
          else
          begin
            nSSEM := 0;
            nSSEW := 0;
          end;

          if nSSEW > 0 then
          begin
            nMMXM := nSSEM mod 4;
            nMMXW := nSSEM div 4;
          end
          else
          begin
            nMMXM := nWidth mod 4;
            nMMXW := nWidth div 4;
          end;

          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
            k := nWidth;

            if IsSSE then
            begin
              for nX := 0 to nSSEW - 1 do
              begin
                asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movlps  xmm7, nAlpha64
        movhps  xmm7, nAlpha64
        movdqu  xmm3, [edx]
        movdqu  xmm0, [ecx]
                {$include SSE.inc}
        add     ecx, 16
        movdqu  [edx], xmm0
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                end;
              end;
            end;

            for nX := 0 to nMMXW - 1 do
            begin
              asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movq    mm7, nAlpha64		// 透明度
        movq    mm3, [edx]
        movq    mm0, [ecx]
                {$include MMX.inc}
        add     ecx, 8
        movq    [edx], mm0
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
              end;
            end;

            asm
        emms
            end;

            for nX := 0 to k - 1 do
            begin //剩余处理
              r := PWord(pSrc)^ and $F800 shr 8;
              G := PWord(pSrc)^ and $07E0 shr 3;
              b := PWord(pSrc)^ and $001F shl 3;

              dr := PWord(pDst)^ and $F800 shr 8;
              dg := PWord(pDst)^ and $07E0 shr 3;
              db := PWord(pDst)^ and $001F shl 3;

              r := (r * (Alpha) + dr * (256 - Alpha)) shr 8;
              G := (G * (Alpha) + dg * (256 - Alpha)) shr 8;
              b := (b * (Alpha) + db * (256 - Alpha)) shr 8;

              PWord(pDst)^ := (r shl 8 and $F800) or (G shl 3 and $07E0) or (b shr 3 and $001F);

              Inc(pSrc, 2);
              Inc(pDst, 2);
            end;
          end;

        end;
      end
      else
      begin
        Draw(DestRect.Left, DestRect.Top, SrcRect, Source, TRANSPARENT);
      end;
    end;
  end;
end;

procedure TTexture.DrawSurface(SrcR, DestR: TRect; DestP: PByte; DestPitch, BitCount: Integer);
var
  SrcRect, DestRect: TRect;
  nX, nY: Integer;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  nDPitch: Integer;
  nSPitch: Integer;
  j, k, L: Integer;
  RGBQuad: PRGBQuad;
  RGBTriple: PRGBTriple;
  nLeft, nBitCount: Integer;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  SrcRect := SrcR;
  DestRect := DestR;
  if ClipRect(DestRect, DestR) and ClipRect(SrcRect, ClientRect) then
  begin

    nWidth := Min(SrcRect.Right - SrcRect.Left, DestRect.Right - DestRect.Left);
    nHeight := Min(SrcRect.Bottom - SrcRect.Top, DestRect.Bottom - DestRect.Top);

    with SrcRect do
    begin
      Right := Left + nWidth;
      Bottom := Top + nHeight;
    end;

    with DestRect do
    begin
      Right := Left + nWidth;
      Bottom := Top + nHeight;
    end;

    if ClipRect(DestRect, DestRect) and ClipRect(SrcRect, SrcRect) then
    begin
      case BitCount of
        16:
          begin
            nLeft := SrcRect.Left * 2;
            nBitCount := BitCount div 8;
            nWidth := nWidth * 2;
            for nY := 0 to nHeight - 1 do
            begin
              pSrc := PByte(Integer(PBits) + (SrcRect.Top + nY) * Pitch + nLeft);
              pDst := PByte(Integer(DestP) + (DestRect.Top + nY) * DestPitch + DestRect.Left * nBitCount);
              Move(pSrc^, pDst^, nWidth);
            end;
          end;
        24:
          begin
            nLeft := SrcRect.Left * 2;
            nBitCount := BitCount div 8;
            nWidth := nWidth * 2;
            for nY := 0 to nHeight - 1 do
            begin
              pSrc := PByte(Integer(PBits) + (SrcRect.Top + nY) * Pitch + nLeft);
              pDst := PByte(Integer(DestP) + (DestRect.Top + nY) * DestPitch + DestRect.Left * nBitCount);
              for nX := 0 to nWidth - 1 do
              begin
                RGBTriple := PRGBTriple(pDst);
                RGBTriple.rgbtRed := PWord(pSrc)^ and $F800 shr 8;
                RGBTriple.rgbtGreen := PWord(pSrc)^ and $07E0 shr 3;
                RGBTriple.rgbtBlue := PWord(pSrc)^ and $001F shl 3;
                Inc(pSrc, 2);
                Inc(pDst, 3);
              end;
            end;
          end;
        32:
          begin //16转32 MMX优化
            k := nWidth mod 4;
            nLeft := SrcRect.Left * 2;
            nBitCount := BitCount div 8;

            if IsSSE then
            begin
              nSSEM := nWidth mod 8;
              nSSEW := nWidth div 8;
            end
            else
            begin
              nSSEM := 0;
              nSSEW := 0;
            end;

            if nSSEW > 0 then
            begin
              nMMXM := nSSEM mod 4;
              nMMXW := nSSEM div 4;
            end
            else
            begin
              nMMXM := nWidth mod 4;
              nMMXW := nWidth div 4;
            end;

            for nY := 0 to nHeight - 1 do
            begin
              pSrc := PByte(Integer(PBits) + (SrcRect.Top + nY) * Pitch + nLeft);
              pDst := PByte(Integer(DestP) + (DestRect.Top + nY) * DestPitch + DestRect.Left * nBitCount);

              k := nWidth;

              if IsSSE then
              begin
                for nX := 0 to nSSEW - 1 do
                begin
                  asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movlps  xmm4, mask_r
        movhps  xmm4, mask_r
        movlps  xmm5, mask_g
        movhps  xmm5, mask_g
        movlps  xmm6, mask_b
        movhps  xmm6, mask_b
        movdqu  xmm0, [ecx]
        movdqu  xmm7, xmm0				// save src 4 X 16bit color data
        pand    xmm0, xmm4				// & r mask   r := pSrc^ and $F800
        psrlw   xmm0, 8				// >> 8       r := r shr 8;
        movdqu  xmm1, xmm7				// restore mm1 data
        pand    xmm1, xmm5				// & g mask   g := pSrc^ and $07E0;
        psrlw   xmm1, 3				// >> 3       g := g shr 3;
        movdqu  xmm2, xmm7				// restore mm1 data
        pand    xmm2, xmm6				// & b mask   b := pSrc^ and $001F;
        psllw   xmm2, 3				// << 3       b := b shl 3;
        psllq   xmm1, 8				// << 8       g := g shl 8;
        por     xmm1, xmm2				// 4 pixel b\g  g := g or b;
        movdqu  xmm7, xmm1				// save mm1
        punpcklwd xmm1, xmm0
        movdqu  [edx], xmm1
        add     edx, 16					// write 4 X 32bit
        movdqu  xmm1, xmm7
        punpckhwd xmm1, xmm0
        movdqu  [edx], xmm1
        add     ecx, 16					// read 4 X 16bit
        add     edx, 16					// write 4 X 32bit
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                  end;
                end;
              end;

              for nX := 0 to nMMXW - 1 do
              begin
                asm
        mov     edx, pDst		// edx = 目的指针
        mov     ecx, pSrc		// ecx = 源指针
        movq    mm4, mask_r
        movq    mm5, mask_g
        movq    mm6, mask_b
        movq    mm0, [ecx]
        movq    mm7, mm0				// save src 4 X 16bit color data
        pand    mm0, mm4				// & r mask   r := pSrc^ and $F800
        psrlw   mm0, 8				// >> 8       r := r shr 8;
        movq    mm1, mm7				// restore mm1 data
        pand    mm1, mm5				// & g mask   g := pSrc^ and $07E0;
        psrlw   mm1, 3				// >> 3       g := g shr 3;
        movq    mm2, mm7				// restore mm1 data
        pand    mm2, mm6				// & b mask   b := pSrc^ and $001F;
        psllw   mm2, 3				// << 3       b := b shl 3;
        psllq   mm1, 8				// << 8       g := g shl 8;
        por     mm1, mm2				// 4 pixel b\g  g := g or b;
        movq    mm7, mm1				// save mm1
        punpcklwd mm1, mm0
        movq    [edx], mm1
        add     edx, 8					// write 4 X 32bit
        movq    mm1, mm7
        punpckhwd mm1, mm0
        movq    [edx], mm1
        add     ecx, 8					// read 4 X 16bit
        add     edx, 8					// write 4 X 32bit
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
                end;
              end;

              asm
        emms
              end;

              for nX := 1 to k do
              begin //剩余处理
                RGBQuad := PRGBQuad(pDst);
                RGBQuad.rgbRed := PWord(pSrc)^ and $F800 shr 8;
                RGBQuad.rgbGreen := PWord(pSrc)^ and $07E0 shr 3;
                RGBQuad.rgbBlue := PWord(pSrc)^ and $001F shl 3;
                RGBQuad.rgbReserved := 0;
                Inc(pSrc, 2);
                Inc(pDst, 4);
              end;
            end;

          end;
      end;
    end;
  end;
end;

procedure TTexture.FastDrawAlpha(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean);
var
  DestRect, SrcRect: TRect;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  j, k, L: Integer;
  nX, nY: Integer;
  nCol64: Int64;
  wColor: Word;
  Mask: Int64;
  wSP, wDP: Word;
  //nSPitch, nDPitch: Integer;
  r, G, b: byte;
  nSLeft: Integer;
  nDLeft: Integer;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  if Source <> nil then
  begin
    DestRect := Dest;
    SrcRect := Src;
    //nSPitch := Source.Pitch;
    //nDPitch := Pitch;
    if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
    begin
      Mask := $7BEF7BEF7BEF7BEF;
      nWidth := SrcRect.Right - SrcRect.Left;
      nHeight := SrcRect.Bottom - SrcRect.Top;
      if TRANSPARENT then
      begin
        wColor := RGB16(Source.TransparentColor);
        nCol64 := Bit16To64(wColor);
        nSLeft := SrcRect.Left * 2;
        nDLeft := DestRect.Left * 2;
        k := nWidth mod 4;

        if IsSSE then
        begin
          nSSEM := nWidth mod 8;
          nSSEW := nWidth div 8;
        end
        else
        begin
          nSSEM := 0;
          nSSEW := 0;
        end;

        if nSSEW > 0 then
        begin
          nMMXM := nSSEM mod 4;
          nMMXW := nSSEM div 4;
        end
        else
        begin
          nMMXM := nWidth mod 4;
          nMMXW := nWidth div 4;
        end;

        for nY := 0 to nHeight - 1 do
        begin
          pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
          pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
          k := nWidth;

          if IsSSE then
          begin
            for nX := 0 to nSSEW - 1 do
            begin
              asm
        mov     ecx, pDst
        mov     eax, pSrc
        movlps  xmm6, nCol64
        movhps  xmm6, nCol64
        movlps  xmm7, Mask
        movhps  xmm7, Mask
        movdqu  xmm0, [eax]
        movdqu  xmm1, [ecx]
        movdqu  xmm5, xmm0
        movdqu  xmm2, xmm1
        pcmpeqw xmm5, xmm6	// xmm5为透明掩码
        psrlq   xmm2, 1
        psrlq   xmm0, 1
        pand    xmm2, xmm7
        pand    xmm0, xmm7
        paddw   xmm2, xmm0		// xmm2为混合结果
        pand    xmm1, xmm5		// 目的数据非透明点置0
        psubusw xmm2, xmm5	// 混合结果透明点置0
        por     xmm1, xmm2		// 相或得最终结果
        movdqu  [ecx], xmm1
        add     eax, 16
        add     ecx, 16
        sub     k, 8
        mov     integer ptr[pSrc], eax
        mov     integer ptr[pDst], ecx
              end;
            end;
          end;

          for nX := 0 to nMMXW - 1 do
          begin
            asm
        mov     ecx, pDst
        mov     eax, pSrc
        movq    mm6, nCol64
        movq    mm7, Mask
        movlps  xmm6, nCol64
        movhps  xmm6, nCol64
        movlps  xmm7, Mask
        movhps  xmm7, Mask
        movd    edx, mm6
        cmp     [eax], edx
        jnz     @notequal
        cmp     [eax + 4], edx
        jnz     @notequal
        jmp     @finishone

@notequal:
        movq    mm0, [eax]
        movq    mm1, [ecx]
        movq    mm5, mm0
        movq    mm2, mm1
        pcmpeqw mm5, mm6	// mm5为透明掩码
        psrlq   mm2, 1
        psrlq   mm0, 1
        pand    mm2, mm7
        pand    mm0, mm7
        paddw   mm2, mm0		// mm2为混合结果
        pand    mm1, mm5		// 目的数据非透明点置0
        psubusw mm2, mm5	// 混合结果透明点置0
        por     mm1, mm2		// 相或得最终结果
        movq    [ecx], mm1

@finishone:
        add     eax, 8
        add     ecx, 8
        sub     k, 4
        mov     integer ptr[pSrc], eax
        mov     integer ptr[pDst], ecx
            end;
          end;

          asm
        emms
          end;

          for nX := 0 to k - 1 do
          begin //剩余处理
            if wColor <> PWord(pSrc)^ then
            begin
              wSP := PWord(pSrc)^ shr 1 and $7BEF;
              wDP := PWord(pDst)^ shr 1 and $7BEF;
              r := (wSP shr 11) + (wDP shr 11);
              G := (wSP shr 5 and $3F) + (wDP shr 5 and $3F);
              b := (wSP and $1F) + (wDP and $1F);
              PWord(pDst)^ := (r shl 11) or (G shl 5) or b;
            end;
            Inc(pSrc, 2);
            Inc(pDst, 2);
          end;
        end;
      end
      else
      begin
        nSLeft := SrcRect.Left * 2;
        nDLeft := DestRect.Left * 2;
        k := nWidth mod 4;

        if IsSSE then
        begin
          nSSEM := nWidth mod 8;
          nSSEW := nWidth div 8;
        end
        else
        begin
          nSSEM := 0;
          nSSEW := 0;
        end;

        if nSSEW > 0 then
        begin
          nMMXM := nSSEM mod 4;
          nMMXW := nSSEM div 4;
        end
        else
        begin
          nMMXM := nWidth mod 4;
          nMMXW := nWidth div 4;
        end;

        for nY := 0 to nHeight - 1 do
        begin
          pSrc := PByte(Integer(Source.PBits) + (SrcRect.Top + nY) * Source.Pitch + nSLeft);
          pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
          k := nWidth;
          if IsSSE then
          begin
            for nX := 0 to nSSEW - 1 do
            begin
              asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movlps  xmm7, Mask
        movhps  xmm7, Mask
        movdqu  xmm0, [ecx]		// 取源数据到mm0
        movdqu  xmm1, [edx]		// 取目的数据到mm1
        psrlq   xmm0, 1		// src? = 0rrrrrggggggbbbb
        psrlq   xmm1, 1		// dst? = 0rrrrrggggggbbbb
        pand    xmm0, xmm7		// src? = 0rrrr0ggggg0bbbb
        pand    xmm1, xmm7		// dst? = 0rrrr0ggggg0bbbb
        paddw   xmm0, xmm1		// result? = rrrrrggggggbbbbb
        add     ecx, 16
        movdqu  [edx], xmm0		// 写回目的地址
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
              end;
            end;
          end;

          for nX := 0 to nMMXW - 1 do
          begin
            asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movq    mm7, Mask		// 64位掩码
        movq    mm0, [ecx]		// 取源数据到mm0
        movq    mm1, [edx]		// 取目的数据到mm1
        psrlq   mm0, 1		// src? = 0rrrrrggggggbbbb
        psrlq   mm1, 1		// dst? = 0rrrrrggggggbbbb
        pand    mm0, mm7		// src? = 0rrrr0ggggg0bbbb
        pand    mm1, mm7		// dst? = 0rrrr0ggggg0bbbb
        paddw   mm0, mm1		// result? = rrrrrggggggbbbbb
        add     ecx, 8
        movq    [edx], mm0		// 写回目的地址
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pSrc], ecx
        mov     integer ptr[pDst], edx
            end;
          end;

          asm
        emms
          end;

          for nX := 0 to k - 1 do
          begin //剩余处理
            wSP := PWord(pSrc)^ shr 1 and $7BEF;
            wDP := PWord(pDst)^ shr 1 and $7BEF;
            r := (wSP shr 11) + (wDP shr 11);
            G := (wSP shr 5 and $3F) + (wDP shr 5 and $3F);
            b := (wSP and $1F) + (wDP and $1F);
            PWord(pDst)^ := (r shl 11) or (G shl 5) or b;

            Inc(pSrc, 2);
            Inc(pDst, 2);
          end;
        end;
 // 算法: 将颜色值全部右移一位, 再与掩码做且运算, 则三色分量均除以2
 // 源数据和目的数据均做上述操作, 再相加即实现半透明
      end;
    end;
  end;
end;

procedure TTexture.StretchDraw(const Dest, Src: TRect; Source: TTexture; TRANSPARENT: Boolean);
var
  DIB: TTexture;
  DestRect, SrcRect: TRect;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  nSLeft: Integer;
  nDLeft: Integer;
  nX, nY: Integer;
  xrIntFloat_16: Integer;
  yrIntFloat_16: Integer;
  srcx_16: Integer;
  srcy_16: Integer;
begin
  if Source <> nil then
  begin
    DestRect := Dest;
    SrcRect := Src;

    if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
    begin
      nWidth := DestRect.Right - DestRect.Left;
      nHeight := DestRect.Bottom - DestRect.Top;

      srcy_16 := 0;
      xrIntFloat_16 := ((SrcRect.Right - SrcRect.Left) shl 16) div nWidth + 1;
      yrIntFloat_16 := ((SrcRect.Bottom - SrcRect.Top) shl 16) div nHeight + 1;

      nSLeft := SrcRect.Left * 2;
      nDLeft := DestRect.Left * 2;

      if TRANSPARENT then
      begin
        DIB := TTexture.Create;
        DIB.SetSize(Width, Height);
        for nY := 0 to nHeight - 1 do
        begin
          pSrc := PByte(Integer(Source.PBits) + SrcRect.Top * Source.Pitch + Source.Pitch * (srcy_16 shr 16) + nSLeft);
          pDst := PByte(Integer(DIB.PBits) + (DestRect.Top + nY) * DIB.Pitch + nDLeft);
          srcx_16 := 0;
          for nX := 0 to nWidth - 1 do
          begin
            PWordArray(pDst)[nX] := PWordArray(pSrc)[srcx_16 shr 16];
            Inc(srcx_16, xrIntFloat_16);
          end;
          Inc(srcy_16, yrIntFloat_16);
        end;
        Self.Draw(DestRect.Left, DestRect.Top, DestRect, DIB);

        DIB.Free;

      end
      else
      begin

        for nY := 0 to nHeight - 1 do
        begin
          pSrc := PByte(Integer(Source.PBits) + SrcRect.Top * Source.Pitch + Source.Pitch * (srcy_16 shr 16) + nSLeft);
          pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nDLeft);
          srcx_16 := 0;
          for nX := 0 to nWidth - 1 do
          begin
            PWordArray(pDst)[nX] := PWordArray(pSrc)[srcx_16 shr 16];
            Inc(srcx_16, xrIntFloat_16);
          end;
          Inc(srcy_16, yrIntFloat_16);
        end;
      end;
    end;
  end;
end;

procedure TTexture.StretchDraw(const Dest: TRect; Source: TTexture; TRANSPARENT: Boolean);
var
  DIB: TTexture;
  DestRect, SrcRect: TRect;
  pSrc, pDst: PByte;
  SrcP, DstP: PWord;
  nWidth: Integer;
  nHeight: Integer;
  nX, nY: Integer;
  nLeft: Integer;
  xrIntFloat_16: Integer;
  yrIntFloat_16: Integer;
  srcx_16: Integer;
  srcy_16: Integer;
begin
  if Source <> nil then
  begin
    if (Source.Width = (Dest.Right - Dest.Left)) and (Source.Height = (Dest.Bottom - Dest.Top)) then
    begin
      Self.Draw(Dest.Left, Dest.Top, Source, TRANSPARENT);
    end
    else
    begin
      DestRect := Dest;
      SrcRect := Source.ClientRect;
      if ClipRect(DestRect, ClientRect) then
      begin
        nWidth := DestRect.Right - DestRect.Left;
        nHeight := DestRect.Bottom - DestRect.Top;
        if TRANSPARENT then
        begin
          DIB := TTexture.Create;
          DIB.SetSize(Width, Height);

          srcy_16 := 0;
          xrIntFloat_16 := (Source.Width shl 16) div nWidth + 1;
          yrIntFloat_16 := (Source.Height shl 16) div nHeight + 1;

          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + Source.Pitch * (srcy_16 shr 16));
            pDst := PByte(Integer(DIB.PBits) + nY * DIB.Pitch);
            srcx_16 := 0;
            for nX := 0 to nWidth - 1 do
            begin
              PWordArray(pDst)[nX] := PWordArray(pSrc)[srcx_16 shr 16];
              Inc(srcx_16, xrIntFloat_16);
            end;
            Inc(srcy_16, yrIntFloat_16);
          end;
          Self.Draw(DestRect.Left, DestRect.Top, DestRect, DIB);
          DIB.Free;
        end
        else
        begin
          nLeft := DestRect.Left * 2;
          srcy_16 := 0;

          xrIntFloat_16 := (Source.Width shl 16) div nWidth + 1;
          yrIntFloat_16 := (Source.Height shl 16) div nHeight + 1;

          for nY := 0 to nHeight - 1 do
          begin
            pSrc := PByte(Integer(Source.PBits) + Source.Pitch * (srcy_16 shr 16));
            pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nLeft);
            srcx_16 := 0;
            for nX := 0 to nWidth - 1 do
            begin
              PWordArray(pDst)[nX] := PWordArray(pSrc)[srcx_16 shr 16];
              Inc(srcx_16, xrIntFloat_16);
            end;
            Inc(srcy_16, yrIntFloat_16);
          end;
        end;
      end;
    end;
  end;
end;

procedure TTexture.Filter(const Rect: TRect; DevColor: TColor);
begin

end;

procedure TTexture.Fill(DevColor: TColor);
var
  pDst: PByte;
  nX, nY, k: Integer;
  nWidth: Integer;
  nHeight: Integer;
  maskkey: Int64;
  wColor: Word;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  pDst := PByte(Integer(PBits));
  nWidth := Width;
  nHeight := Height;
  wColor := RGB16(DevColor);
  maskkey := Bit16To64(wColor);

  k := nWidth mod 4;

  if IsSSE then
  begin
    nSSEM := nWidth mod 8;
    nSSEW := nWidth div 8;
  end
  else
  begin
    nSSEM := 0;
    nSSEW := 0;
  end;

  if nSSEW > 0 then
  begin
    nMMXM := nSSEM mod 4;
    nMMXW := nSSEM div 4;
  end
  else
  begin
    nMMXM := nWidth mod 4;
    nMMXW := nWidth div 4;
  end;

  for nY := 0 to nHeight - 1 do
  begin
    pDst := PByte(Integer(PBits) + nY * Pitch);
    k := nWidth;

    if IsSSE then
    begin
      for nX := 0 to nSSEW - 1 do
      begin
        asm
        mov     edx, pDst		// edx = 目的指针
        movlps  xmm0, maskkey
        movhps  xmm0, maskkey
        movdqu  [edx], xmm0		// 直接写入目的地址
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pDst], edx
        end;
      end;
    end;

    for nX := 0 to nMMXW - 1 do
    begin
      asm
        mov     edx, pDst		// edx = 目的指针
        movq    mm0, maskkey		// 从源地址取4象素数据
        movq    [edx], mm0		// 直接写入目的地址
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pDst], edx
      end;
    end;

    asm
        emms
    end;

    for nX := 0 to k - 1 do
    begin //剩余处理
      PWord(pDst)^ := wColor;
      Inc(pDst, 2);
    end;
  end;
end;

procedure TTexture.FillRect(const Rect: TRect; DevColor: TColor);
var
  DestRect: TRect;
  pDst: PByte;
  nX, nY, k: Integer;
  nWidth: Integer;
  nHeight: Integer;
  nLeft: Integer;
  maskkey: Int64;
  wColor: Word;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  DestRect := Rect;
  if ClipRect(DestRect, ClientRect) then
  begin
    pDst := PByte(Integer(PBits) + Pitch * DestRect.Top + DestRect.Left * 2);
    nWidth := DestRect.Right - DestRect.Left;
    nHeight := DestRect.Bottom - DestRect.Top;
    wColor := RGB16(DevColor);
    maskkey := Bit16To64(wColor);
    nLeft := DestRect.Left * 2;
    k := nWidth mod 4;

    if IsSSE then
    begin
      nSSEM := nWidth mod 8;
      nSSEW := nWidth div 8;
    end
    else
    begin
      nSSEM := 0;
      nSSEW := 0;
    end;

    if nSSEW > 0 then
    begin
      nMMXM := nSSEM mod 4;
      nMMXW := nSSEM div 4;
    end
    else
    begin
      nMMXM := nWidth mod 4;
      nMMXW := nWidth div 4;
    end;

    for nY := 0 to nHeight - 1 do
    begin
      pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nLeft);
      k := nWidth;

      if IsSSE then
      begin
        for nX := 0 to nSSEW - 1 do
        begin
          asm
        mov     edx, pDst		// edx = 目的指针
        movlps  xmm0, maskkey
        movhps  xmm0, maskkey
        movdqu  [edx], xmm0		// 直接写入目的地址
        add     edx, 16
        sub     k, 8
        mov     integer ptr[pDst], edx
          end;
        end;
      end;

      for nX := 0 to nMMXW - 1 do
      begin
        asm
        mov     edx, pDst		// edx = 目的指针
        movq    mm0, maskkey		// 从源地址取4象素数据
        movq    [edx], mm0		// 直接写入目的地址
        add     edx, 8
        sub     k, 4
        mov     integer ptr[pDst], edx
        end;
      end;

      asm
        emms
      end;

      for nX := 0 to k - 1 do
      begin //剩余处理
        PWord(pDst)^ := wColor;
        Inc(pDst, 2);
      end;
    end;
  end;
end;

procedure TTexture.FillRectAlpha(const Rect: TRect; Color: TColor; Alpha: Integer);
var
  DestRect: TRect;
  nX, nY: Integer;
  pSrc, pDst: PByte;
  nWidth: Integer;
  nHeight: Integer;
  nLeft: Integer;
  nCol64: Int64;
  nAlpha64: Int64;
  wColor: Word;
  j, k, L: Integer;
  r, G, b, dr, dg, db: byte;
  nMMXM: Integer;
  nSSEM: Integer;
  nMMXW: Integer;
  nSSEW: Integer;
begin
  DestRect := Rect;
  if ClipRect(DestRect, ClientRect) then
  begin
    if (Alpha < 0) or (Alpha > 256) then
    begin
      FillRect(Rect, Color);
    end
    else
    begin
      wColor := RGB16(Color);
      nCol64 := Bit16To64(wColor);
      nAlpha64 := Bit16To64(Alpha shr 3);
      nWidth := DestRect.Right - DestRect.Left;
      nHeight := DestRect.Bottom - DestRect.Top;
      pSrc := PByte(@nCol64);
      k := nWidth mod 4;
      nLeft := DestRect.Left * 2;

      if IsSSE then
      begin
        nSSEM := nWidth mod 8;
        nSSEW := nWidth div 8;
      end
      else
      begin
        nSSEM := 0;
        nSSEW := 0;
      end;

      if nSSEW > 0 then
      begin
        nMMXM := nSSEM mod 4;
        nMMXW := nSSEM div 4;
      end
      else
      begin
        nMMXM := nWidth mod 4;
        nMMXW := nWidth div 4;
      end;

      for nY := 0 to nHeight - 1 do
      begin
        pDst := PByte(Integer(PBits) + (DestRect.Top + nY) * Pitch + nLeft);
        k := nWidth;

        if IsSSE then
        begin
          for nX := 0 to nSSEW - 1 do
          begin
            asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movlps  xmm7, nAlpha64
        movhps  xmm7, nAlpha64
        movlps  xmm0, nCol64
        movhps  xmm0, nCol64
        movdqu  xmm3, [edx]
               {$include SSE.inc}
        movdqu  [edx], xmm0
        add     edx, 16
        sub     k, 8
        mov     Integer ptr[pDst], edx
            end;
          end;
        end;

        for nX := 0 to nMMXW - 1 do
        begin
          asm
        mov     edx, pDst		// edi = 目的指针
        mov     ecx, pSrc		// esi = 源指针
        movq    mm7, nAlpha64		// 透明度
        movq    mm3, [edx]
        movq    mm0, [ecx]
             {$INCLUDE MMX.inc}
        movq    [edx], mm0
        add     edx, 8
        sub     k, 4
        mov     Integer ptr[pDst], edx
          end;
        end;

        asm
        emms
        end;

        for nX := 0 to k - 1 do
        begin //剩余处理
          r := wColor and $F800 shr 8;
          G := wColor and $07E0 shr 3;
          b := wColor and $001F shl 3;

          dr := PWord(pDst)^ and $F800 shr 8;
          dg := PWord(pDst)^ and $07E0 shr 3;
          db := PWord(pDst)^ and $001F shl 3;

          r := (r * (Alpha) + dr * (256 - Alpha)) shr 8;
          G := (G * (Alpha) + dg * (256 - Alpha)) shr 8;
          b := (b * (Alpha) + db * (256 - Alpha)) shr 8;

          PWord(pDst)^ := (r shl 8 and $F800) or (G shl 3 and $07E0) or (b shr 3 and $001F);

          Inc(pDst, 2);
        end;
      end;
    end;
  end;
end;

procedure TTexture.FrameRect(const Rect: TRect; DevColor: TColor);
var
  DestRect: TRect;
  DRect: TRect;
begin
  DestRect := Rect;
  if ClipRect(DestRect, ClientRect) then
  begin
    DRect := DestRect;
    DRect.Bottom := DRect.Top + 1;
    FillRect(DRect, DevColor);

    DRect := DestRect;
    DRect.Top := DRect.Bottom - 1;
    FillRect(DRect, DevColor);

    DRect := DestRect;
    DRect.Right := DRect.Left + 1;
    FillRect(DRect, DevColor);

    DRect := DestRect;
    DRect.Left := DRect.Right - 1;
    FillRect(DRect, DevColor);
  end;
end;

procedure TTexture.Line(X1, Y1, X2, Y2: Integer; DevColor: TColor);
var
  d, ax, ay, sx, sy, dx, dy: Integer;
  C: Word;
begin
  C := RGB16(DevColor);
  dx := X2 - X1;
  ax := Abs(dx) shl 1;
  if dx < 0 then
    sx := -1
  else
    sx := 1;
  dy := Y2 - Y1;
  ay := Abs(dy) shl 1;
  if dy < 0 then
    sy := -1
  else
    sy := 1;
  Pixels16[X1, Y1] := C;
  if ax > ay then
  begin
    d := ay - (ax shr 1);
    while X1 <> X2 do
    begin
      if d > -1 then
      begin
        Inc(Y1, sy);
        Dec(d, ax);
      end;
      Inc(X1, sx);
      Inc(d, ay);
      Pixels16[X1, Y1] := C;
    end;
  end
  else
  begin
    d := ax - (ay shr 1);
    while Y1 <> Y2 do
    begin
      if d >= 0 then
      begin
        Inc(X1, sx);
        Dec(d, ay);
      end;
      Inc(Y1, sy);
      Inc(d, ax);
      Pixels16[X1, Y1] := C;
    end;
  end;
end;

function TTexture.TextWidth(const Text: string): Integer;
begin
  Result := ImageFont.TextWidth(Text);
end;

function TTexture.TextHeight(const Text: string): Integer;
begin
  Result := ImageFont.TextHeight(Text);
end;

procedure TTexture.TextOut(X, Y: Integer; const Text: string; FColor: TColor; Bcolor: TColor);
begin
  ImageFont.Draw(Self, X, Y, Text, FColor, Bcolor);
end;

procedure TTexture.TextRect(Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor; Bcolor: TColor);
begin
  ImageFont.DrawRect(Self, Rect, X, Y, Text, FColor, Bcolor);
end;

procedure TTexture.BoldTextOut(X, Y: Integer; const Text: string; FColor: TColor; Bcolor: TColor);
begin
  ImageFont.BoldDraw(Self, X, Y, Text, FColor, Bcolor);
end;

procedure TTexture.BoldTextRect(Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor; Bcolor: TColor);
begin
  ImageFont.BoldDrawRect(Self, Rect, X, Y, Text, FColor, Bcolor);
end;

procedure TTexture.Noise(Color: TColor);
var
  pDst: PByte;
  wColor: Word;
  wSrcColor: Word;
  C1, C2, C3, C4, C5: PWord;
  I, Amount, nCount, X, Y: Integer;
begin
  nCount := 0;
  Amount := Width * Height div 3;
  wColor := RGB16(Color);
  wSrcColor := PWord(Integer(FPBits))^;
  while nCount < Amount do
  begin
    Y := Random(Height - 1);
    X := Random(Width - 1);
    C1 := PWord(Integer(FPBits) + Y * Pitch + X * 2);
    if (C1^ = wSrcColor) then
    begin
      C1^ := wColor;
    end;
    Inc(nCount);
  end;
end;

procedure TTexture.Side(Source, MarkColor: TColor);
begin

end;

function TTextureList.GetTexture(Index: Integer): TTexture;
begin
  Result := TTexture(List[Index]);
end;

constructor TTextureList.Create();
begin
  MainForm := nil;
  List := TList.Create;
end;

destructor TTextureList.Destroy;
begin
  while count > 0 do
    Items[count - 1].Free;

  List.Free;
  inherited Destroy;
end;

function TTextureList.GetCount: Integer;
begin
  Result := List.Count;
end;

constructor TImageFont.Create();
begin
  FreeOutTimeTick := GetTickCount;
  FreeFontTextOutTimeTick := GetTickCount;
  FontList := TList.Create;
  FontTextList := TList.Create;
end;

destructor TImageFont.Destroy;
begin
  Clear;
  FontList.Free;
  FontTextList.Free;
  inherited;
end;

procedure TImageFont.Clear;
var
  I: Integer;
  TextureFont: pTTextureFont;
  FontText: pTFontText;
begin
  for I := 0 to FontList.Count - 1 do
  begin
    TextureFont := FontList.Items[I];
    FreeMem(TextureFont.Data);
    Dispose(TextureFont);
  end;
  FontList.Clear;

  for I := 0 to FontTextList.Count - 1 do
  begin
    FontText := FontTextList.Items[I];
    FontText.Font.Free;
    Dispose(FontText);
  end;
  FontTextList.Clear;
end;

function TImageFont.GetCount: Integer;
begin
  Result := FontList.Count;
end;

procedure TImageFont.FreeOutTime;
var
  I: Integer;
  TextureFont: pTTextureFont;
  FontText: pTFontText;
begin
  if (GetTickCount - FreeOutTimeTick > 1000 * 30) then
  begin
    FreeOutTimeTick := GetTickCount;
    for I := FontList.Count - 1 downto 0 do
    begin
      TextureFont := FontList.Items[I];
      if (GetTickCount - TextureFont.Time > 1000 * 60 * 5) then
      begin
        FontList.Delete(I);
        FreeMem(TextureFont.Data);
        Dispose(TextureFont);
      end;
    end;
  end;
end;

procedure TImageFont.FreeFontTextOutTime;
var
  I: Integer;
  FontText: pTFontText;
begin
  if (GetTickCount - FreeFontTextOutTimeTick > 1000 * 30) then
  begin
    FreeFontTextOutTimeTick := GetTickCount;

    for I := FontTextList.Count - 1 downto 0 do
    begin
      FontText := FontTextList.Items[I];
      if (GetTickCount - FontText.Time > 1000 * 60 * 5) then
      begin
        FontTextList.Delete(I);
        FontText.Font.Free;
        Dispose(FontText);
      end;
    end;
  end;
end;

function TImageFont.TextWidth(const Text: string): Integer;
var
  tm: TEXTMETRIC;
  HHDC: hdc;
  tempDC: hdc;
  Point: Size;
begin
 // 创建兼容DC并选入字体          TextWidth(Text), DIB.TextHeight
  tempDC := GetDC(MainForm.Handle);
  HHDC := CreateCompatibleDC(tempDC);

  SelectObject(HHDC, MainForm.Canvas.Font.Handle);

  Windows.GetTextExtentPoint32(HHDC, PChar(Text), Length(Text), Point);
  Result := Point.cx;
  //nHeight := Point.cy;
  DeleteDC(HHDC);
  ReleaseDC(0, tempDC);
end;

function TImageFont.TextHeight(const Text: string): Integer;
var
  tm: TEXTMETRIC;
  HHDC: hdc;
  tempDC: hdc;
  Point: Size;
begin
 // 创建兼容DC并选入字体          TextWidth(Text), DIB.TextHeight
  tempDC := GetDC(MainForm.Handle);
  HHDC := CreateCompatibleDC(tempDC);

  SelectObject(HHDC, MainForm.Canvas.Font.Handle);

  Windows.GetTextExtentPoint32(HHDC, PChar(Text), Length(Text), Point);
  // Point.cx;
  Result := Point.cy;
  DeleteDC(HHDC);
  ReleaseDC(0, tempDC);
end;

function TImageFont.GetTextDIB(Text: string; FColor, Bcolor: TColor): TTexture;
var
  I: Integer;
  FontText: pTFontText;
  FontStyle: TFontStyles;
begin
  Result := nil;
  for I := 0 to FontTextList.Count - 1 do
  begin
    FontText := FontTextList.Items[I];
    if (CompareStr(FontText.Text, Text) = 0) and (CompareText(MainForm.Canvas.Font.Name, FontText.Name) = 0) and (MainForm.Canvas.Font.Size = FontText.Size) and (MainForm.Canvas.Font.Style = FontText.Style) and (FColor = FontText.FColor) and (Bcolor = FontText.BColor) then
    begin
      FontText.Time := GetTickCount;
      Result := FontText.Font;
      Exit;
    end;
  end;
  FreeFontTextOutTime;
end;

function TImageFont.GetTextData(Text: string): pTTextureFont;
var
  tm: TEXTMETRIC;
  BitmapInfo: TBitmapInfo;
  Data: Pointer;
  HHBitmap: HBitmap;
  HHDC: hdc;
  tempDC: hdc;
  Point: Size;
  nWidth, nHeight: Integer;
  I, II: Integer;
  DstP: PByte;
  RGBQuad: PRGBQuad;
  TextureFont: pTTextureFont;
  FontStyle: TFontStyles;
begin
  Result := nil;
  FontStyle := MainForm.Canvas.Font.Style;
  if fsUnderline in MainForm.Canvas.Font.Style then
  begin
    MainForm.Canvas.Font.Style := MainForm.Canvas.Font.Style - [fsUnderline];
  end;

  for I := 0 to FontList.Count - 1 do
  begin
    TextureFont := FontList.Items[I];
    if (CompareStr(TextureFont.Text, Text) = 0) and (CompareText(MainForm.Canvas.Font.Name, TextureFont.Name) = 0) and (MainForm.Canvas.Font.Size = TextureFont.Size) and (MainForm.Canvas.Font.Style = TextureFont.Style) then
    begin
      TextureFont.Time := GetTickCount;
      if fsUnderline in FontStyle then
      begin
        MainForm.Canvas.Font.Style := MainForm.Canvas.Font.Style + [fsUnderline];
      end;
      Result := TextureFont;
      Exit;
    end;
  end;

  FreeOutTime; //释放5分钟没有使用的数据

 // 创建兼容DC并选入字体


  tempDC := GetDC(MainForm.Handle);
  HHDC := CreateCompatibleDC(tempDC);

  SelectObject(HHDC, MainForm.Canvas.Font.Handle);

  Windows.GetTextExtentPoint32(HHDC, PChar(Text), Length(Text), Point);
  nWidth := Point.cx;
  nHeight := Point.cy;

  with BitmapInfo.bmiHeader do
  begin
  //位图信息头
    biSize := SizeOf(BitmapInfo.bmiHeader);
    biWidth := nWidth;
    biHeight := nHeight;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
    biSizeImage := 0;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed := 0;
    biClrImportant := 0;
  end;

  //创建字符位图
  HHBitmap := CreateDIBSection(HHDC, BitmapInfo, DIB_RGB_COLORS, Data, 0, 0);
  SelectObject(HHDC, HHBitmap); //将字符位图选入DC
  SetTextColor(HHDC, RGB(255, 255, 255)); //设文字颜色为白色
  SetBkColor(HHDC, RGB(0, 0, 0)); //设背景颜色为黑色
  Windows.TextOut(HHDC, 0, 0, PChar(Text), Length(Text));

  New(Result);
  Result.Name := MainForm.Canvas.Font.Name;
  Result.Size := MainForm.Canvas.Font.Size;
  Result.Style := MainForm.Canvas.Font.Style;

  GetMem(Result.Data, nWidth * nHeight + 4);
  Result.Text := Text;
  Result.Width := nWidth;
  Result.Height := nHeight;
  Result.Time := GetTickCount;

  for I := nHeight - 1 downto 0 do
  begin //32位转换成8位的数据
    RGBQuad := PRGBQuad(Integer(Data) + (nHeight - 1 - I) * nWidth * 4);
    DstP := PByte(Integer(Result.Data) + I * nWidth);
    for II := 0 to nWidth - 1 do
    begin
      if not (Integer(RGBQuad^) = 0) then
      begin
        PByte(DstP)^ := 255;
      end
      else
      begin
        PByte(DstP)^ := 0;
      end;
      Inc(RGBQuad);
      Inc(DstP);
    end;
  end;

  DeleteObject(HHBitmap);
  DeleteDC(HHDC);
  ReleaseDC(0, tempDC);
  FontList.Add(Result);
  if fsUnderline in FontStyle then
  begin
    MainForm.Canvas.Font.Style := MainForm.Canvas.Font.Style + [fsUnderline];
  end;
end;

//8位字符点阵数据绘制到16位数据

procedure TImageFont.DrawFont(pSrc, pDst: PByte; nPitch, nWidth, nHeight: Integer; Color: TColor);
var
  nX, nY, I, k: Integer;
  SrcP: PByte;
  DstP: PWord;
  nCol64: Int64;
  wColor: Word;
  nSSEM, nSSEW: Integer;
  nMMXM, nMMXW: Integer;
begin
  wColor := RGB16(Color);
  nCol64 := Bit16To64(wColor);

  if IsSSE then
  begin
    nSSEM := nWidth mod 8;
    nSSEW := nWidth div 8;
  end
  else
  begin
    nSSEM := 0;
    nSSEW := 0;
  end;

  if nSSEW > 0 then
  begin
    nMMXM := nSSEM mod 4;
    nMMXW := nSSEM div 4;
  end
  else
  begin
    nMMXM := nWidth mod 4;
    nMMXW := nWidth div 4;
  end;

  for nY := 0 to nHeight - 1 do
  begin
    SrcP := PByte(Integer(pSrc) + nWidth * nY);
    DstP := PWord(Integer(pDst) + nPitch * nY);
    k := nWidth;

    if IsSSE then
    begin
      for nX := 0 to nSSEW - 1 do
      begin
        asm
        mov     edx, DstP // edx = 目的指针
        mov     ecx, SrcP // ecx = 字符点阵数据指针
        movdqu  xmm0, [edx] // 目的颜色
        movq    xmm7, [ecx] // mm7 = 8位字符点阵数据
        movlps  xmm1, nCol64		// 64位颜色键
        movhps  xmm1, nCol64		// 64位颜色键
        punpcklbw xmm7, xmm7 // 8位点阵数据扩展为128位
        pand    xmm1, xmm7 // 不绘点的源颜色值清0
        psubusw xmm0, xmm7 // 待绘点的目的颜色清0
        por     xmm0, xmm1 // 相或得结果颜色
        add     ecx, 8
        movdqu  [edx], xmm0 // 写入4个象素
        add     edx, 16
        sub     k, 8
        mov     integer ptr[SrcP], ecx
        mov     integer ptr[DstP], edx
        end;
      end;
    end;

    for nX := 0 to nMMXW - 1 do
    begin
      asm
        mov     edx, DstP // edx = 目的指针
        mov     ecx, SrcP // ecx = 字符点阵数据指针
        movq    mm0, [edx] // 目的颜色
        movd    mm7, [ecx] // mm7 = 8位字符点阵数据
        movq    mm1, nCol64 // mm1 = 64位颜色值
        punpcklbw mm7, mm7 // 8位点阵数据扩展为16位
        pand    mm1, mm7 // 不绘点的源颜色值清0
        psubusw mm0, mm7 // 待绘点的目的颜色清0
        por     mm0, mm1 // 相或得结果颜色
        add     ecx, 4
        movq    [edx], mm0 // 写入4个象素
        add     edx, 8
        sub     k, 4
        mov     integer ptr[SrcP], ecx
        mov     integer ptr[DstP], edx
      end;
    end;

    asm
        emms
    end;
    for I := 0 to k - 1 do
    begin //剩余处理
      if SrcP^ <> 0 then
        DstP^ := wColor;
      Inc(SrcP);
      Inc(DstP);
    end;
  end;

end;

procedure TImageFont.DrawRect(DIB: TTexture; Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor; BColor: TColor);
var
  I: Integer;
  S: string;
  sText: WideString;
  nX, nWidth, nHeight, nPitch: Integer;
  TextureFont: pTTextureFont;
  AChar: Char;
  SourceRect, SrcRect, DestRect, ClientRect: TRect;
  pSrc: PByte;
  pDst: PByte;
  SrcP: PByte;
  DstP: PByte;
  Source: TTexture;
  FontText: pTFontText;
begin
  if Text = '' then
    Exit;
  SourceRect := Rect;
  if ClipRect(SourceRect, DIB.ClientRect) then
  begin
    if FColor = clBlack then
      FColor := $00050505;

    Source := GetTextDIB(Text, FColor, BColor);
    if Source = nil then
    begin
      nX := 0;
      sText := Text;

      Source := TTexture.Create;
      Source.SetSize(TextWidth(Text), TextHeight('0'));
      New(FontText);
      FontText.Font := Source;
      FontText.Text := Text;
      FontText.Time := GetTickCount;
      FontText.Name := MainForm.Canvas.Font.Name;
      FontText.Size := MainForm.Canvas.Font.Size;
      FontText.Style := MainForm.Canvas.Font.Style;
      FontText.FColor := FColor;
      FontText.BColor := BColor;
      FontTextList.Add(FontText);
      pDst := Source.PBits;
      nPitch := Source.Pitch;
      DestRect := Source.ClientRect;
      if BColor <> clBlack then
        Source.Fill(BColor);

      for I := 1 to Length(sText) do
      begin
        S := sText[I];
        AChar := S[1];
        if (Ord(AChar) > 32) then
        begin //可见字符
          TextureFont := GetTextData(S);
          pSrc := TextureFont.Data;
          SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);

          nWidth := SrcRect.Right - SrcRect.Left;
          nHeight := SrcRect.Bottom - SrcRect.Top;
          SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);
          DstP := PByte(Integer(pDst) + (DestRect.Left + nX) * 2);

          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FColor);
          Inc(nX, nWidth);

        end
        else
        begin
          Inc(nX, TextWidth(S));
        end;
      end;
      if fsUnderline in MainForm.Canvas.Font.Style then
      begin
        Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FColor);
      end;
    end;

    DIB.Draw(SourceRect.Left, Y, Bounds(SourceRect.Left - X, 0, SourceRect.Right - SourceRect.Left, SourceRect.Bottom - SourceRect.Top), Source);
  end;
end;

procedure TImageFont.BoldDrawRect(DIB: TTexture; Rect: TRect; X, Y: Integer; const Text: string; FColor: TColor; BColor: TColor);
//procedure TImageFont.BoldDraw(DIB: TTexture; X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = clBlack);
var
  I: Integer;
  S: string;
  sText: WideString;
  nX, nWidth, nHeight, nPitch: Integer;
  TextureFont: pTTextureFont;
  AChar: Char;
  SourceRect, SrcRect, DestRect, ClientRect: TRect;
  pSrc: PByte;
  pDst: PByte;
  SrcP: PByte;
  DstP: PByte;
  Source: TTexture;
  FontText: pTFontText;
begin
  if Text = '' then
    Exit;
  SourceRect := Rect;
  if ClipRect(SourceRect, DIB.ClientRect) then
  begin
    if FColor = clBlack then
      FColor := $00050505;

    Source := GetTextDIB(Text, FColor, BColor);
    if Source = nil then
    begin
      sText := Text;
      nX := 0;
      Source := TTexture.Create;
      Source.SetSize(TextWidth(Text) + 2, TextHeight('0') + 2);
      New(FontText);
      FontText.Font := Source;
      FontText.Text := Text;
      FontText.Time := GetTickCount;
      FontText.Name := MainForm.Canvas.Font.Name;
      FontText.Size := MainForm.Canvas.Font.Size;
      FontText.Style := MainForm.Canvas.Font.Style;
      FontText.FColor := FColor;
      FontText.BColor := BColor;
      FontTextList.Add(FontText);

      pDst := Source.PBits;
      nPitch := Source.Pitch;
      DestRect := Source.ClientRect;

      for I := 1 to Length(sText) do
      begin
        S := sText[I];
        AChar := S[1];
        if (Ord(AChar) > 32) then
        begin //可见字符
          TextureFont := GetTextData(S);
          pSrc := TextureFont.Data;
          SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);
          ClientRect := SrcRect;

          nWidth := SrcRect.Right - SrcRect.Left;
          nHeight := SrcRect.Bottom - SrcRect.Top;

          SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);

          DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX) * 2);
          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, BColor);

          DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX + 2) * 2);
          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, BColor);

          DstP := PByte(Integer(pDst) + DestRect.Top * nPitch + (DestRect.Left + nX + 1) * 2);
          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, BColor);

          DstP := PByte(Integer(pDst) + (DestRect.Top + 2) * nPitch + (DestRect.Left + nX + 1) * 2);
          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, BColor);

          DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX + 1) * 2);
          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FColor);

          Inc(nX, nWidth);

        end
        else
        begin
          Inc(nX, TextWidth(S));
        end;
      end;
      if fsUnderline in MainForm.Canvas.Font.Style then
      begin
        Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FColor);
      end;
    end;
    DIB.Draw(SourceRect.Left, Y, Bounds(SourceRect.Left - X, 0, SourceRect.Right - SourceRect.Left, SourceRect.Bottom - SourceRect.Top), Source);
    //DIB.Draw(X, Y, Source.ClientRect, Source);
  end;
end;

procedure TImageFont.Draw(DIB: TTexture; X, Y: Integer; const Text: string; FColor: TColor; BColor: TColor);
var
  I: Integer;
  S: string;
  sText: WideString;
  nX, nWidth, nHeight, nPitch: Integer;
  TextureFont: pTTextureFont;
  AChar: Char;
  SrcRect, DestRect, ClientRect: TRect;
  pSrc: PByte;
  pDst: PByte;
  SrcP: PByte;
  DstP: PByte;
  Source: TTexture;
  FontText: pTFontText;
begin
  if Text = '' then
    Exit;

  if FColor = clBlack then
    FColor := $00050505;

  Source := GetTextDIB(Text, FColor, BColor);
  if Source = nil then
  begin
    nX := 0;
    sText := Text;

    Source := TTexture.Create;
    Source.SetSize(TextWidth(Text), TextHeight('0'));
    New(FontText);
    FontText.Font := Source;
    FontText.Text := Text;
    FontText.Time := GetTickCount;
    FontText.Name := MainForm.Canvas.Font.Name;
    FontText.Size := MainForm.Canvas.Font.Size;
    FontText.Style := MainForm.Canvas.Font.Style;
    FontText.FColor := FColor;
    FontText.BColor := BColor;
    FontTextList.Add(FontText);
    pDst := Source.PBits;
    nPitch := Source.Pitch;
    DestRect := Source.ClientRect;
    if BColor <> clBlack then
      Source.Fill(BColor);

    for I := 1 to Length(sText) do
    begin
      S := sText[I];
      AChar := S[1];
      if (Ord(AChar) > 32) then
      begin //可见字符
        TextureFont := GetTextData(S);
        pSrc := TextureFont.Data;
        SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);

        nWidth := SrcRect.Right - SrcRect.Left;
        nHeight := SrcRect.Bottom - SrcRect.Top;
        SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);
        DstP := PByte(Integer(pDst) + (DestRect.Left + nX) * 2);

        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FColor);
        Inc(nX, nWidth);

      end
      else
      begin
        Inc(nX, TextWidth(S));
      end;
    end;
    if fsUnderline in MainForm.Canvas.Font.Style then
    begin
      Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FColor);
    end;
  end;

  DIB.Draw(X, Y, Source.ClientRect, Source);
end;

procedure TImageFont.BoldDraw(DIB: TTexture; X, Y: Integer; const Text: string; FColor: TColor = clWhite; Bcolor: TColor = clBlack);
var
  I: Integer;
  S: string;
  sText: WideString;
  nX, nWidth, nHeight, nPitch: Integer;
  TextureFont: pTTextureFont;
  AChar: Char;
  SrcRect, DestRect, ClientRect: TRect;
  pSrc: PByte;
  pDst: PByte;
  SrcP: PByte;
  DstP: PByte;
  Source: TTexture;
  FontText: pTFontText;
begin
  if Text = '' then
    Exit;

  if FColor = clBlack then
    FColor := $00050505;

  Source := GetTextDIB(Text, FColor, Bcolor);
  if Source = nil then
  begin
    sText := Text;
    nX := 0;
    Source := TTexture.Create;
    Source.SetSize(TextWidth(Text) + 2, TextHeight('0') + 2);
    New(FontText);
    FontText.Font := Source;
    FontText.Text := Text;
    FontText.Time := GetTickCount;
    FontText.Name := MainForm.Canvas.Font.Name;
    FontText.Size := MainForm.Canvas.Font.Size;
    FontText.Style := MainForm.Canvas.Font.Style;
    FontText.FColor := FColor;
    FontText.BColor := Bcolor;
    FontTextList.Add(FontText);

    pDst := Source.PBits;
    nPitch := Source.Pitch;
    DestRect := Source.ClientRect;

    for I := 1 to Length(sText) do
    begin
      S := sText[I];
      AChar := S[1];
      if (Ord(AChar) > 32) then
      begin //可见字符
        TextureFont := GetTextData(S);
        pSrc := TextureFont.Data;
        SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);
        ClientRect := SrcRect;

        nWidth := SrcRect.Right - SrcRect.Left;
        nHeight := SrcRect.Bottom - SrcRect.Top;

        SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);

        DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX) * 2);
        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, Bcolor);

        DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX + 2) * 2);
        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, Bcolor);

        DstP := PByte(Integer(pDst) + DestRect.Top * nPitch + (DestRect.Left + nX + 1) * 2);
        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, Bcolor);

        DstP := PByte(Integer(pDst) + (DestRect.Top + 2) * nPitch + (DestRect.Left + nX + 1) * 2);
        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, Bcolor);

        DstP := PByte(Integer(pDst) + (DestRect.Top + 1) * nPitch + (DestRect.Left + nX + 1) * 2);
        DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FColor);

        Inc(nX, nWidth);

      end
      else
      begin
        Inc(nX, TextWidth(S));
      end;
    end;
    if fsUnderline in MainForm.Canvas.Font.Style then
    begin
      Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FColor);
    end;
  end;

  DIB.Draw(X, Y, Source.ClientRect, Source);
end;

procedure TImageFont.DrawEditText(DIB: TTexture; const X, Y: Integer; const ARect, BRect, CRect: TRect; const AText, BText, CText: string; FontColor: TColor = clBlack; SelFontColor: TColor = clWhite; SelBackColor: TColor = clBlue);
var
  I: Integer;
  S: string;
  sText: WideString;
  nDrawX, nX, nWidth, nHeight, nPitch: Integer;
  TextureFont: pTTextureFont;
  AChar: Char;
  SrcRect, DestRect, ClientRect, SourceRect: TRect;
  pSrc: PByte;
  pDst: PByte;
  SrcP: PByte;
  DstP: PByte;
  Source: TTexture;
  FontText: pTFontText;
begin
  if (AText = '') and (BText = '') and (CText = '') then
    Exit;

  nDrawX := 0;
  if FontColor = clBlack then
    FontColor := $00050505;
  if SelFontColor = clBlack then
    SelFontColor := $00050505;
  if SelBackColor = clBlack then
    SelBackColor := $00050505;

  if (AText <> '') and (ARect.Right > ARect.Left) then
  begin

    Source := GetTextDIB(AText, FontColor, clBlack);
    if Source = nil then
    begin
      nX := 0;
      sText := AText;

      Source := TTexture.Create;
      Source.SetSize(TextWidth(AText), TextHeight('0'));
      New(FontText);
      FontText.Font := Source;
      FontText.Text := AText;
      FontText.Time := GetTickCount;
      FontText.Name := MainForm.Canvas.Font.Name;
      FontText.Size := MainForm.Canvas.Font.Size;
      FontText.Style := MainForm.Canvas.Font.Style;
      FontText.FColor := FontColor;
      FontText.BColor := clBlack;
      FontTextList.Add(FontText);
      pDst := Source.PBits;
      nPitch := Source.Pitch;
      DestRect := Source.ClientRect;

      for I := 1 to Length(sText) do
      begin
        S := sText[I];
        AChar := S[1];
        if (Ord(AChar) > 32) then
        begin //可见字符
          TextureFont := GetTextData(S);
          pSrc := TextureFont.Data;
          SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);

          nWidth := SrcRect.Right - SrcRect.Left;
          nHeight := SrcRect.Bottom - SrcRect.Top;
          SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);
          DstP := PByte(Integer(pDst) + (DestRect.Left + nX) * 2);

          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FontColor);
          Inc(nX, nWidth);

        end
        else
        begin
          Inc(nX, TextWidth(S));
        end;
      end;
      if fsUnderline in MainForm.Canvas.Font.Style then
      begin
        Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FontColor);
      end;
    end;

    DIB.Draw(X, Y, ARect, Source);
    nDrawX := ARect.Right - ARect.Left;
  end;

  if (BText <> '') and (BRect.Right > BRect.Left) and (X + nDrawX { + (BRect.Right - BRect.Left)}    < DIB.Width) then
  begin
    Source := GetTextDIB(BText, SelFontColor, SelBackColor);
    if Source = nil then
    begin
      nX := 0;
      sText := BText;

      Source := TTexture.Create;
      Source.SetSize(TextWidth(BText), TextHeight('0'));
      New(FontText);
      FontText.Font := Source;
      FontText.Text := BText;
      FontText.Time := GetTickCount;
      FontText.Name := MainForm.Canvas.Font.Name;
      FontText.Size := MainForm.Canvas.Font.Size;
      FontText.Style := MainForm.Canvas.Font.Style;
      FontText.FColor := SelFontColor;
      FontText.BColor := SelBackColor;
      FontTextList.Add(FontText);
      pDst := Source.PBits;
      nPitch := Source.Pitch;
      DestRect := Source.ClientRect;
      Source.Fill(SelBackColor);

      for I := 1 to Length(sText) do
      begin
        S := sText[I];
        AChar := S[1];
        if (Ord(AChar) > 32) then
        begin //可见字符
          TextureFont := GetTextData(S);
          pSrc := TextureFont.Data;
          SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);

          nWidth := SrcRect.Right - SrcRect.Left;
          nHeight := SrcRect.Bottom - SrcRect.Top;
          SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);
          DstP := PByte(Integer(pDst) + (DestRect.Left + nX) * 2);

          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, SelFontColor);
          Inc(nX, nWidth);

        end
        else
        begin
          Inc(nX, TextWidth(S));
        end;
      end;
      if fsUnderline in MainForm.Canvas.Font.Style then
      begin
        Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), SelFontColor);
      end;
    end;

    DIB.Draw(X + nDrawX, Y, BRect, Source);
    nDrawX := nDrawX + (BRect.Right - BRect.Left);
  end;

  if (CText <> '') and (CRect.Right > CRect.Left) and (X + nDrawX < DIB.Width) then
  begin
    Source := GetTextDIB(CText, FontColor, clBlack);
    if Source = nil then
    begin
      nX := 0;
      sText := CText;

      Source := TTexture.Create;
      Source.SetSize(TextWidth(CText), TextHeight('0'));
      New(FontText);
      FontText.Font := Source;
      FontText.Text := CText;
      FontText.Time := GetTickCount;
      FontText.Name := MainForm.Canvas.Font.Name;
      FontText.Size := MainForm.Canvas.Font.Size;
      FontText.Style := MainForm.Canvas.Font.Style;
      FontText.FColor := FontColor;
      FontText.BColor := clBlack;
      FontTextList.Add(FontText);
      pDst := Source.PBits;
      nPitch := Source.Pitch;
      DestRect := Source.ClientRect;

      for I := 1 to Length(sText) do
      begin
        S := sText[I];
        AChar := S[1];
        if (Ord(AChar) > 32) then
        begin //可见字符
          TextureFont := GetTextData(S);
          pSrc := TextureFont.Data;
          SrcRect := Bounds(0, 0, TextureFont.Width, TextureFont.Height);

          nWidth := SrcRect.Right - SrcRect.Left;
          nHeight := SrcRect.Bottom - SrcRect.Top;
          SrcP := PByte(Integer(pSrc) + SrcRect.Top * TextureFont.Width + SrcRect.Left);
          DstP := PByte(Integer(pDst) + (DestRect.Left + nX) * 2);

          DrawFont(SrcP, DstP, nPitch, nWidth, nHeight, FontColor);
          Inc(nX, nWidth);

        end
        else
        begin
          Inc(nX, TextWidth(S));
        end;
      end;
      if fsUnderline in MainForm.Canvas.Font.Style then
      begin
        Source.FillRect(Bounds(0, Source.Height - 1, Source.Width, Source.Height), FontColor);
      end;
    end;

    DIB.Draw(X + nDrawX, Y, CRect, Source);
  end;

end;

initialization
begin
  ImageFont := TImageFont.Create();
  ImageCanvas := TTexture.Create();
end;


finalization
begin

end;

end.