Имеет ли ограничения TImage на размер изображения

[shyub]

Попробовал.

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

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, ExtDlgs;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    b: TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  b:= TBitmap.Create;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0,0, b);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  b.LoadFromFile(OpenDialog1.FileName);
  PaintBox1Paint(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  b.LoadFromFile('C:\111\16000x12000.bmp');
  PaintBox1Paint(Sender);
end;
end.

Через OpenDialog1 сразу же вылектает, через прямой путь Button2 грузится около миниту. Не вылетает, но PaintBox после загрузки становится чёрным (картинку не видно).
Скорее всего не хватает памяти (стоит Win-7 x86, ОЗУ - 4 ГГб).
А с загрузкой в Image не получилось?

[vitaly_l]

Скорее всего не хватает памяти

Когда не хватает памяти, он сообщает, т.к. проверяет, объём, до того как грузить.
В опен-диалоге при нехватке памяти, превью всё равно показывает.


.

[shyub]

Сегодня поэксперементировал с Lazpaint. Файл, который мне не удавалось загрузить, загружает (правда подтормаживает). Проект открытый и свободно скачивается с сайта FPC. Посмотрел исходный код, но не понял почему работает. Вот что-то похожее на открытие файла:

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

Image: TLazPaintImage;
....
  ShowNoPicture;
  Image.OnImageChanged.NotifyObservers;
  finalFilenameUTF8 := filenameUTF8;
  try
    format := DetectFileFormat(filenameUTF8);
    if format in[ifIco,ifGif] then
    begin
      newPicture := LoadFlatImageUTF8(FilenameUTF8, finalFilenameUTF8, '.lzp');
    end else
    begin
      StartImport;  // Совсем не понятно...
      image.LoadFromFileUTF8(filenameUTF8); // Вот здесь происходит загрузка.
      EndImport;   // Совсем не понятно...
      newPicture := nil;     // Приравнивают newPicture к нулю, а дальше проверка....
    end;
    if (newPicture <> nil) and (newPicture.Width > 0) and (newPicture.Height > 0) then
    begin
      StartImport;  // Здесь, по идее, должна картинка загружаться на экран...
      with ComputeAcceptableImageSize(newPicture.Width,newPicture.Height) do
        if (cx < newPicture.Width) or (cy < newPicture.Height) then
          BGRAReplace(newPicture, newPicture.Resample(cx,cy,rmFineResample));
      FImageActions.SetCurrentBitmap(newPicture, False);
      EndImport;
    end else newPicture.Free;
  except
    on ex: Exception do
    begin
      ToolManager.ToolOpen;
      Image.OnImageChanged.NotifyObservers;
      LazPaintInstance.ShowError(rsOpen,ex.Message);
    end;
  end;

Короче, надо детально разбираться.

[Mirage]

LazPaint, похоже, через BGRAControls работает. А выводит наверное и вовсе по частям.

[shyub]

Да, там BGRAControls, но у меня и с использованием библиотек bgrabitmap7.9.3 + bgracontrols_3_4 так же тормозит...

[shyub]

Всё-таки удалось открыть и сохранить графический файл размером более 1,5 ГГБ, правда пришлось применять стороннюю библиотеку - FreeImage!