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

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.
要实现更漂亮的卡拉奇字幕，如文字加边加阴影什么的，在以上代码基础上发挥一下就可以了。