type
TSWFInfo = record
xMin: integer; //
xMax: integer; //
yMin: integer; //
yMax: integer; //
FrameCount: integer;
end;procedure WriteTxtInfo(sFileName, txtInfo: string);
var
m_Info: string;
FileResult: THandle;
TmpTxtFile: TextFile;
begin
try
if not FileExists(sFileName) then
begin
FileResult := FileCreate(sFileName);
FileClose(FileResult);
AssignFile(TmpTxtFile, sFileName);
ReWrite(TmpTxtFile);
CloseFile(TmpTxtFile);
end; m_Info := txtInfo + #13#10;
FileResult := FileOpen(sFileName, fmOpenReadWrite or fmShareDenyNone);
if FileResult > 0 then
begin
FileSeek(FileResult, 0, 2);
FileWrite(FileResult, m_Info[1], Length(m_Info));
FileClose(FileResult);
end;
except
on e: exception do
begin
//MessageBox(Handle, pChar('txtWriteInfo 处出错!详情' + #13#10 + E.Message), '', mb_Ok + mb_IconInformation);
Exit;
end;
end;
end;
procedure GetColor;
var
tmpFrame, tmpX, tmpY: integer;
tmpString: string;
C: Cardinal;
FilePath: string;
FrameMin, FrameMax: integer;
xMin, xMax, yMin, yMax: integer;
SWFInfo: TSWFInfo;
begin
Screen.Cursor := crHourGlass;
try
FilePath := 'd:\123.txt';
// 取得SWF文件头信息
// SWFRect...
// ...
xMin := SWFInfo.xMin; // 值范围在0~1000
xMax := SWFInfo.xMax; // 值范围在0~1000
yMin := SWFInfo.yMin; // 值范围在0~1000
yMax := SWFInfo.yMax; // 值范围在0~1000
FrameMin := 1;
FrameMax := SWFInfo.FrameCount; // 值范围在1~3500左右 for tmpFrame := FrameMin to FrameMax do
begin
frmFlash.ShockwaveFlash1.StopPlay();
frmFlash.ShockwaveFlash1.GotoFrame(tmpFrame);
frmFlash.Update; tmpString := '第 [' + IntToSTr(tmpInteger) + '] 帧';
WriteTxtInfo(FilePath, tmpString); for tmpX := xMin to xMax do
begin
tmpString := '';
for tmpY := yMin to yMax do
begin
C := GetPixel(GetDc(frmFlash.ShockwaveFlash1.Handle), tmpX, tmpY);
TmpString := TmpString + '(X: ' + IntToStr(tmpX)
+ ', Y: ' + IntToStr(tmpY) + '): $'
+ IntToHex(GetRValue(C), 2)
+ IntToHex(GetGValue(C), 2)
+ IntToHex(GetBValue(C), 2);
end;
WriteTxtInfo(FilePath, tmpString);// 将该点颜色写入到文本文件中
end;
end;
except
showmessage('');
end;
Screen.Cursor := crDefault;
end;procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
// m_Thread: TThreadFindFrame;
hGetColorThread: THandle;
ThID: dWord;
begin
try
hGetColorThread := BeginThread(nil, 0,
@GetColor, nil, 0, ThID);
if hGetColorThread = 0 then
messageBox(Handle, '线程失败,5555~~~', '', mb_Ok + mb_IconInformation)
except
on e: exception do
begin
messageBox(handle, pChar(E.Message), '', mb_Ok + mb_IconInformation);
Exit;
end;
end;
end;说明:上面代码的功能是在指定SWF动画中,取每一帧里指定坐标点的颜色!!由于一些动画中帧相对较多,或者每帧当中取的坐标较多,而且需要频繁的写文件,所以程序效率比较低!因此,特求一段高效代码(或相关的解决办法)!谢谢
TSWFInfo = record
xMin: integer; //
xMax: integer; //
yMin: integer; //
yMax: integer; //
FrameCount: integer;
end;procedure WriteTxtInfo(sFileName, txtInfo: string);
var
m_Info: string;
FileResult: THandle;
TmpTxtFile: TextFile;
begin
try
if not FileExists(sFileName) then
begin
FileResult := FileCreate(sFileName);
FileClose(FileResult);
AssignFile(TmpTxtFile, sFileName);
ReWrite(TmpTxtFile);
CloseFile(TmpTxtFile);
end; m_Info := txtInfo + #13#10;
FileResult := FileOpen(sFileName, fmOpenReadWrite or fmShareDenyNone);
if FileResult > 0 then
begin
FileSeek(FileResult, 0, 2);
FileWrite(FileResult, m_Info[1], Length(m_Info));
FileClose(FileResult);
end;
except
on e: exception do
begin
//MessageBox(Handle, pChar('txtWriteInfo 处出错!详情' + #13#10 + E.Message), '', mb_Ok + mb_IconInformation);
Exit;
end;
end;
end;
procedure GetColor;
var
tmpFrame, tmpX, tmpY: integer;
tmpString: string;
C: Cardinal;
FilePath: string;
FrameMin, FrameMax: integer;
xMin, xMax, yMin, yMax: integer;
SWFInfo: TSWFInfo;
begin
Screen.Cursor := crHourGlass;
try
FilePath := 'd:\123.txt';
// 取得SWF文件头信息
// SWFRect...
// ...
xMin := SWFInfo.xMin; // 值范围在0~1000
xMax := SWFInfo.xMax; // 值范围在0~1000
yMin := SWFInfo.yMin; // 值范围在0~1000
yMax := SWFInfo.yMax; // 值范围在0~1000
FrameMin := 1;
FrameMax := SWFInfo.FrameCount; // 值范围在1~3500左右 for tmpFrame := FrameMin to FrameMax do
begin
frmFlash.ShockwaveFlash1.StopPlay();
frmFlash.ShockwaveFlash1.GotoFrame(tmpFrame);
frmFlash.Update; tmpString := '第 [' + IntToSTr(tmpInteger) + '] 帧';
WriteTxtInfo(FilePath, tmpString); for tmpX := xMin to xMax do
begin
tmpString := '';
for tmpY := yMin to yMax do
begin
C := GetPixel(GetDc(frmFlash.ShockwaveFlash1.Handle), tmpX, tmpY);
TmpString := TmpString + '(X: ' + IntToStr(tmpX)
+ ', Y: ' + IntToStr(tmpY) + '): $'
+ IntToHex(GetRValue(C), 2)
+ IntToHex(GetGValue(C), 2)
+ IntToHex(GetBValue(C), 2);
end;
WriteTxtInfo(FilePath, tmpString);// 将该点颜色写入到文本文件中
end;
end;
except
showmessage('');
end;
Screen.Cursor := crDefault;
end;procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
// m_Thread: TThreadFindFrame;
hGetColorThread: THandle;
ThID: dWord;
begin
try
hGetColorThread := BeginThread(nil, 0,
@GetColor, nil, 0, ThID);
if hGetColorThread = 0 then
messageBox(Handle, '线程失败,5555~~~', '', mb_Ok + mb_IconInformation)
except
on e: exception do
begin
messageBox(handle, pChar(E.Message), '', mb_Ok + mb_IconInformation);
Exit;
end;
end;
end;说明:上面代码的功能是在指定SWF动画中,取每一帧里指定坐标点的颜色!!由于一些动画中帧相对较多,或者每帧当中取的坐标较多,而且需要频繁的写文件,所以程序效率比较低!因此,特求一段高效代码(或相关的解决办法)!谢谢
解决方案 »
- 如何才能强制WebBrowser组件不从缓存中读取网页而是直接下载?
- 请问关于ADOQuery的一个问题! 急!!!
- 如何在保存文件的时候给文件定义一个默认的文件名啊,如hahh.jpg??
- 时间函数怎么了?
- 帮我看一下这段代码,谢谢
- 难题:n(n>10)个叶子节点的huffman树有多少种?它们是怎样求得的?
- delphi listview 分组
- 报表的显示问题
- 在form的close事件里面写“action:=caFree”,该form占用的内存应该被释放掉,而实际上并没有?!
- 请问各位高手,有哪位知道十进制与十六进制之间怎样转换,在这里先谢谢各位拉
- 求一个查询语句
- 急!Delphi如何调用.net写的webservice XML?
用空间来换速度。3 如果SWF动画很长,为了防止内存占用过大,则可以设定缓冲区达到多少张图时暂停一下SWF,等待处理完成,保存完成后在继续。
大文件采用OpenFileMapping内存映射处理快些,查查资料先。
http://www.pediy.com/bbshtml/bbs8/pediy8-709.htm