关于显示透空歌词的思路 - 回复 "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.