关于修改程序的问题！！渴求大虾们帮忙 ( 积分: 100 )

mmxmw · 2005-05-11

在下渴求各位可否把以下程序转为KOL重新编写一下，谢谢啦。

unit U_Main;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure CoolTrayIcon1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//窗口背景必须背擦除是的消息
procedure WMEraseBkgnd(var Message: TMessage);
message WM_ERASEBKGND;
end;

TDisPlay = class(TThread)
private
BitMap: TBitmap;
sll: TStringList;
procedure readfile;
function strisint(mystr: string): boolean;
//判断字符是否是整数
function GetOutPutTime(x: integer): Integer;
procedure Draw;
protected
procedure Execute;
override;
public
constructor Create;
overload;
destructor Destroy;
override;
published

end;

var
Form1: TForm1;
hWnd_WinAmp: hWnd;
DisPlay: TDisPlay;
CurrentLRCFileName: string;
CurrentSkinFileName: string;

// function, returning a Pointer to your Plugin-record to Winamp
function winampGetGeneralPurposePlugin: PWinampGeneralPurposePlugin;
cdecl;
export;
function Generalinit: Integer;
cdecl;
procedure Generalquit;
cdecl;
procedure Generalconfig;
cdecl;

const
Plugin: WinampGeneralPurposePlugin =
(Version: $10;
Description: 'Lyrics2005 - 歌词显示插件';
Init: GeneralInit;
Config: GeneralConfig;
Quit: GeneralQuit;
hWNDParent: 0;
hDLLInstance: 0;
);

implementation

{$R *.dfm}

function Generalinit: Integer;
begin

//创建并显示窗口
Application.CreateForm(TForm1, Form1);
DisPlay := TDisPlay.Create;
Result := 0;
hwnd_winamp := FindWindow('Winamp v1.x', nil);
end;

procedure Generalquit;
begin

DisPlay.Terminate;
DisPlay.Free;
Form1.Close;
Form1.Free;
end;

procedure Generalconfig;
begin

MessageBox(0, 'Lyrics2005 - 歌词显示插件' + #13 , MB_ICONINFORMATION);
end;

function winampGetGeneralPurposePlugin: PWinampGeneralPurposePlugin;
begin

result := @Plugin;
end;

procedure TForm1.WMEraseBkgnd(var Message: TMessage);
begin

Message.Result := 1;
end;

{ TDisPlay }

constructor TDisPlay.Create;
begin

inherited create(false);
//false -马上执行 true -挂起
FreeOnTerminate := false;
//false-执行完毕后马上释放 ture 执行后不释放
BitMap := TBitmap.Create;
sll := TStringList.Create;
BitMap.Canvas.Font.size := 20;
BitMap.Canvas.Font.name := '楷体_GB2312';
BitMap.Canvas.Font.Style := [fsBold];
CurrentLRCFileName := '';
end;

destructor TDisPlay.Destroy;
begin

sll.Free;
BitMap.Free;
inherited;
end;

function TDisPlay.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 TDisPlay.Draw;
begin

Form1.PaintBox1.Canvas.Lock;
//Form1.PaintBox1.Canvas.Draw(0, 0, BitMap);
BitBlt(Form1.PaintBox1.Canvas.Handle, 0, 0, BitMap.Width, BitMap.Height, BitMap.Canvas.Handle, 0, 0, SRCCopy);
Form1.PaintBox1.Canvas.Unlock;
end;

procedure TDisPlay.Execute;
var
CurrentTime, i, lc, CurrentCentHeight, CurrentCentWidth, TY, y: integer;
begin

inherited;
while not Self.Terminateddo

begin

readfile;
CurrentTime := GetOutPutTime(0);
BitMap.Canvas.Lock;
BitMap.Width := Form1.Width;
BitMap.Height := Form1.Height;
CurrentCentHeight := BitMap.Height div 2 - (BitMap.Canvas.TextHeight('s') + 10) div 2;
CurrentCentWidth := BitMap.Width div 2;
BitMap.Canvas.Brush.Color := clBlack;
BitMap.Canvas.FillRect(BitMap.Canvas.ClipRect);
//找出当前句
for i := 0 to sll.Count - 1do

begin

if strtoint(copy(sll.strings, 1, 10)) > CurrentTime then
break;
end;

if (i > 1) and (I < sll.Count) then

begin

lc := (BitMap.Canvas.TextHeight('s') + 10) * (CurrentTime - strtoint(copy(sll.strings[i - 1], 1, 10))) div (strtoint(copy(sll.strings[i - 1], 1, 10)) - strtoint(copy(sll.strings, 1, 10)));
CurrentCentHeight := lc + CurrentCentHeight;
TY := CurrentCentHeight - (i - 1) * (BitMap.Canvas.TextHeight('s') + 10);
end
else

TY := CurrentCentHeight - (BitMap.Canvas.TextHeight('s') + 10);
y := i - 1;
for i := 0 to sll.Count - 1do

begin

BitMap.Canvas.Font.Color := clGreen;
//当前句
if y = i then

BitMap.Canvas.Font.Color := clLime;
BitMap.Canvas.TextOut(CurrentCentWidth -
BitMap.Canvas.TextWidth(Copy(sll.Strings, 12, Length(sll.Strings))) div 2
, TY + i * (BitMap.Canvas.TextHeight('s') + 10), Copy(sll.Strings, 12, Length(sll.Strings)));
end;

//画边框
//BitBlt(BitMap.Canvas.Handle, 0, 0, BitMap.Width, BitMap.Height, SourceDC, 0, 0, SRCCopy);
//BitBlt(DestDC, 0, 0, RectWidth, RectHeight, SourceDC, LeftPos, TopPos, SRCCOPY);
// CurrentSkinFileName :=GetAmpSTr(hwnd_winamp, winamp_message_GETSKIN, 0);
// //取得面版文件
// BitMap.Canvas.TextOut(0,0,CurrentSkinFileName);
//这里为什么不能用 Synchronize
Draw;
BitMap.Canvas.Unlock;
Sleep(1);
end;

end;

procedure TDisPlay.readfile;
var
filename: string;
ch: PChar;
sl, tmp: TStringList;
i, y, x, offset: integer;
sj, temp: string;
begin

//得到播放歌曲名
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';
if filename <> CurrentLRCFileName then

begin

CurrentLRCFileName := filename;
sll.Clear;
sll.Add(' 0,' + ' ');
sll.Add(' 0,' + Copy(ExtractFileName(filename), 1, Length(ExtractFileName(filename)) - 4));
if FileExists(filename) then

begin

sl := TStringList.Create;
try
sl.LoadFromFile(filename);
offset := 0;
for i := 0 to sl.Count - 1do

begin

if Pos('[offset:', sl.strings) > 0 then

begin

temp := Copy(sl.strings, 9, POS(']', sl.strings) - 9);
if strisint(temp) then

begin

offset := StrToInt(temp);
end;

end;

y := pos('[', sl.strings);
temp := sl.strings;
tmp := TStringList.Create;
while y <> 0do

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 * 1000 +
strtoint(copy(sj, 4, 2)) * 1000 +
strtoint(copy(sj, 7, 2)) * 10
) - offset);
sj := format('%10s', [sj]);
tmp.Add(sj);
end;

y := pos('[', temp);
end;

for x := 0 to tmp.Count - 1do

sll.Add(tmp.strings[x] + ',' + temp);
tmp.Free;
end;

finally
sl.Free;
end;

//这里添加歌曲长度作为最后一句走的时间段
sj := IntToStr((GetOutPutTime(1) + 1) * 1000);
sj := format('%10s', [sj]);
sll.Add(sj + ',' + ' ');
sll.Sort;
end
else
//歌词文件不存在,下载歌词
begin

end;

end;

end;

function TDisPlay.strisint(mystr: string): boolean;
var
ri, code: integer;
begin

Val(mystr, ri, Code);
if code = 0 then

result := true
else

result := false;
code := ri;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

SetWindowLong(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TForm1.CoolTrayIcon1Click(Sender: TObject);
begin

if Self.Showing then

Self.Hide
else

Self.Show;
end;

end.

请大虾们把结果发给我lxmws@126.com 在下不胜感激！！！

mmxmw · 2005-05-11

在下渴求各位可否把以下程序转为KOL重新编写一下，谢谢啦。

unit U_Main;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure CoolTrayIcon1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//窗口背景必须背擦除是的消息
procedure WMEraseBkgnd(var Message: TMessage);
message WM_ERASEBKGND;
end;

TDisPlay = class(TThread)
private
BitMap: TBitmap;
sll: TStringList;
procedure readfile;
function strisint(mystr: string): boolean;
//判断字符是否是整数
function GetOutPutTime(x: integer): Integer;
procedure Draw;
protected
procedure Execute;
override;
public
constructor Create;
overload;
destructor Destroy;
override;
published

end;

var
Form1: TForm1;
hWnd_WinAmp: hWnd;
DisPlay: TDisPlay;
CurrentLRCFileName: string;
CurrentSkinFileName: string;

// function, returning a Pointer to your Plugin-record to Winamp
function winampGetGeneralPurposePlugin: PWinampGeneralPurposePlugin;
cdecl;
export;
function Generalinit: Integer;
cdecl;
procedure Generalquit;
cdecl;
procedure Generalconfig;
cdecl;

const
Plugin: WinampGeneralPurposePlugin =
(Version: $10;
Description: 'Lyrics2005 - 歌词显示插件';
Init: GeneralInit;
Config: GeneralConfig;
Quit: GeneralQuit;
hWNDParent: 0;
hDLLInstance: 0;
);

implementation

{$R *.dfm}

function Generalinit: Integer;
begin

//创建并显示窗口
Application.CreateForm(TForm1, Form1);
DisPlay := TDisPlay.Create;
Result := 0;
hwnd_winamp := FindWindow('Winamp v1.x', nil);
end;

procedure Generalquit;
begin

DisPlay.Terminate;
DisPlay.Free;
Form1.Close;
Form1.Free;
end;

procedure Generalconfig;
begin

MessageBox(0, 'Lyrics2005 - 歌词显示插件' + #13 , MB_ICONINFORMATION);
end;

function winampGetGeneralPurposePlugin: PWinampGeneralPurposePlugin;
begin

result := @Plugin;
end;

procedure TForm1.WMEraseBkgnd(var Message: TMessage);
begin

Message.Result := 1;
end;

{ TDisPlay }

constructor TDisPlay.Create;
begin

inherited create(false);
//false -马上执行 true -挂起
FreeOnTerminate := false;
//false-执行完毕后马上释放 ture 执行后不释放
BitMap := TBitmap.Create;
sll := TStringList.Create;
BitMap.Canvas.Font.size := 20;
BitMap.Canvas.Font.name := '楷体_GB2312';
BitMap.Canvas.Font.Style := [fsBold];
CurrentLRCFileName := '';
end;

destructor TDisPlay.Destroy;
begin

sll.Free;
BitMap.Free;
inherited;
end;

function TDisPlay.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 TDisPlay.Draw;
begin

Form1.PaintBox1.Canvas.Lock;
//Form1.PaintBox1.Canvas.Draw(0, 0, BitMap);
BitBlt(Form1.PaintBox1.Canvas.Handle, 0, 0, BitMap.Width, BitMap.Height, BitMap.Canvas.Handle, 0, 0, SRCCopy);
Form1.PaintBox1.Canvas.Unlock;
end;

procedure TDisPlay.Execute;
var
CurrentTime, i, lc, CurrentCentHeight, CurrentCentWidth, TY, y: integer;
begin

inherited;
while not Self.Terminateddo

begin

readfile;
CurrentTime := GetOutPutTime(0);
BitMap.Canvas.Lock;
BitMap.Width := Form1.Width;
BitMap.Height := Form1.Height;
CurrentCentHeight := BitMap.Height div 2 - (BitMap.Canvas.TextHeight('s') + 10) div 2;
CurrentCentWidth := BitMap.Width div 2;
BitMap.Canvas.Brush.Color := clBlack;
BitMap.Canvas.FillRect(BitMap.Canvas.ClipRect);
//找出当前句
for i := 0 to sll.Count - 1do

begin

if strtoint(copy(sll.strings, 1, 10)) > CurrentTime then
break;
end;

if (i > 1) and (I < sll.Count) then

begin

lc := (BitMap.Canvas.TextHeight('s') + 10) * (CurrentTime - strtoint(copy(sll.strings[i - 1], 1, 10))) div (strtoint(copy(sll.strings[i - 1], 1, 10)) - strtoint(copy(sll.strings, 1, 10)));
CurrentCentHeight := lc + CurrentCentHeight;
TY := CurrentCentHeight - (i - 1) * (BitMap.Canvas.TextHeight('s') + 10);
end
else

TY := CurrentCentHeight - (BitMap.Canvas.TextHeight('s') + 10);
y := i - 1;
for i := 0 to sll.Count - 1do

begin

BitMap.Canvas.Font.Color := clGreen;
//当前句
if y = i then

BitMap.Canvas.Font.Color := clLime;
BitMap.Canvas.TextOut(CurrentCentWidth -
BitMap.Canvas.TextWidth(Copy(sll.Strings, 12, Length(sll.Strings))) div 2
, TY + i * (BitMap.Canvas.TextHeight('s') + 10), Copy(sll.Strings, 12, Length(sll.Strings)));
end;

//画边框
//BitBlt(BitMap.Canvas.Handle, 0, 0, BitMap.Width, BitMap.Height, SourceDC, 0, 0, SRCCopy);
//BitBlt(DestDC, 0, 0, RectWidth, RectHeight, SourceDC, LeftPos, TopPos, SRCCOPY);
// CurrentSkinFileName :=GetAmpSTr(hwnd_winamp, winamp_message_GETSKIN, 0);
// //取得面版文件
// BitMap.Canvas.TextOut(0,0,CurrentSkinFileName);
//这里为什么不能用 Synchronize
Draw;
BitMap.Canvas.Unlock;
Sleep(1);
end;

end;

procedure TDisPlay.readfile;
var
filename: string;
ch: PChar;
sl, tmp: TStringList;
i, y, x, offset: integer;
sj, temp: string;
begin

//得到播放歌曲名
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';
if filename <> CurrentLRCFileName then

begin

CurrentLRCFileName := filename;
sll.Clear;
sll.Add(' 0,' + ' ');
sll.Add(' 0,' + Copy(ExtractFileName(filename), 1, Length(ExtractFileName(filename)) - 4));
if FileExists(filename) then

begin

sl := TStringList.Create;
try
sl.LoadFromFile(filename);
offset := 0;
for i := 0 to sl.Count - 1do

begin

if Pos('[offset:', sl.strings) > 0 then

begin

temp := Copy(sl.strings, 9, POS(']', sl.strings) - 9);
if strisint(temp) then

begin

offset := StrToInt(temp);
end;

end;

y := pos('[', sl.strings);
temp := sl.strings;
tmp := TStringList.Create;
while y <> 0do

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 * 1000 +
strtoint(copy(sj, 4, 2)) * 1000 +
strtoint(copy(sj, 7, 2)) * 10
) - offset);
sj := format('%10s', [sj]);
tmp.Add(sj);
end;

y := pos('[', temp);
end;

for x := 0 to tmp.Count - 1do

sll.Add(tmp.strings[x] + ',' + temp);
tmp.Free;
end;

finally
sl.Free;
end;

//这里添加歌曲长度作为最后一句走的时间段
sj := IntToStr((GetOutPutTime(1) + 1) * 1000);
sj := format('%10s', [sj]);
sll.Add(sj + ',' + ' ');
sll.Sort;
end
else
//歌词文件不存在,下载歌词
begin

end;

end;

end;

function TDisPlay.strisint(mystr: string): boolean;
var
ri, code: integer;
begin

Val(mystr, ri, Code);
if code = 0 then

result := true
else

result := false;
code := ri;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

SetWindowLong(Self.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TForm1.CoolTrayIcon1Click(Sender: TObject);
begin

if Self.Showing then

Self.Hide
else

Self.Show;
end;

end.

请大虾们把结果发给我lxmws@126.com 在下不胜感激！！！

workshop · 2005-05-12

好做啊
他不是有例子么

我现在头痛我的activex 用不了kol

mmxmw · 2005-05-12

大哥帮人帮到底，送佛送到西！帮帮我吧实在不行把这个Delphi程序修改一下也好啊谢谢你啦

关于修改程序的问题！！渴求大虾们帮忙 ( 积分: 100 )

mmxmw

Unregistered / Unconfirmed

mmxmw

Unregistered / Unconfirmed

workshop

Unregistered / Unconfirmed

mmxmw

Unregistered / Unconfirmed

Similar threads