千千静音的悬浮式卡拉OK字幕,大家一定觉得不错吧,其实用Delphi,你也可以很容易的做得到。首先我们在Delphi中新建一个700*130左右的窗体,上面放置两个Image控件,Image控件的Align=alClient,使它们铺满窗口,唯一不同的是,Image1的Visuble=ture,用于前台显示字幕,Image2的Visible=false,用于后台绘制,还要用到一个Timer控件,Interval=100。
要使字幕悬浮在Windows桌面上显示,第一要求窗体是透明的,只显示字幕;第二要求字幕位于顶层,其它窗体不能覆盖它。 我们分别解决它。
(1)窗体是透明的,只显示字幕。
Delphi要实现透明窗体是非常容易的,Form的属性页里有两个参数,设TransparentColor=True 、TransparentColorValue=clWhite即可,第2个参数用clWhite是因为Image绘制字幕时使用白色底,而Image铺满窗口后,白底色会被过滤变透明,只留下字幕。
(2)顶层无标题无边框窗体。
要做到这一点,只需要加入以下代码:
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
visible:=true;
with Params do
begin
Style := WS_POPUP or WS_CLIPSIBLINGS ;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
end;
end;
好了,给出全部代码吧。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
private
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
iy:integer;
implementation
{$R *.dfm}
//实现顶层无标题无边框窗体。
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
visible:=true;
with Params do
begin
Style := WS_POPUP or WS_CLIPSIBLINGS ;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
end;
end;
//初始化设定字体大小,分别使用黑色和红色绘制字幕
procedure TForm1.FormCreate(Sender: TObject);
begin
iy:=0;
image1.Parent.DoubleBuffered :=true;
image2.Parent.DoubleBuffered :=true;
image1.Canvas.Font.Size :=50;
image2.Canvas.Font.Size :=50;
image1.Canvas.Font.Color :=clBtnText;
image2.Canvas.Font.Color :=clred;
image1.Canvas.TextOut(10,10,'我们都是中国人');
image2.Canvas.TextOut(10,10,'我们都是中国人');
timer1.Enabled :=true;
end;
//用定时器将IMAGE2的红色字幕复制到IMAGE1中,实现卡拉OK走字.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
iy:=iy+2;
if iy>image1.Width then iy:=image1.Width -1;
image1.Canvas.CopyRect(rect(0,0,iy,image1.Height -1),image2.Canvas,rect(0,0,iy,image1.Height -1));
end;
//双击字幕结束程序运行.
procedure TForm1.Image1DblClick(Sender: TObject);
begin
close;
end;
end.
要实现更漂亮的卡拉奇字幕,如文字加边加阴影什么的,在以上代码基础上发挥一下就可以了。