Ожидание окончания отрисовки Canvas / очистка драйвера - Delphi - Ответ 4186475

procedure TBLMPart.SaveToFile( part:TPart; var startpos:int64; vpi:TViewProgressItem=nil );
  const BufSize = 500*1024*1024;
        limitBuf = BufSize - ( 256*256*3+200 );
  var mc:TMercator;
      x,y,i,k:integer;
      bmp:TBitMap;
      tilepath:string;
      tileindex:TRect;
      pic:TPicture;
      tileIsEmpty, waserr:Boolean;
      bufDWORD: array of DWORD;
      lastsize, posImageArray, posTableoffs:Int64;
      MemBuf,IndexBuf:TMemoryStream;
begin
  waserr := true;
  FPStart := startpos;
  mc.Init( TMercatorType(part.Zoom.Desc.ProjType), part.Zoom.Zoom+1 );
  tileindex := mc.GetTilesIndex( part.Bound );
 
  FHeader.Make( part );
 
  bmp := nil; pic := nil; FreeAndNIL(FPictFormat);
  MemBuf := nil; IndexBuf := nil;
 
  vpi.Start( vpi, FHeader.countHeight*FHeader.countWidth,
              'Масштаб : z'+IntToStr(FHeader.zoom)+' Часть : '+part.Name );
  try
    pic := TPicture.Create;
    FPictFormat := FHeader.GetFormatClass.Create;
    SetLength( bufDWORD, FHeader.countWidth );
    MemBuf := TMemoryStream.Create;
    MemBuf.SetSize( BufSize );
 
    IndexBuf := TMemoryStream.Create;
    IndexBuf.SetSize(FHeader.countHeight * FHeader.countWidth * sizeof(DWORD));
    IndexBuf.Position := 0;
 
 
 
    posTableoffs := FPStart + sizeof( FHeader );
    posImageArray := posTableoffs + IndexBuf.Size;
 
    FBLMObj.FFile.Position := posImageArray;
    for y:=tileindex.Top to tileindex.Bottom do
    begin
      for x:=tileindex.Left to tileindex.Right do
      begin
        i := x - tileindex.Left;
        tileIsEmpty := true;
        bufDWORD[i] := 0;
 
        bmp := nil;
        bmp := TBitMap.Create;
        try
          bmp.SetSize( 256, 256 );
          bmp.PixelFormat := pf24bit;
          bmp.Canvas.Lock;
          try
 
            bmp.Canvas.Brush.Color := clWhite;
            bmp.Canvas.Brush.Style := bsSolid;
            bmp.Canvas.FillRect( Rect( 0, 0, bmp.Width, bmp.Height ) );
            bmp.Canvas.Refresh;
          finally
            bmp.Canvas.Unlock;
          end;
          for k:=0 to Part.Layers.Count-1 do
          begin
            tilepath := part.GetTilePath( k, x, y );
            if not FileExists( tilepath ) then
              continue;
            try
              pic.LoadFromFile( tilepath );
              bmp.Canvas.Lock;
              try
                bmp.Canvas.Draw( 0,0, pic.Graphic );
                bmp.Canvas.Refresh;
              finally
                bmp.Canvas.Unlock;
              end;
              tileIsEmpty := false;
            except
            end;
          end;
 
          if vpi.Progress( vpi, 1 ) then
            exit;
 
          if not tileIsEmpty then
            FPictFormat.Assign( bmp );
        finally
          FreeAndNIL( bmp );
        end;
 
        if tileIsEmpty then
          continue;
 
        lastsize := MemBuf.Position;
        FPictFormat.SaveToStream( MemBuf );
        bufDWORD[i] := MemBuf.Position - lastsize;
 
        if( MemBuf.Size - MemBuf.Position ) < limitBuf then
        begin
          FBLMObj.FFile.WriteBuffer( Pointer(MemBuf.Memory)^, MemBuf.Position );
          MemBuf.Position := 0;
        end;
 
      end;
      IndexBuf.WriteBuffer( Pointer(bufDWORD)^, Length(bufDWORD)*sizeof(DWORD) );
    end;
 
    if MemBuf.Position > 0 then
      FBLMObj.FFile.WriteBuffer( Pointer(MemBuf.Memory)^, MemBuf.Position );
    startpos := FBLMObj.FFile.Position;
 
    FHeader.size := FBLMObj.FFile.Position - FPStart;
    FBLMObj.FFile.Position := FPStart;
    FBLMObj.FFile.WriteBuffer( FHeader, sizeof( FHeader ) );
 
    FBLMObj.FFile.Position := posTableoffs;
    FBLMObj.FFile.WriteBuffer( Pointer(IndexBuf.Memory)^, IndexBuf.Size );
    waserr := false;
  finally
    FreeAndNIL( pic );
    FreeAndNIL( FPictFormat );
    FreeAndNIL( MemBuf );
    FreeAndNIL( IndexBuf );
    if waserr then startpos := FPStart
              else Inc( FBLMObj.FHeader.layerCount );
    vpi.Finish( vpi );
  end;
end;