{******************************************************************}
{ TextUtil.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 28.11.2006                                           }
{ Update    : 22.03.2007                                           }
{                                                                  }
{ Sizden iki şey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit TextUtil;

interface

uses Windows, Messages, CommCtrl, WinSock, Types, SysUtils, GdipApi, GdipObj,
  DirectDraw, StdCtrls, Graphics;

{ GdiPlusDrawText }
procedure GdiPlusDrawText(gpCanvas: TGPGraphics; const Caption: WideString;
  Left, Top: Single; const FontName: WideString; gpFontStyle: FontStyle = FontStyleRegular;
  gpAlignment: StringAlignment = StringAlignmentNear; Size: Integer = 10;
  gpColor: TGPColor = aclBlack); overload;

{ GdiPlusDrawText }
procedure GdiPlusDrawText(gpCanvas: TGPGraphics; const Caption: WideString;
  gpRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment = StringAlignmentNear;
  gpColor: TGPColor = aclBlack; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias); overload;

{ GdiPlusDrawTextEx }
procedure GdiPlusDrawTextEx(gpCanvas: TGPGraphics; const Caption: WideString;
  gpRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment = StringAlignmentNear;
  gpColor: TGPColor = aclBlack; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias); overload;

{ GdiPlusMeasureString }
procedure GdiPlusMeasureString(gpCanvas: TGPGraphics; const Caption: WideString;
  out outRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment =
  StringAlignmentNear; Shadow: Boolean = True; TextRenderingHint:
  TTextRenderingHint = TextRenderingHintAntiAlias);

{ PaintLabelTo }
procedure PaintLabelTo(Graphics: TGPGraphics; ALabel: TLabel; const WideText: WideString;
  Align: StringAlignment; Color: Cardinal; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias);

{ PaintLabelToEx }
procedure PaintLabelToEx(Graphics: TGPGraphics; ALabel: TLabel; const WideText: WideString;
  X, Y: Single; Align: StringAlignment; Color: Cardinal; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias);

{ DrawImageTo }
procedure DrawImageTo(Graphics: TGPGraphics; X, Y, W, H: Single;
  Image: TGPBitmap; Alpha: Byte = $FF);

{ DrawImageToEx }
procedure DrawImageToEx(Graphics: TGPGraphics; DestX, DestY, DestWidth, DestHeight: Single;
  SrcX, SrcY, SrcWidth, SrcHeight: Single; Image: TGPBitmap; Alpha: Byte = $FF);

{ MakeRectF }
function MakeRectF(const Rect: TRect): TGPRectF;

{ OffsetRectF }
procedure OffsetRectF(var RectF: TGPRectF; dx, dy: Single);

{ InflateRectF }
procedure InflateRectF(var RectF: TGPRectF; dx, dy: Single);

{ CopyRectF }
function CopyRectF(const Rect: TGPRectF): TGPRectF;

{ GetCodecClsId }
//function GetCodecClsId(const Format: WideString; out ClsId: TGUID): Boolean;

implementation

uses Unicode;

{ GdiPlusDrawText }
procedure GdiPlusDrawText(gpCanvas: TGPGraphics; const Caption: WideString;
  Left, Top: Single; const FontName: WideString; gpFontStyle: FontStyle = FontStyleRegular;
  gpAlignment: StringAlignment = StringAlignmentNear; Size: Integer = 10;
  gpColor: TGPColor = aclBlack); overload;
var
  gpBrush: TGPSolidBrush;
  gpFont: TGPFont;
  gpFormat: TGPStringFormat;
  gpPoint: TGPPointF;
begin
  gpBrush := TGPSolidBrush.Create( gpColor );
  try
    gpFont := TGPFont.Create(FontName, Size, gpFontStyle);
    try

      gpFormat := TGPStringFormat.Create;
      try
        gpCanvas.SetTextRenderingHint(TextRenderingHintAntiAlias);
        gpFormat.SetAlignment(gpAlignment);

        gpPoint.X := Left;
        gpPoint.Y := Top;

        gpCanvas.DrawString( WideString(Caption), Length(Caption), gpFont,
          gpPoint, gpFormat, gpBrush );

      finally
        gpFormat.Free;
      end;
    finally
      gpFont.Free;
    end;
  finally
    gpBrush.Free;
  end;
end;

{ GdiPlusDrawText }
procedure GdiPlusDrawText(gpCanvas: TGPGraphics; const Caption: WideString;
  gpRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment = StringAlignmentNear;
  gpColor: TGPColor = aclBlack; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias); overload;
var
  DC: HDC;
  gpBrush: TGPSolidBrush;
  gpFont: TGPFont;
  gpFormat: TGPStringFormat;
  R: TGPRectF;
begin
  DC := GetDC(GetDesktopWindow());
  try

    gpBrush := TGPSolidBrush.Create( gpColor );
    try
      gpFont := TGPFont.Create(DC, Font.Handle);
      try

        gpFormat := TGPStringFormat.Create;
        try
          //gpCanvas.SetTextRenderingHint(TextRenderingHintAntiAlias);
          gpCanvas.SetTextRenderingHint(TextRenderingHint);
          gpFormat.SetAlignment(gpAlignment);

          if Shadow then
          begin
            R := CopyRectF(gpRect);
            OffsetRectF(R, 1.0, 1.0);
            //gpBrush.SetColor(aclBlack);
            gpBrush.SetColor(MakeColor(GetAlpha(gpColor), 0, 0, 0));
            gpCanvas.DrawString( WideString(Caption), Length(Caption), gpFont,
              R, gpFormat, gpBrush );
            gpBrush.SetColor(gpColor);
          end;

          gpCanvas.DrawString( WideString(Caption), Length(Caption), gpFont,
            gpRect, gpFormat, gpBrush );
            
        finally
          gpFormat.Free;
        end;
      finally
        gpFont.Free;
      end;
    finally
      gpBrush.Free;
    end;
  finally
    ReleaseDC(GetDesktopWindow(), DC);
  end;

end;

{ GdiPlusDrawTextEx }
procedure GdiPlusDrawTextEx(gpCanvas: TGPGraphics; const Caption: WideString;
  gpRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment = StringAlignmentNear;
  gpColor: TGPColor = aclBlack; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias); overload;
var
  DC: HDC;
  gpBrush: TGPSolidBrush;
  gpFont: TGPFont;
  gpFormat: TGPStringFormat;
  R: TGPRectF;
begin
  DC := GetDC(GetDesktopWindow());
  try

    gpBrush := TGPSolidBrush.Create( gpColor );
    try
      gpFont := TGPFont.Create(DC, Font.Handle);
      try

        gpFormat := TGPStringFormat.Create;
        try
          gpFormat.SetAlignment(gpAlignment);
          if Shadow then
          begin
            R := CopyRectF(gpRect);
            OffsetRectF(R, 1.0, 2.0);
            gpBrush.SetColor(MakeColor(GetAlpha(gpColor), 0, 0, 0));
            gpCanvas.SetTextRenderingHint(TextRenderingHintAntiAlias);
            gpCanvas.DrawString( WideString(Caption), Length(Caption), gpFont,
              R, gpFormat, gpBrush );
            gpBrush.SetColor(gpColor);
          end;
          gpCanvas.SetTextRenderingHint(TextRenderingHint);
          gpCanvas.DrawString( WideString(Caption), Length(Caption), gpFont,
            gpRect, gpFormat, gpBrush );
            
        finally
          gpFormat.Free;
        end;
      finally
        gpFont.Free;
      end;
    finally
      gpBrush.Free;
    end;
  finally
    ReleaseDC(GetDesktopWindow(), DC);
  end;

end;

{ GdiPlusMeasureString }
procedure GdiPlusMeasureString(gpCanvas: TGPGraphics; const Caption: WideString;
  out outRect: TGPRectF; Font: TFont; gpAlignment: StringAlignment =
  StringAlignmentNear; Shadow: Boolean = True; TextRenderingHint:
  TTextRenderingHint = TextRenderingHintAntiAlias);
var
  DC: HDC;
  gpFont: TGPFont;
  gpFormat: TGPStringFormat;
  gpPoint: TGPPointF;
begin
  DC := GetDC(GetDesktopWindow());
  try

    gpFont := TGPFont.Create(DC, Font.Handle);
    try

      gpFormat := TGPStringFormat.Create;
      try
        gpPoint.X := 0.0;
        gpPoint.Y := 0.0;
        gpCanvas.SetTextRenderingHint(TextRenderingHint);
        gpFormat.SetAlignment(gpAlignment);
        gpCanvas.MeasureString( WideString(Caption), Length(Caption), gpFont,
          gpPoint, gpFormat, outRect );
      finally
        gpFormat.Free;
      end;
    finally
      gpFont.Free;
    end;

  finally
    ReleaseDC(GetDesktopWindow(), DC);
  end;

end;

{ PaintLabelTo }
procedure PaintLabelTo(Graphics: TGPGraphics; ALabel: TLabel; const WideText: WideString;
  Align: StringAlignment; Color: Cardinal; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias);
var
  BR, R: TGPRectF;
begin
  if Assigned(ALabel) and ALabel.Visible then
  begin
    if WideText <> '' then
    begin
      GdiPlusMeasureString(Graphics, WideText, BR, ALabel.Font, Align);
      if ALabel.AutoSize then
        ALabel.ClientWidth := Round(BR.Width) + 1;
      //ALabel.ClientHeight := Round(BR.Height) + 1;
      R := MakeRectF(ALabel.BoundsRect);
      OffsetRectF(R, -1.0, -1.0);
      GdiPlusDrawText(Graphics, WideText, R, ALabel.Font, Align, Color, Shadow,
        TextRenderingHint);
    end;
  end;
end;

{ PaintLabelToEx }
procedure PaintLabelToEx(Graphics: TGPGraphics; ALabel: TLabel; const WideText: WideString;
  X, Y: Single; Align: StringAlignment; Color: Cardinal; Shadow: Boolean = True;
  TextRenderingHint: TTextRenderingHint = TextRenderingHintAntiAlias);
var
  BR, R: TGPRectF;
begin
  if Assigned(ALabel) and ALabel.Visible then
  begin
    if WideText <> '' then
    begin
      GdiPlusMeasureString(Graphics, WideText, BR, ALabel.Font, Align);
      if ALabel.AutoSize then
        ALabel.ClientWidth := Round(BR.Width) + 1;
      ALabel.ClientHeight := Round(BR.Height) + 1;
      R := MakeRect(X, Y, ALabel.Width, ALabel.Height);
      //R := MakeRectF(ALabel.BoundsRect);
      OffsetRectF(R, -1.0, -1.0);
      GdiPlusDrawText(Graphics, WideText, R, ALabel.Font, Align, Color, Shadow,
        TextRenderingHint);
    end;
  end;
end;

{ DrawImageTo }
procedure DrawImageTo(Graphics: TGPGraphics; X, Y, W, H: Single;
  Image: TGPBitmap; Alpha: Byte = $FF);
const
  CMatrix: ColorMatrix = (
    (1.0, 0.0, 0.0, 0.0, 0.0),
    (0.0, 1.0, 0.0, 0.0, 0.0),
    (0.0, 0.0, 1.0, 0.0, 0.0),
    (0.0, 0.0, 0.0, 1.0, 0.0),
    (0.0, 0.0, 0.0, 0.0, 1.0)
  );
var
  Attr: TGPImageAttributes;
  Matrix: ColorMatrix;
begin

  Matrix := CMatrix;

  Matrix[3, 3] := (Alpha / 255);

  Attr := TGPImageAttributes.Create;
  try
    Graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    Attr.SetWrapMode(WrapModeTile);
    Attr.SetColorMatrix(Matrix, ColorMatrixFlagsDefault, ColorAdjustTypeBitmap);

    // for test only
    //Attr.ClearGamma;
    //Attr.SetGamma(5.8, ColorAdjustTypeBitmap);
    //Attr.SetThreshold(0.2, ColorAdjustTypeBitmap);

    Graphics.DrawImage(Image,
      MakeRect(X, Y, W, H),  // dest rect
      0, 0, Image.GetWidth, Image.GetHeight, // source rect
      UnitPixel,
      Attr);

  finally
    Attr.Free;
  end;

end;

{ DrawImageToEx }
procedure DrawImageToEx(Graphics: TGPGraphics; DestX, DestY, DestWidth, DestHeight: Single;
  SrcX, SrcY, SrcWidth, SrcHeight: Single; Image: TGPBitmap; Alpha: Byte = $FF);
const
  CMatrix: ColorMatrix = (
    (1.0, 0.0, 0.0, 0.0, 0.0),
    (0.0, 1.0, 0.0, 0.0, 0.0),
    (0.0, 0.0, 1.0, 0.0, 0.0),
    (0.0, 0.0, 0.0, 1.0, 0.0),
    (0.0, 0.0, 0.0, 0.0, 1.0)
  );
var
  Attr: TGPImageAttributes;
  Matrix: ColorMatrix;
begin

  Matrix := CMatrix;

  Matrix[3, 3] := (Alpha / 255);

  Attr := TGPImageAttributes.Create;
  try
    Graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);
    Attr.SetWrapMode(WrapModeTile);
    Attr.SetColorMatrix(Matrix, ColorMatrixFlagsDefault, ColorAdjustTypeBitmap);

    Graphics.DrawImage(Image,
      MakeRect(DestX, DestY, DestWidth, DestHeight),  // dest rect
      SrcX, SrcY, SrcWidth, SrcHeight, // source rect
      UnitPixel,
      Attr);

  finally
    Attr.Free;
  end;

end;

{ MakeRectF }
function MakeRectF(const Rect: TRect): TGPRectF;
begin
  Result.X := Rect.Left;
  Result.Y := Rect.Top;
  Result.Width := Rect.Right - Rect.Left;
  Result.Height := Rect.Bottom - Rect.Top;
end;

{ OffsetRectF }
procedure OffsetRectF(var RectF: TGPRectF; dx, dy: Single);
begin
  RectF.X := RectF.X + dx;
  RectF.Y := RectF.Y + dy;
end;

{ InflateRectF }
procedure InflateRectF(var RectF: TGPRectF; dx, dy: Single);
begin
  RectF.X := RectF.X - dx;
  RectF.Y := RectF.Y - dy;
  RectF.Width := RectF.Width + dx;
  RectF.Height := RectF.Height + dy;
end;

{ CopyRectF }
function CopyRectF(const Rect: TGPRectF): TGPRectF;
begin
  Result.X := Rect.X;
  Result.Y := Rect.Y;
  Result.Width := Rect.Width;
  Result.Height := Rect.Height;
end;
(*
{ GetCodecClsId }
function GetCodecClsId(const Format: WideString; out ClsId: TGUID): Boolean;
var
  Num, Size: UINT;
  PCodecInfo, SaveInfo: PImageCodecInfo;
  Index: Integer;
begin
  Result := False;
  if GdipGetImageEncodersSize(Num, Size) <> OK then Exit;
  PCodecInfo := AllocMem(Size);
  try
    SaveInfo := PCodecInfo;
    if GdipGetImageEncoders(Num, Size, SaveInfo) = OK then
    begin
      for Index := 0 to Num - 1 do
      begin
        if StrCompW(SaveInfo.MimeType, PWideChar(Format)) = 0 then
        begin
          ClsId := SaveInfo.Clsid;
          Result := True;
          Break;
        end;
        Inc(SaveInfo);
      end;
    end;
  finally
    FreeMem(PCodecInfo);
  end;
end;
*)
end.