How to add ALPHA to delphi TEXTOUT Tcanvas ?

나도 저 문제에 봉착 했다.

델파이가 아니고 C++ Builder 지만...

어쨋든 두 툴이 거의 동일하다시피 하기 때문에...

앞에서 거론한 문제를 풀기위해

첫번째로 TGraphicControl의 Text를 반투명 혹은 투명하게 처리하기 위한 방안이다.

저 답을 보고 싶었으나, "돈내고 가입"해야 보는 곳이었다.

어쨋든 결재는 했으니.. 한번 해보자 ㅡㅡ;;;

-----------------------------------------------------------------------------------------------------------

첫번째 답

-------------

You need to calculate font color before painting on canvas.

Canvas.Font.Color := BlendColors(clBtnFace, clWindowText, 50);

function BlendColors(Color1, Color2: TColor; Opacity: Byte): TColor;
var
  r, g, b: Byte;
  c1, c2: PByteArray;
begin
  Color1 := ColorToRGB(Color1);
  Color2 := ColorToRGB(Color2);
  c1 := @Color1;
  c2 := @Color2;

  r := Trunc(c1[0] + (c2[0] - c1[0]) * Opacity / 256);
  g := Trunc(c1[1] + (c2[1] - c1[1]) * Opacity / 256);
  b := Trunc(c1[2] + (c2[2] - c1[2]) * Opacity / 256);

  Result := RGB(r, g, b);
end;

-----------------------------------------------------------------------------------------------------------

두번째 답

------------------

There are several ways how to do this.. Here's one of them:

object Image1: TImage
  Left = 2
  Top = 34
  Width = 317
  Height = 269
  OnMouseDown = Image1MouseDown
 OnMouseMove = Image1MouseMove
end

object Edit1: TEdit
  Left = 32
  Top = 0
  Width = 185
  Height = 21
  TabOrder = 0
  Text = 'Some different text'
end

object Label1: TLabel
  Left = 0
  Top = 4
  Width = 21
  Height = 13
  Caption = 'Text'
end

object Edit2: TEdit
  Left = 264
  Top = 0
  Width = 57
  Height = 21
  TabOrder = 1
  Text = '127'
end

object Label2: TLabel
  Left = 232
  Top = 4
  Width = 27
  Height = 13
  Caption = 'Blend'
end

object Bevel1: TBevel
  Left = 0
  Top = 32
  Width = 321
  Height = 273
end

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
  Image1: TImage;
  Edit1: TEdit;
  Label1: TLabel;
  Edit2: TEdit;
  Label2: TLabel;
  Bevel1: TBevel;
  procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  procedure FormCreate(Sender: TObject);
  procedure TranspTxt(s : string; x, y : cardinal; BorderX, BorderY : byte; transp : byte);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Image1, Picture.Bitmap do begin
    Stretch := true;
    Width := Image1.Width;
    Height := Image1.Height;
    PixelFormat := pf24bit;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  with Image1.Canvas do
    case Button of
      mbLeft : MoveTo(x, y);
      mbRight : TranspTxt(Edit1.Text, x, y, 4, 0, StrToInt(Edit2.Text));
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then begin
    Image1.Canvas.LineTo(x, y);
  end;
end;

procedure TForm1.TranspTxt(s : string; x, y : cardinal; BorderX, BorderY : byte; transp : byte);
  // transp :
  // 0 - no transparency
  // 255 - full transparency (invisible)
type
  TLine = array [0..32767] of TRGBTriple;
  PLine = ^TLine;
var
  bmp : TBitmap;
  l1, l2 : PLine;
  w, h : word;
  n1, n2 : single;
begin
  bmp := TBitmap.Create;
    with bmp do begin
      PixelFormat := Image1.Picture.Bitmap.PixelFormat;
      with Canvas do begin
        with Font do begin // font params - name, size, style, color, charset etc
          Name := 'Courier New';
          Size := 14;
          Style := [];
          Color := $0000ff; // red
        end;

        Width := TextWidth (s) + BorderX * 2; // calculate width of text frame
        Height := TextHeight(s) + BorderY * 2; // calculate height of text frame
        Pen.Width := 3; // set border width
        Pen.Color := $000000; // color
        Brush.Color := $ffffff; // background color
        Rectangle(ClipRect); // draw frame (background & border)
        Brush.Style := bsClear;
        TextOut(BorderX, BorderY, s); // draw text
      end;

      n1 := 1 / 255 * transp;
      n2 := 1 - n1;
      for h := 0 to Height - 1 do begin // put it on Image1.Picture.Bitmap
        if y + h >= Image1.Picture.Bitmap.Height then break; // bottom of the image
        l1 := Image1.Picture.Bitmap.ScanLine[y + h];
        l2 := ScanLine[h];
        for w := 0 to Width - 1 do begin
          if x + w > Image1.Picture.Bitmap.Width then break; // right margin of the image
          l1[x + w].rgbtRed := Trunc(l1[x + w].rgbtRed * n1 + l2[w].rgbtRed * n2);
          l1[x + w].rgbtGreen := Trunc(l1[x + w].rgbtGreen * n1 + l2[w].rgbtGreen * n2);
          l1[x + w].rgbtBlue := Trunc(l1[x + w].rgbtBlue * n1 + l2[w].rgbtBlue * n2);
        end;
      end;
    end;

    bmp.Free;
    Image1.Refresh;
  end;
end.

-----------------------------------------------------------------------------------------------------------

세번째답

--------------

Create an in-memory bitmap.
Use TextOut to write your to the bitmap
Use AlphaBlend to merge the new bitmap and your destination with your required transparency (trans, 0 to 255)

***Note: AlphaBlend does not work on all systems. The application must be running under Windows 2000 or better***

eg ...

procedure TForm1.AlphaTextOut(dest : TCanvas ; x, y: integer; s: string; trans: byte);
var
  MyBMP : TBitmap;
  BlendFunction : TBlendFunction;
  ASize : TSize;
begin
  try
    MyBMP := TBitmap.create;
    GetTextExtentPoint32(MyBMP.Canvas.Handle,PCHAR(s),length(s),ASize);
    MyBMP.Width := MyBMP.Canvas.TextWidth(s);
    MyBMP.Height := MyBMP.Canvas.TextHeight(s);
    MyBMP.Canvas.TextOut(0,0,s);
  
  with BlendFunction do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    SourceConstantAlpha := trans;
    AlphaFormat := 0;
  end;


  windows.AlphaBlend(
    Dest.Handle, // handle to destination DC
    x, // x-coord of upper-left corner
    y, // y-coord of upper-left corner
    MyBMP.Width, // width of destination rectangle
    MyBMP.Height, // height of destination rectangle
    MyBMP.Canvas.Handle, // handle to source DC
    0, // x-coord of source upper-left corner
    0, // y-coord of source upper-left corner
    MyBMP.Width, // width of source rectangle
    MyBMP.Height, // height of source rectangle
    blendFunction // alpha-blending function
  );
  finally
    MyBMP.free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AlphaTextOut(image1.picture.bitmap.canvas ,0 ,0, 'A test string' ,200)
end;

--------------------------------------------------------------------

-----------------------------------------------------------------------------------------------------

선택된 답

--------

hello yarek, here is my version that is specifically for a TPanel, instead of a bitmap. . . It is called - procedure BlendTextOut
the first parameter is for the Panel you want the text to go onto, the X and Y are position, and the Text parameter is the String to be drawn on the panel, the PerCentShow is a number from 1 to 99 for the percent of transparency to show the text, I left out the zero and 100 percent, since they make no sence for a blend text. . .

type
  TPerCent = 1..99;

procedure BlendTextOut(aPanel: TPanel; X, Y: Integer; const Text: String; PerCentShow: TPerCent);
type
  PColor32 = ^TColor32;
  TColor32 = packed record
  b, g, r, a: Byte;
end;
var
  BmpText, panelBmp: TBitmap;
  DCp: HDC;
  xx, yy, ColorBk, wid: Cardinal;
  pClPanel, pClBmp: PColor32;
  AmSh, AmBk: Single;
begin
  if not Assigned(aPanel) then Exit;
  if (X > aPanel.Width-1) or (Y > aPanel.Height -1) then Exit;
  
  BmpText := TBitmap.Create;
  with BmpText, BmpText.Canvas do
  begin
    PixelFormat := pf32Bit;
    wid := ColorToRGB(aPanel.Color);
    Brush.Color := wid;
    Font.Assign(aPanel.Font);
    Width := TextWidth(Text);
    Height := TextHeight(Text);
    if (X < -Width) or (Y < -Height) then
    begin
      FreeAndNil(BmpText);
      Exit;
    end;

    Brush.Style := bsClear;
    TextOut(0, 0, Text);

    panelBmp := TBitmap.Create;
    panelBmp.PixelFormat := pf32Bit;
    panelBmp.Width := Width;
    panelBmp.Height := Height;
  end;

  DCp := GetDC(aPanel.Handle);
  BitBlt(panelBmp.Canvas.Handle,0,0, panelBmp.width, panelBmp.Height, DCp, X,Y, SRCCOPY);
  ReleaseDC(aPanel.Handle,DCp);
  ColorBk := wid;
  TColor32(ColorBk).r := TColor32(wid).b;
  TColor32(ColorBk).b := TColor32(wid).r;
  // ColorBk := ((wid and $FF) shl 16) or (wid and $FF00) or
  // ((wid and $FF0000) shr 16);

  AmSh := PerCentShow / 100;
  AmBk := 1.0 - AmSh;
  wid := Pred(BmpText.Width);
  pClPanel := panelBmp.ScanLine[panelBmp.Height - 1];
  pClBmp := BmpText.ScanLine[BmpText.Height - 1];
  
  for yy := BmpText.Height - 1 downto 0 do
  begin
    for xx := 0 to wid do
    begin
      if PDWORD(pClBmp)^ <> ColorBk then
      begin
        pClPanel.b := Round((pClBmp.b * AmSh) + (pClPanel.b * AmBk));
        pClPanel.g := Round((pClBmp.g * AmSh) + (pClPanel.g * AmBk));
        pClPanel.r := Round((pClBmp.r * AmSh) + (pClPanel.r * AmBk));
      end;

      Inc(pClPanel);
      Inc(pClBmp);
    end;
  end;

  FreeAndNil(BmpText);
  DCp := GetDC(aPanel.Handle);
  BitBlt(DCp,x,y, panelBmp.width, panelBmp.Height, panelBmp.Canvas.Handle, 0,0, SRCCOPY);
  ReleaseDC(aPanel.Handle,DCp);
  FreeAndNil(panelBmp);
end;