Delphi实现悬浮的卡拉ＯＫ字幕

最新推荐文章于 2024-09-19 11:42:35 发布

weixin_30662539

最新推荐文章于 2024-09-19 11:42:35 发布

阅读量133

点赞数

原文链接：http://www.cnblogs.com/hssbsw/archive/2012/06/03/2533088.html

版权

Delphi实现悬浮的卡拉ＯＫ字幕
2010-07-15 作者:李海彬　　　阅读:441

         千千静音的悬浮式卡拉ＯＫ字幕，大家一定觉得不错吧，其实用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中，实现卡拉ＯＫ走字.
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.
要实现更漂亮的卡拉奇字幕，如文字加边加阴影什么的，在以上代码基础上发挥一下就可以了。

转载于:https://www.cnblogs.com/hssbsw/archive/2012/06/03/2533088.html