Очень медленное отображение bmp

[happyman_fk]

Тема быстрого отображения картинок уже много раз поднималась, но у меня скорость катастрофически медленная.
И мне кажется так быть не должно.
Черно-белые bmp-картинки (pf1bit) лежат в базе Postgresql. Тип поля bytea.
Размер картинок строго 2500*3500.

Код: Выделить всё

SQLQuery1.Open;     //   ---> 31-1200 ms    (От двух до ста картинок)
...
MyBitmap.LoadFromStream(JpgStream, 1106062);     //   ---> 1200-1300 ms
BitBlt(Image1.Canvas.Handle, 0, 0, 2500, 3500, MyBitmap.Canvas.Handle, 0, 0, $00CC0020);   //   ---> 2500-2700 ms

Пробовал создать минимальный проект -- загрузка и отображение рисунка из файла.
Процедура на нажатие кнопки:

Код: Выделить всё

image1.Picture.LoadFromFile('g:\Мои документы\57804-1.bmp');

Тоже выполняется столько же долго. Где-то 4 сек.
На других компах пробовал уже скомпилированный проект запускать -- тоже долго.

[Sharfik]

2500х3500 и BMP? O_O
У выбора этого формата есть какое то разумное объяснение?

[happyman_fk]

Эти файлы -- это исходные данные.
1. Пробовал использовать zlib, но возникли проблемы с распаковкой на клиенте. Дело в том, что загружает в базу у меня скрипт, написанный мною на Питоне. И я пробовал сделать так, чтобы перед загрузкой в базу, скрипт сжимал данные. Но клиент я писал в Лазарусе и при распаковке были ошибки. Хотя пробовал распаковывать Питоном и всё норм. Пока что этот вариант я откладываю в долгий ящик, потому что пробовал загружать в базу эти файлы, конвертированные в формат PNG и прироста скорости не увидел.
2. Проводил такой эксперимент:
Сделал два одинаковых проекта в Делфи и Лазарусе, никак не связанных с БД. Просто загружают рисунок из файла.

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var
  tm:Integer;
begin
  tm := GetTickCount;
  image1.Picture.LoadFromFile('g:\Мои документы\1.bmp');
  tm := GetTickCount - tm;
  label1.Caption:=IntToStr(tm);
end;


В Делфи -- 16 мс или вообще 0.
В Лазарусе -- 1280 мс., но после этого рисунок не сразу появляется, а где-то еще 1500 мс. В итоге где-то 4 сек.

3. Пробовал добавлять вручную через инспектор объектов в image1 рисунок в Лазарусе. Дальше в свойствах image1 сделал visible:= false. Потом в процедуре нажатия кнопки: image1.visible:= true. Аналогичное проделал в программе Microsoft Visual С++ 2008, проект типа Windows Forms Application.
В программе на С++ рисунок появился почти мгновенно, в Лазарусе - 2-3 сек.

4. Пробовал в Питоне. Получилось сделать поиск рисунка из базы и отображать на форме. Тоже, кажется, что появляется мгновенно.
Вот кусок кода в Питоне:

Код: Выделить всё

image = QtGui.QImage()
image.loadFromData(data)
lbl = QtGui.QLabel(self)
lbl.setPixmap(QtGui.QPixmap(image))


5. Пробовал копать в сторону низкоуровневого доступа. Т.е. я заранее знаю все параметры bmp. Все рисунки абсолютно одинаковы по параметрам. Идея обращаться к памяти начиная с места, где идут пиксельные данные, пропуская заголовок. Промучился долго, но так и не получилось реализовать. Не хватает знаний и умений в области динамической памяти, указателей...

6. Пробовал смотреть в сторону других компонент работы с графикой http://wiki.freepascal.org/Components_and_Code_examples/ru
Пробовал установить LazRGBGraphics и PascalMagick, но не получилось довести до конца.

Проблема выбрать правильное направление поиска решения проблемы.
Потрачено где-то несколько недель времени на поиски и пока результатов нет(

[Sharfik]

Вспомнил... сталкивался с этим, когда редактор свойств свой стал делать, у него одно из свойств это картинки, и нужно было из строки взять список и отобразить их. Тоже при переключениях тормозилась перерисовка.
Но решил задачу по простому, через кеш.

Код: Выделить всё

procedure ...DrawImage(ACanvas:TCanvas; AFileName: String; ATop, ALeft, AWidth, AHeight: Integer);
var
  PosX,PosY,PosR,PosB,ScaleH,ScaleW,IndexImg:Integer;
  ScaleK:real;
  tmpJpegImage:TJpegImage;
  tmpBitmapImage1,tmpBitmapImage2:TBitmap;
begin
          PosY                           :=ATop;
          PosX                           :=ALeft;
          tmpBitmapImage2                :=GetCasheImage(AFileName);
          if not Assigned(tmpBitmapImage2) then //Если еще не загружен в кеш, то выполняем это.
          begin
            if FileExistsUTF8(AFileName) then
            begin
            tmpJpegImage                 :=TJpegImage.Create;
            tmpBitmapImage1              :=TBitmap.Create;
            tmpBitmapImage2              :=TBitmap.Create;
              try
                //Рисуем значение
                tmpJpegImage.LoadFromFile(AFileName);
                tmpBitmapImage1.Assign(tmpJpegImage);
                ScaleH                   :=tmpBitmapImage1.Height;
                ScaleW                   :=tmpBitmapImage1.Width;
                ScaleK                   :=ScaleW/ScaleH;
                tmpBitmapImage2.SetSize(Round(ScaleK*(AWidth)), AHeight);
                tmpBitmapImage2.Canvas.StretchDraw(Rect(0, 0, round(ScaleK*(AWidth)), AHeight),tmpBitmapImage1);
                IndexImg                 :=FImageCasheList.Add(AFileName);
                FImageCasheList.Objects[IndexImg]:=tmpBitmapImage2;
                ACanvas.Draw(PosX, PosY, tmpBitmapImage2);
              finally
                tmpJpegImage.free;
                tmpBitmapImage1.free;
              end;
            end;
          end
          else begin
               ACanvas.Draw(PosX, PosY, tmpBitmapImage2);
          end;


Пробовал сначала виртуально в память загрузить картинку, а потом рисовать ее в окно уже?

ну или по теме пройтись
viewtopic.php?f=5&t=6507
если ничего не поможет, переходить на рисование через OpenGl

[happyman_fk]

Через кэш немного не понял.
У меня в базе будут лежать десятки тысяч фоток. После запроса в DBGrid может оказаться список десятков, а может сотен, фоток по 1 МБ каждая. Дальше они все будут подгружаться в кеш, а потом после DBGrid1CellClick будет отображение из кеша соответствующей картинки. Так?

А еще нигде не могу найти функцию GetCasheImage.

Добавлено спустя 37 минут 46 секунд:

Пробовал сначала виртуально в память загрузить картинку, а потом рисовать ее в окно уже?

Приведу свой более полный код, но уже в другой вариации.

Код: Выделить всё

SQLQuery1.SQL.Add(str);
  SQLQuery1.Open;      //   ---> 31-1200 ms    (От двух до ста картинок)
  if CheckBox1.Checked then
      begin
             Stream := SQLQuery1.CreateBlobStream(SQLQuery1.FieldByName('original_jpg'), bmRead);
             MyBitmap.LoadFromStream(Stream, 990062);      //   ---> 1200-1300 ms
             BitBlt(Image1.Canvas.Handle, 0, 0, 2370, 3300, MyBitmap.Canvas.Handle, 0, 0, $00CC0020);     //   ---> 2500-2700 ms
        end;                 

Вместо SRCCOPY я пишу $00CC0020.

Была идея Stream сразу "вкинуть" в BitBlt после определённых преобразований.

Код: Выделить всё

var
Info: BITMAPINFO;
Buffer: Pbyte;
Begin   
             GetMem (Buffer , 990062);
             SQLQuery1.FieldByName('original_jpg').GetData(Buffer);

             Info.bmiColors[0].rgbBlue:=0;
             Info.bmiColors[0].rgbGreen:=0;
             Info.bmiColors[0].rgbRed:=0;
             Info.bmiColors[1].rgbBlue:=1;
             Info.bmiColors[1].rgbGreen:=1;
             Info.bmiColors[1].rgbRed:=111;

//  Info.bmiHeader.biSize=sizeof(Info.bmiHeader);
  Info.bmiHeader.biBitCount:=1;
  Info.bmiHeader.biWidth:=2370;
  Info.bmiHeader.biHeight:=3300;
  Info.bmiHeader.biPlanes:=1;
//  Info.bmiHeader.biSizeImage = 977625;

MyBitmap.Handle:= CreateDIBSection(0, Info, DIB_RGB_COLORS, Buffer, 0, 0);
BitBlt(Image1.Canvas.Handle, 0, 0, 2370, 3300, MyBitmap.Handle, 0, 0, $00CC0020);
end;


SQLQuery1.FieldByName('original_jpg').GetData(Buffer); - эта строка скорее всего неправильная, наверное надо
Stream := SQLQuery1.CreateBlobStream(SQLQuery1.FieldByName('original_jpg'), bmRead);
а потом используя SetPosition и write связать Stream и Buffer.