unit1.~pas

播放器的插件调用例程

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Winamp, Menus, StdCtrls, ExtCtrls, ComCtrls;

type
   TForm1 = class(TForm)
      PopupMenu1: TPopupMenu;
      N1: TMenuItem;
      N2: TMenuItem;
      N3: TMenuItem;
      Timer1: TTimer;
      Image1: TImage;
      procedure N1Click(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
      procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
         Y: Integer);
      procedure N3Click(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure FormShow(Sender: TObject);
   private
      { Private declarations }
      procedure readfile;
   public
      { Public declarations }
      procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
      procedure CreateParams(var Params: TCreateParams); override;
   end;

var
   Form1: TForm1;
   hDC: Integer;
   shu: integer;
   MPos: TPoint;
   hWnd_WinAmp: hWnd;
   sll: TStringList;
   bmp: TBitmap;
   bufferCanvas: TCanvas;
   ARect: TRect;
   wy: integer; //位移
   jg: integer; //间格
   dqj: integer;
   js:integer;
function winampVisGetHeader: PwinampVisHeader; cdecl; export;
function getModule(which: Integer): PwinampVisModule; cdecl;
procedure config(this_mod: PwinampVisModule); cdecl;
function init(this_mod: PwinampVisModule): Integer; cdecl;
function render(this_mod: PwinampVisModule): Integer; cdecl;
procedure quit(this_mod: PwinampVisModule); cdecl;

function GetOutPutTime(x: integer): Integer;
function strisint(str: string): boolean; //判断字符是否是整数

implementation

{$R *.DFM}

const
   hdr: TwinampVisHeader =
   (version: ver;
      description: '歌词显示插件 Ver1.0';
      getModule: getModule);

   fmod: TwinampVisModule =
   (description: '歌词显示插件';
      hwndParent: 0;
      hDllInstance: 0;
      sRate: 0;
      nCh: 0;
      latencyMs: 25;
      delayMS: 25;
      spectrumNch: 0;
      waveformNch: 2;
      Config: config;
      Init: init;
      Render: render;
      Quit: quit);

function winampVisGetHeader: PwinampVisHeader;
begin
   Result := @hdr;
end;

function getModule(which: Integer): PwinampVisModule;
begin
   if which = 0 then
      Result := @fmod
   else
      Result := nil;
end;

procedure config(this_mod: PwinampVisModule);
begin
   MessageBox(0, '小天程序制作',
      'About',
      MB_ICONINFORMATION);
end;

function init(this_mod: PwinampVisModule): Integer;
begin
   Application.CreateForm(TForm1, Form1);
   hDC := GetDC(Form1.Handle);
   Result := 0;
end;

function GetOutPutTime(x: integer): Integer;
begin
   GetOutPutTime := 0;
   if x = 0 then
      GetOutPutTime := SendMessage(hwnd_winamp, WM_USER, x, 105)
   else
      if x = 1 then
      GetOutPutTime := SendMessage(hwnd_winamp, WM_USER, x, 105);
end;

procedure TForm1.WMEraseBkgnd(var Message: TMessage);
begin
   Message.Result := 1;
end;

function render(this_mod: PwinampVisModule): Integer;
var
   cru, i, lc, clint: integer;
begin
   cru := (GetOutPutTime(0) div 1000) + wy;
   if cru < 1 then form1.readfile;
   //找出当前句
   if sll.Count > 0 then
      begin
         for i := 0 to sll.Count - 1 do
            begin
               if strtoint(copy(sll.strings[i], 1, 5)) > cru then
                  break;
            end;
         {2002-3-23代码}
         //计算位移距离
         if i > 0 then
            lc := round((cru - strtoint(copy(sll.strings[i], 1, 5))) * (35 / (strtoint(copy(sll.strings[i], 1, 5)) - strtoint(copy(sll.strings[i - 1], 1, 5)))))
         else
            lc := 5;
         //如果不是当前句就画
         if i - 1 <> dqj then
            begin
               with form1 do
                  begin
                     form1.image1.top:=0;
                     form1.image1.top:=form1.image1.top-lc;
                     bmp.Width := image1.width;
                     bmp.Height := image1.height;
                     ARect := Rect(0, 0, bmp.width, bmp.height);
                     clint := round(form1.Height / 2) - 20;
                     bmp.Canvas.Brush.Color := clblack;
                     bmp.Canvas.FillRect(ARect);
                     bmp.Canvas.Font.size := 16;
                     bmp.Canvas.Font.name := '楷体_GB2312';
                     bmp.Canvas.Font.Color := clGreen;
                     if i > 3 then
                        bmp.Canvas.TextOut(0, clint - jg * 3 - lc, copy(sll.strings[i - 4], 6, length(sll.strings[i - 4]) - 5));
                     if i > 2 then
                        bmp.Canvas.TextOut(0, clint - jg * 2 - lc, copy(sll.strings[i - 3], 6, length(sll.strings[i - 3]) - 5));
                     if i > 1 then
                        bmp.Canvas.TextOut(0, clint - jg - lc, copy(sll.strings[i - 2], 6, length(sll.strings[i - 2]) - 5));
                     if i > 0 then //当前句
                        begin
                           bmp.Canvas.Font.Color := clLime;
                           bmp.Canvas.TextOut(0, clint - lc, copy(sll.strings[i - 1], 6, length(sll.strings[i - 1]) - 5));
                        end;
                     bmp.Canvas.Font.Color := clGreen;
                     bmp.Canvas.TextOut(0, clint + jg - lc, copy(sll.strings[i], 6, length(sll.strings[i]) - 5));
                     if i + 1 < sll.Count then
                        bmp.Canvas.TextOut(0, clint + jg * 2 - lc, copy(sll.strings[i + 1], 6, length(sll.strings[i + 1]) - 5));
                     //显示到image
                     image1.Canvas.CopyRect(ARect, Bmp.Canvas, ARect);
                  end;
            end
         else
            begin
               dqj:=i-1;
               form1.image1.top:=form1.image1.top-lc;
            end;
      end;
   {//测试
   form1.image1.Canvas.Font.Color := clwhite;
   js:=js+1;
   form1.image1.Canvas.TextOut(0,0,inttostr(js)); }
   Result := 0; //必须
end;

procedure quit(this_mod: PwinampVisModule);
begin
form1.Close;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   MessageBox(0, '小天程序制作',
      'About',
      MB_ICONINFORMATION);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   //ShowWindow(form1.Handle, SW_HIDE); //在状态栏隐藏
   //SetWindowLong(form1.Handle,GWL_EXSTYLE and gwl_style, ws_ex_clientedge and  not ws_caption);
   //SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
   clientheight := height;
   //取得winamp的句柄
   hwnd_winamp := FindWindow('Winamp v1.x', nil);
   sll := TStringList.Create;
   bmp := TBitmap.Create;
   bmp.Width := image1.Width;
   bmp.Height := image1.Height + round(screen.Height / 2);
   ARect := Rect(0, 0, bmp.width, bmp.height);
   bmp.Canvas.Brush.Color := clblack;
   bmp.Canvas.FillRect(ARect);
   wy := 0;
   jg := 30;
   image1.Height := screen.Height * 2;
   image1.Width := screen.Width * 2;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   MPos.X := X;
   MPos.Y := Y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
   if ssLeft in Shift then
      begin
         Form1.Left := Form1.Left - (MPos.X - X);
         Form1.Top := Form1.Top - (MPos.Y - Y);
      end;
end;

function strisint(str: string): boolean; //判断字符是否是整数
begin
   try
      strtoint(str);
      Result := true;
   except
      Result := false;
   end;
end;

procedure TForm1.readfile;
var
   filename: string;
   szText: array[0..254] of char;
   ch: PChar;
   sl, tmp: TStringList;
   i, y, x: integer;
   sj, temp: string;
begin
   wy := 0;
   dqj := 0;
   //得到播放歌曲名
   Ch := Pointer(SendMessage(hwnd_winamp, WM_USER, SendMessage(hwnd_winamp, WM_USER, 0, 125), 211));
   filename := copy(Strpas(ch), 1, length(Strpas(ch)) - 4) + '.lrc';
   sll.Clear;
   if GetWindowText(hwnd_winamp, @szText, 255) > 0 then
      begin
         sll.Add('99999' + Strpas(@szText));
      end;
   if FileExists(filename) then
      begin
         sl := TStringList.Create;
         try
            sl.LoadFromFile(filename);
            //转换并排序
            for i := 0 to sl.Count - 1 do
               begin
                  y := pos('[', sl.strings[i]);
                  temp := sl.strings[i];
                  tmp := TStringList.Create;
                  while y <> 0 do
                     begin
                        sj := copy(temp, pos('[', temp) + 1, pos(']', temp) - pos('[', temp) - 1);
                        temp := copy(temp, pos(']', temp) + 1, length(temp) - pos(']', temp));
                        if strisint(copy(sj, 1, 2)) and strisint(copy(sj, 4, 2)) then
                           begin
                              sj := inttostr(strtoint(copy(sj, 1, 2)) * 60 + strtoint(copy(sj, 4, 2)));
                              sj := format('%5s', [sj]);
                              tmp.Add(sj);
                           end;
                        y := pos('[', temp);
                     end;
                  for x := 0 to tmp.Count - 1 do
                     sll.Add(tmp.strings[x] + temp);
                  tmp.Free;
               end;
         finally
            sl.Free;
         end;
         sll.Sort;
      end;
   {//显示到bitamp
   bmp.Width := image1.Width;
   bmp.Height := image1.Height+round(screen.Height / 2);
   ARect := Rect(0, 0, bmp.width, bmp.height);
   bmp.Canvas.Brush.Color := clblack;
   bmp.Canvas.FillRect(ARect);
   bmp.Canvas.Font.size := 16;
   bmp.Canvas.Font.name := '楷体_GB2312';
   bmp.Canvas.Font.Color := clGreen;
   for i := 0 to sll.Count - 1 do
      begin
         bmp.Canvas.TextOut(0, round(screen.Height / 2)+jg * i, copy(sll.strings[i], 6, length(sll.strings[i]) - 5));
      end;
   //显示到image
   image1.Canvas.CopyRect(ARect, Bmp.Canvas, ARect);
   //显示over      }
end;

procedure TForm1.N3Click(Sender: TObject);
begin
   if n3.Checked then
      begin
         n3.Checked := false;
         form1.FormStyle := fsNormal;
      end
   else
      begin
         n3.Checked := true;
         form1.FormStyle := fsStayOnTop;
      end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   bmp.Destroy;
   sll.Free;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; //上下键调节
   Shift: TShiftState);
begin
   if key = VK_UP then
      wy := wy - 1;
   if key = VK_down then
      wy := wy + 1;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   with Params do
      begin
         Style := (Style or WS_POPUP) xor (ws_dlgframe);
      end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   form1.readfile;
end;

end.