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.   

    1 将要写的内容先保存,然后在一次性的写入文件。2 可以考虑先将每一帧人图截取,保存到缓冲区中。另一个线程从缓冲区中读取坐标点的颜色。
      用空间来换速度。3 如果SWF动画很长,为了防止内存占用过大,则可以设定缓冲区达到多少张图时暂停一下SWF,等待处理完成,保存完成后在继续。
      

  2.   

    最近时间不多,留个脚印关注一下!
    大文件采用OpenFileMapping内存映射处理快些,查查资料先。
      

  3.   

    最高效的是使用异步I/O和完成端口
    http://www.pediy.com/bbshtml/bbs8/pediy8-709.htm