关于显示透空歌词的思路 - 回复 "zhaoboaidelphi" 的问题

问题来源: http://www.cnblogs.com/del/archive/2009/12/22/1629717.html#2096734

---

1、使用 TransparentColor、TransparentColorValue 给窗体指定透明色;

2、绘制非透明色的文本, 用 TLabel 呈现文本也可;

3、处理 WM_NCHITTEST 消息使窗体能够被拖动;

4、用 Esc 键退出.

---

测试代码:

---

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
  protected
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FormStyle := fsStayOnTop;
  BorderStyle := bsNone;
  TransparentColor := True;
  TransparentColorValue := Color;

  Font.Size := 72;
  Font.Name := 'Arial Black';
//  DoubleBuffered := True;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = Chr(27) then Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  str: string;
begin
  str := TimeToStr(Now);
  ClientWidth := Canvas.TextWidth(str);
  ClientHeight := Canvas.TextHeight(str);

  Canvas.Lock;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Color := clBlack;
  Canvas.TextOut(1, 1, str);
  Canvas.Font.Color := clRed;
  Canvas.TextOut(0, 0, str);
  Canvas.Brush.Style := bsSolid;
  Canvas.Unlock;
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTCAPTION;
end;

end.

---