Ошибка при загрузке BMP

[DarkHacker]

Сообщение от min@y™

ты меня устал, я иссяк.
а что, вообще, за задача? может переформулировать её?

Та никак...есть динамическая задачка, картинка которая постоянно меняется, в "области изменения" производиться захват, очищается от шелухи, делиться на фрагменты и распознается, есть некоторые трудности в использовании нормального распознавания через вектор и т.д по этому для этой задачи используется сумма абсолютных разниц для поиска картинки "на картинке". Так как действия происходят по 3-4 раза за секунду то появляется такая трабла, как я описал.

[min@y™]

предлагаю избавиться от загрузки из файлов.
как, чем, где и когда формируются файлы, которые ты грузишь с диска?

[DarkHacker]

Сообщение от min@y™

предлагаю избавиться от загрузки из файлов.
как, чем, где и когда формируются файлы, которые ты грузишь с диска?

Мною формируются, шаблоны уже собраны и отлично работают.
ПРобовал грузить из Стрима - тоже оошибки.
Какие варианты? (

[min@y™]

Какие варианты?

не знаю.
надоело.
пост сдал.

[Sibedir]

DarkHacker, предлагаю начать от печки.

Имею папку с мультивложениями. В каждом вложении есть несколько BMP. Один из них отличается по размеру. Вот этот

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.FileCtrl, Vcl.ExtDlgs,
  Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  bufBMP: TBitmap;
  path: string;
  bmp: TBitmap;

function simple_search_img (aBMP, aTemplate: TBitmap): Boolean;
begin
  Result := (aBMP.Height = aTemplate.Height) and
            (aBMP.Width  = aTemplate.Width );
end;

function GetLastDir (aPath: String):String;
var
  i, j: Integer;
begin
  if Length(aPath) < 4 then Result := aPath
  else begin
    j := 1;
    for i := Length(aPath) - 1 downto 1 do
      if aPath[i] = '\' then begin
        j := i + 1;
        Break;
      end;
    Result := Copy (aPath, j, Length(aPath));
  end;
end;

function FindBMP (aTemplate: TBitmap; aPath: string): string;
var
  sRec: TSearchRec;
  isFound: Boolean;
  s: string;
begin
  isFound := FindFirst (aPath + '\*.*', faAnyFile, sRec) = 0;
  Result := '';
  while isFound do begin
    if ((sRec.Attr and faDirectory) = sRec.Attr) then begin
      if (sRec.Name <> '.') and (sRec.Name <> '..') then
        Result := FindBMP (aTemplate, aPath + '\' + sRec.Name);
    end
    else begin
      if LowerCase (ExtractFileExt (sRec.Name)) = '.bmp' then begin
        bufBMP.LoadFromFile (aPath + '\' + sRec.Name);
        if simple_search_img (bufBMP, aTemplate) then
          Result := GetLastDir (aPath);
      end;
    end;
    if Result <> '' then Break;
    isFound := FindNext( sRec ) = 0;
  end;
  Application.MainForm.Caption := aPath;
  Application.ProcessMessages;
  FindClose(sRec);
end;

{$R *.dfm}

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled := False;
  bufBMP.Free;
  bmp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then begin
    bmp.LoadFromFile (OpenPictureDialog1.FileName);
    path := DirectoryListBox1.Directory;
    Timer1.Enabled := True;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  Button1.Caption := FindBMP (bmp, path);
  Timer1.Enabled := True;
end;

end.

прекрасно находит тот самый файл.
Правда, тратит он на это больше 2 секунд.

[Slym]

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

[DarkHacker]

Следующий код дает "необходимую" ошибку.

for j:=0 to 1000 do
for i:=0 to (AList_actions.count)-1 do
  begin
  bmp.loadfromfile(AList_actions[i]);
       memo2.Lines.Add(AList_actions[i]);
       end;

Создается bmp ДО цикла, освобождается после. Может теперь кто-то подскажет.
В зависимости от значения sleep вставленного во втором цикле (в коде отсутствует) немного смещается время появления ошибки, в среднем это 380-400 итерация главного цикла.

[Serge_Bliznykov]

там все не просто с этим самым LoadFromFile
каждый вызов вызывает создание Picture, которая, похоже, никем не освобождается.

а что если попробовать так:

for j:=0 to 1000 do
for i:=0 to (AList_actions.count)-1 do
  begin
         bmp := TBitmap.Create;
         bmp.loadfromfile(AList_actions[i]);
         bmp.Dormant;
         bmp.FreeImage;
         bmp.ReleaseHandle;
         bmp.Free;
         memo2.Lines.Add(AList_actions[i]);
       end;

код я взял из интернета, поэтому меня о нём можно не расспрашивать...

[DarkHacker]

Сообщение от Serge_Bliznykov

там все не просто с этим самым LoadFromFile
каждый вызов вызывает создание Picture, которая, похоже, никем не освобождается.

а что если попробовать так:

for j:=0 to 1000 do
for i:=0 to (AList_actions.count)-1 do
  begin
         bmp := TBitmap.Create;
         bmp.loadfromfile(AList_actions[i]);
         bmp.Dormant;
         bmp.FreeImage;
         bmp.ReleaseHandle;
         bmp.Free;
         memo2.Lines.Add(AList_actions[i]);
       end;

код я взял из интернета, поэтому меня о нём можно не расспрашивать...

Освобождается..
То что вы привели вроде неплохой вариант, работает на 10 итераций больше))) Я заметил что есть разница сколько файлов в директории, например если 5 директорий по 1 файлу, то все ок, если в одной директории скинуть 15 файлов то фейл.

[Sibedir]

Да не, хрень это всё на посном масле.

Сообщение от Serge_Bliznykov

каждый вызов вызывает создание Picture, которая, похоже, никем не освобождается.

Я вот так сделал

procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
begin
  if OpenPictureDialog1.Execute then begin
    for i := 0 to 1000000 do begin
      bmp.LoadFromFile (OpenPictureDialog1.FileName);
      Button2.Caption := IntToStr (i);
      Application.ProcessMessages;
    end;
  end;
end;

и ушел покурить. Ни каких проблем.
И даже вот так

procedure TForm1.Timer2Timer(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to 1000000 do begin
    bmp.LoadFromFile (OpenPictureDialog1.FileName);
    Button2.Caption := IntToStr (i);
    Application.ProcessMessages;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then begin
    Timer2.Interval := 10;
    Timer2.Enabled := True;
  end;
end;

можно обкуриться.

DarkHacker, может ты с потоками работаешь?