[AND_REY]

Скорость упала (~16Мб за 14сек.) из-за внутреннего цикла и чтения по байтно:

Код:

procedure TForm1.Button2Click(Sender: TObject);
Type
 TRGB = Record
   B,G,R: Byte;
  end;
 PRGBLine = ^TRGBLine;
 TRGBLine = Array [0..65535] of TRGB;
Var
 F: TFileStream;
 Bmp: TBitmap;
 Line: PRGBLine;
 R, j, i: Integer;
 C1, C2, C3, Y: Byte;
begin
 if OpenDialog1.Execute Then
  F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead) Else Exit;
 Bmp:= TBitmap.Create;
 Bmp.PixelFormat:= pf24bit;
 if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3)
  Else R:= (F.Size Div 3) + 1 ;
 Bmp.Width:= Round(Sqrt(R));
 Bmp.Height:= Bmp.Width;
 if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1;
 For j:= 0 To Bmp.Height - 1 Do
  begin
   Line:= Bmp.ScanLine[j];
   For i:= 0 To Bmp.Width - 1 Do
    begin
     F.Read(C1, 1); //R
     F.Read(C2, 1); //G
     F.Read(C3, 1); //B
     Y:= Round(0.299*C1 + 0.587*C1 + 0.114*C1);
     Line^[i].R:= Y;
     Line^[i].G:= Y;
     Line^[i].B:= Y;
    end;
  end;
 Image1.Canvas.Draw(0, 0, Bmp);
 Bmp.SaveToFile('c:\test.bmp');
 Bmp.Free;
 F.Free;
end;