TLabelを半透明化するには？

ラベル 2005-07-31 05:26:40 No: 16740

TLabelについての質問ですがお願いします。
TLabelを半透明で表示したいのですが可能でしょうか？
完全な透明なものは作成できましたが、
半透明は調べても見つかりませんでした。
やりたいことは、Label1の内容が確認できて、Label1の背後にある
コンポーネントも確認できるというものです。
よろしくお願いします。

anone 2005-07-31 18:28:45 No: 16741

TLabel ではできなそう

deldel 2005-08-01 18:01:44 No: 16742

TPanelはハンドル持ってますからできそうですね。

できません 2005-08-02 22:41:48 No: 16743

とはいっても、ビットマップを使用して合成して書き込むならばできますが、
それをしたいのなら結構ムズイですよ。

deldel 2005-08-02 23:16:40 No: 16744

Panel1 の上に Image1 を貼って、
Image1 の Align を alClient にし、
Panel1 の Border や Bevel を全部 None にし、
以下を実行すれば半透明のラベルのように見えます。

var
  H: HDC;
  R: TRect;
  X, Y: integer;
  C: TColor;
  bR, bG, bB: Byte;
  wR, wG, wB: Word;
begin
  Panel1.Visible := False;
  Application.ProcessMessages;

  //パネルの背景をImageに描画
  H := GetWindowDC(Handle);
  BitBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, H, Panel1.Left+4, Panel1.Top+23, SRCCOPY);

  //Imageを半透明化
  for Y := 0 to Image1.Height - 1 do begin
  for X := 0 to Image1.Width - 1 do begin
    C := Image1.Canvas.Pixels[X, Y];
    bR := GetRValue(C); wR := bR div 2 + 128; if wR > 255 then wR := 255;
    bG := GetGValue(C); wG := bG div 2 + 128; if wG > 255 then wG := 255;
    bB := GetBValue(C); wB := bB div 2 + 128; if wB > 255 then wB := 255;
    Image1.Canvas.Pixels[X, Y] := RGB(wR, wG, wB);
  end;
  end;

  //パネルのキャプションを真ん中に描画
  R.Top := 0; R.Left := 0; R.Right := Image1.Width; R.Bottom := Image1.Height;
  Image1.Canvas.Brush.Style := bsClear;
  Image1.Canvas.Font := Panel1.Font;
  DrawText(Image1.Canvas.Handle, PChar(Panel1.Caption), Length(Panel1.Caption), R, DT_CENTER or DT_SINGLELINE  or DT_VCENTER);

Panel1.Visible := True;
end;

篠田雅夫(今度SQLクライアント公開した 2005-08-03 00:57:35 No: 16745

できませんさんを具現化した例です。
フォームに貼り付けたLabel1にオーバーラップしたLabel2でお互い色を変えて
お試しあれ。
任意の背景にあわせるためにはコントロールのオーバーラップを調べないとできないですね。
コンポーネント化できたら教えてね！

procedure TForm1.Button1Click(Sender: TObject);
var
  work_bmp: TBitmap;
  x, y: integer;
  back_red, back_green, back_blue: integer;
  fore_red, fore_green, fore_blue: integer;
  back_col, fore_col, blend_col: TColor;
procedure Resolution(col: TColor; var r: integer; var g: integer; var b: integer);
begin
  b := (Col and $FF0000) div $10000;
  g := (Col and $FF00)  div $100;
  r := Col and $FF;
end;

begin
  work_bmp := TBitmap.Create;
  try
    work_bmp.Width := Label2.Width;
    work_bmp.Height := Label2.Height;
    work_bmp.Canvas.Brush.Color := Label1.Color;
    work_bmp.Canvas.FillRect(Rect(0, 0, work_bmp.Width, work_bmp.Height));
    work_bmp.Canvas.Font.Assign(Label1.Font);
    work_bmp.Canvas.TextOut(Label1.Left - Label2.Left, Label1.Top - Label2.Top, Label1.Caption);
    for y := 0 to Label2.Height do begin
      for x := 0 to Label2.Width do begin
        back_col := work_bmp.Canvas.Pixels[x, y];
        Resolution(back_col, back_red, back_green, back_blue);
        fore_col := Label2.Canvas.Pixels[x, y];
        Resolution(fore_col, fore_red, fore_green, fore_blue);

        blend_col :=  Round((back_red + fore_red) / 2) +
                      Round((back_green + fore_green) / 2) * $100 +
                      Round((back_blue + fore_blue) / 2) * $10000;
        work_bmp.Canvas.Pixels[x, y] := blend_col;

      end;
    end;
    Label2.Canvas.Lock;
    Label2.Canvas.CopyMode := cmSrcCopy;
    Label2.Canvas.CopyRect(
      Rect(0,0,Label2.Width, Label2.Height),
      work_bmp.Canvas,
      Rect(0, 0, Label2.Width, Label2.Height));
    Label2.Canvas.Unlock;
  finally
    work_bmp.Free;
  end;

end;