delphi - フォームに透明なテキストを描画する方法は？

Question

いくつかのコントロールがあるフォームに透明なテキストを描画する方法はありますか？コントロールを使用TLabelすると、フォームのコントロールの後ろに常に表示されます。

Answer 1

コントロールはウィンドウコントロールではないため、使用できませんTLabel。したがって、フォームのすべてのウィンドウ子コントロールによって非表示になります。TStaticText確かにウィンドウコントロール（コントロール）であるを使用することもできますがSTATIC、それを真に透過的にするのは少し難しいと思います。

これには、レイヤードウィンドウを使用できます。

1. 新しいVCLプロジェクトを作成し、それにウィンドウコントロールの束を追加します。

2. プロジェクトに。という名前の新しいフォームを作成しますsplash。に設定BorderStyleしbsNone、フォント名、サイズ、色を好きなように設定します（Segoe UI、42、赤など）。

3. パブリックメソッドを追加する

   procedure Tsplash.UpdateSplash(const Str: string);
   var
     R: TRect;
     P: TPoint;
     S: TPoint;
     bm: TBitmap;
     bf: TBlendFunction;
     EXSTYLE: DWORD;
     x, y: integer;
     pixel: PRGBQuad;
     TextRed,
     TextGreen,
     TextBlue: byte;
   begin
     EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
     SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or WS_EX_LAYERED);
   
     R := ClientRect;
   
     bm := TBitmap.Create;
     try
       bm.PixelFormat := pf32bit;
       bm.SetSize(ClientWidth, ClientHeight);
   
       bm.Canvas.Brush.Color := clBlack;
       bm.Canvas.FillRect(ClientRect);
   
       bm.Canvas.Font.Assign(Self.Font);
       bm.Canvas.Font.Color := clWhite;
       DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
         DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);
   
       TextRed := GetRValue(Font.Color);
       TextGreen := GetGValue(Font.Color);
       TextBlue := GetBValue(Font.Color);
   
       for y := 0 to bm.Height - 1 do
       begin
         pixel := bm.ScanLine[y];
         x := 0;
         while x < bm.Width do
         begin
           with pixel^ do
           begin
             rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;
   
             rgbBlue := TextBlue * rgbReserved div 255;
             rgbGreen := TextGreen * rgbReserved div 255;
             rgbRed := TextRed * rgbReserved div 255;
           end;
   
           inc(pixel);
           inc(x);
         end;
       end;
   
       P := Point(0, 0);
       S := Point(bm.Width, bm.Height);
       bf.BlendOp := AC_SRC_OVER;
       bf.BlendFlags := 0;
       bf.SourceConstantAlpha := 255;
       bf.AlphaFormat := AC_SRC_ALPHA;
       UpdateLayeredWindow(Handle, 0, nil, @S, bm.Canvas.Handle, @P, 0, @bf,
         ULW_ALPHA)
     finally
       bm.Free;
     end;
   end;
   

4. メインフォームにプライベートメソッドを追加します

   procedure TForm1.CreateSplash;
   var
     p: TPoint;
   begin
     splash.Visible := true;
     UpdateSplash;
   end;
   
   procedure TForm1.UpdateSplash;
   var
     p: TPoint;
   begin
     if not (Assigned(splash) and splash.Visible) then Exit;
     p := ClientToScreen(Point(0, 0));
     splash.SetBounds(p.X, p.Y, ClientWidth, ClientHeight);
     splash.UpdateSplash('Sample Text');
   end;
   

   UpdateSplashフォームを移動またはサイズ変更するたびに呼び出します。

   procedure TForm1.WMMove(var Message: TWMMove);
   begin
     UpdateSplash;
   end;
   
   procedure TForm4.FormResize(Sender: TObject);
   begin
     UpdateSplash;
   end;
   

最後に、試してみるだけでできます。

procedure TForm1.FormClick(Sender: TObject);
begin
  if splash.Visible then
    splash.Hide
  else
    CreateSplash;
end;

コンパイルされたデモEXE