求高效的多线程代码！！谢谢
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动画中，取每一帧里指定坐标点的颜色!!
由于一些动画中帧相对较多，或者每帧当中取的坐标较多，而且需要频繁的写文件，所以程序效率比较低！
因此，特求一段高效代码（或相关的解决办法）!谢谢
[解决办法]
1 将要写的内容先保存，然后在一次性的写入文件。
2 可以考虑先将每一帧人图截取，保存到缓冲区中。另一个线程从缓冲区中读取坐标点的颜色。
用空间来换速度。
3 如果SWF动画很长，为了防止内存占用过大，则可以设定缓冲区达到多少张图时暂停一下SWF，等待处理完成，保存完成后在继续。
[解决办法]
乒乓buffer
[解决办法]
最近时间不多，留个脚印关注一下！
大文件采用OpenFileMapping内存映射处理快些，查查资料先。
[解决办法]
最高效的是使用异步I/O和完成端口
http://www.pediy.com/bbshtml/bbs8/pediy8-709.htm
