[ ВОПРОС СНЯТ ! ] Ошибки при запуске в режиме отладки

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

[ ВОПРОС СНЯТ ! ] Ошибки при запуске в режиме отладки

Сообщение Alex2013 » 25.11.2017 03:18:26

Интересно насколько часто подобное происходит ?
Столкнулся сегодня в очередной раза причем ошибки полезли именно что ДИКИЕ ! ( никакой трассировки не проводилось )
Рекурсивный поиск полигонов при поиска в одно битовом режиме выдает полную чушь при загрузке стороннего битмапа .

(Кстати, ошибки разные при разных режимах оптимизации в Q3 эффект вообще "вроде как" пропал... )

Кто сталкивался с подобными "чудесами" и есть ли проверенный рецепт борьбы с подобными глюками ?
Зы
Да возможно где-то допущены ошибки в коде но при запуске без отладки их не видно
Код поиска вполне обычный в варианте 24бита работает довольно надежно ...
Код: Выделить всё
// Доступ к одно битовым битмапам Чтение
function Get_Pixel_State(Var B:TbitMap; x, y: integer): integer;
Var
  addrPixel:PByte;
begin

addrPixel:=Pointer(B.ScanLine[y]+(x div 8));

result:=integer(((addrPixel^ shl (x and 7)) and $80)=$80);

end;

// Доступ к одно битовым битмапам Запись
procedure Change_Pixel_State(Var B:TbitMap; x, y, c: integer);
var
  addrPixel:PByte;
begin
addrPixel:=Pointer(B.ScanLine[y]+(x div 8));
if (c=1) then
     addrPixel^:=addrPixel^ or ($80 shr (x and 7))
  else
     addrPixel^:=addrPixel^ and ($80 shr (x and 7) xor $ff);
end;

/// Рекурсивнй поиск границ контура 1Bit
function ScanOBJ_1Bit(Var image:tBitmap;x,y:integer):trect;

const    delta: array[1 .. 8] of record dx, dy: integer;
end =    (      (dx:0; dy:1),
                (dx:1; dy:0),
                (dx:0; dy:-1),
                (dx:-1; dy:0),
                (dx:1; dy:1),
                (dx:1; dy:-1),
                (dx:-1; dy:1),
                (dx:-1; dy:-1)    );

XC : integer=0;
YC: integer=0;
Var
i: byte;
begin
with result do
begin
Left := x; Top := y;
Right := x; Bottom := y;
end;
Change_Pixel_State(image,x, y, 1);
for i := 1 to 8 do
begin
if not InR(x+delta[i].dx, 0,image.Width-1) then  continue;
if not InR(y+delta[i].dy, 0,image.Height-1) then  continue;
XC:=x+delta[i].dx;
YC:=y+delta[i].dy;
if Get_Pixel_State(Image,xc,yc)= 0 then
begin
With  ScanOBJ_1Bit(image, XC,YC) do begin
  if Left <= result.left then result.Left := Left;
  if right >= result.right then result.right := right;
  if top <= result.top then result.top := top;
  if bottom >= result.bottom then result.bottom :=bottom;
end;

end;

end;
end;

procedure ScanOBJECTS1Bit(Var RL:TList; Var image:tBitmap;DR:Longint;
                        FMySobj:Boolean );
Var
//  W,H:Longint;
  R:^Trect;
  Lf,:Boolean;
  I,x,y:Longint;
begin
If image=nil then exit;
Lf:=False;
Repeat
   Lf:=False;
   For Y:=0 to image.Width-1 do
   For X:=0 to image.Height-1 do
   begin
    if  Get_Pixel_State(image,x,y)  =0 then
     begin
      GetMem(R,SizeOf(Trect));
       if FMySobj then begin
         // Тут я пытаюсь изобрести новый метод  поиска контуров но
         // этот кусок кода к описываемой проблеме не относится ...
         ....
       end else
      R^:=ScanOBJ_1Bit(image,x,y );
      if (ABS(r^.Bottom-R^.Top)>DR) AND (Abs(R^.Right-r^.Left)>DR) then
        begin
          RL.Add(R) ;
          LF:=True;
        end  else FreeMem(R,SizeOf(Trect));
      end
      end;
   Until not LF;
  end;

Есть впечатление что суть ошибки или в неверной оптимизации чтения бита ( result:=integer(((addrPixel^ shl (x and 7)) and $80)=$80);)
или есть отличия методов загрузки битмара в режиме отладки и без него, хотя КАК это может быть непонятно ....
( image1.Picture.LoadFromFile(OpenDialog1.FileName); ).
Последний раз редактировалось Alex2013 30.11.2017 22:16:07, всего редактировалось 2 раз(а).
Alex2013
энтузиаст
 
Сообщения: 710
Зарегистрирован: 03.04.2013 11:59:44

Re: Ошибки при запуске в режиме отладки

Сообщение MysticCoder » 26.11.2017 15:08:08

Ты бы хоть ошибки привел бы
MysticCoder
постоялец
 
Сообщения: 117
Зарегистрирован: 14.09.2013 00:20:28

Re: Ошибки при запуске в режиме отладки

Сообщение zub » 26.11.2017 18:41:14

написано криво - вот и ошибки
zub
долгожитель
 
Сообщения: 2275
Зарегистрирован: 14.11.2005 23:51:26

Re: Ошибки при запуске в режиме отладки

Сообщение Alex2013 » 28.11.2017 20:11:39

Код работает и "не падает" но без отладки находит например 2 контура(что верно ) а в режиме отладки каким-то боком например 4 ( не верно !) ... :shock:
(Причем с заранее загруженной картинкой ошибок почему-то не возникает )
Ничего кроме конверсии в одно битовый формат во внешнем коде нет (Это вообще тестовая программа для отладки работы в монохромном режиме )

Код конверсии в монохромный режим ...
Код: Выделить всё
// Только 24 Бита !
Function Get_Pixel(Const BB:TBitmap;X,Y:Integer):Integer;
Type
TA=Array[0..2] of byte;
Var
PA:^TA;
  n:integer;
begin
Get_Pixel:=-1;
  if bb = NIL then exit;
  if not InR(x,0,bb.Width-1) then exit;
  if not InR(y,0,bb.Height-1) then exit;
  pa:=Pointer(  BB.ScanLine[y]+(x *3));

  Get_Pixel:=rgb(pa^[2],pa^[1],pa^[0]);
end;

...
if B1= nil then b1:=TBitmap.Create ;
B1.PixelFormat:=pf1bit;
b1.SetSize(image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height);

b1.BeginUpdate;
For Y:=0 To b1.Height-1 do For X:=0 To B1.Width-1 do
  begin
    Change_Pixel_State(B1,X,Y,   Integer(   Get_Pixel(Image1.Picture.Bitmap,X,Y) <>0));
    end;
b1.EndUpdate;
// для контроля делаю  просмотр результата
image2.Picture.Bitmap.SetSize(B1.Width,b1.Height);
image2.Picture.Bitmap.Canvas.Draw(0,0,b1);

Где "написано криво"?
Зы
Да возможно картинка "не той системы" но КАКИМ БОКОМ при этом может влиять режим отладки ?
Alex2013
энтузиаст
 
Сообщения: 710
Зарегистрирован: 03.04.2013 11:59:44

Re: Ошибки при запуске в режиме отладки

Сообщение zub » 28.11.2017 22:41:09

>>Где "написано криво"?
Вот когда выложишь минимальный рабочий пример - тебе объяснят. а так просто поверь - криво

>>но КАКИМ БОКОМ при этом может влиять режим отладки ?
Боков может быть миллион. Ты главное пойми это не режим отладки влияет, это без отладчика какимто чудным способом кривой код работает - звезды так сложились. на другой машине он повалится и без отладки
zub
долгожитель
 
Сообщения: 2275
Зарегистрирован: 14.11.2005 23:51:26

Re: Ошибки при запуске в режиме отладки

Сообщение MysticCoder » 28.11.2017 23:04:39

Просмотри все варнинги, неинициализированные переменные и результы. Непонятно, что значит в режиме не отладки, это без отладчика релизная сборка запускается или дебаговая? Если релизная, то выделяемая память в зависимости от настроек может и не нулями заполнятся.
А вообще веди лог, смотри отличия. Логируй момент когда в одной сборке находится контур, а в другой нет.
MysticCoder
постоялец
 
Сообщения: 117
Зарегистрирован: 14.09.2013 00:20:28

Re: Ошибки при запуске в режиме отладки

Сообщение zub » 28.11.2017 23:05:42

Почему так: чтото гдето поработало, и все считают что оно идеально и должно работать везде и всегда. виня в обратном всё кроме своих рук и головы
zub
долгожитель
 
Сообщения: 2275
Зарегистрирован: 14.11.2005 23:51:26

Re: Ошибки при запуске в режиме отладки

Сообщение Alex2013 » 30.11.2017 22:04:20

Вообщем разобрался ! (в процессе упрощения кода ) Спасибо за отклики !
Зуб, ты прав и неправ одновременно ... :wink:

Дело не в режиме отладки как я думал, а в странном поведении TBitmap в одно битовом режиме ...
(а отладка просто вылезала как "очевидная причина" ввиду устоявшегося привычного набора действий при запуске программы из под среды : сразу все проверить не загружая картинки)

Суть (как я уже писал другой теме ) в том что любое обращение к данным в обход стандартных методов в одно битовом режиме переводит TBitmap в "не изменяемый режим" .
И любое действие (Очистка, Освобождение памяти или изменение размера ) вызывает исключение ...
Для теста на скорость это несущественно но я не учел необходимость масштабирования при загрузке как результат если загружать сразу (или использовать только заранее загруженную картину ) все работало нормально но стоило повторно загрузить битмап другого размера возникали ошибки при поиске контуров

Загрузка с масштабированием решила проблему ДЛЯ ТЕСТА . Но "не понятка" осталась ...
Код: Выделить всё
procedure TBTForm.Button1Click(Sender: TObject);
Var f:String;
     im:Timage;
begin
GetDir(0,F);
OpenDialog1.InitialDir:=F;
OpenDialog1.FileName:='*.bmp;*.jpg;*.png';
If OpenDialog1.Execute then begin
im:=Timage.Create(nil);
im.Picture.LoadFromFile(OpenDialog1.FileName);
image1.Picture.Bitmap.Canvas.
   StretchDraw(rect(0,0,image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height),im.Picture.Bitmap);
im.Free;
end;
end;
Зы

Полный код "урезанного" тестового модуля
(Для нормальной работы нужна предварительно загруженная (во время создания формы ) картинка TBTForm.Image1 )
Формат "двухцветный" Чб 24 бита ...
Код: Выделить всё
unit BTun1;
{$mode objfpc}{$H+}

interface

uses
  Windows,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, StdCtrls,Math,LCLType;

type

  { TBTForm }

  TBTForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    Image2: TImage;
    Label2: TLabel;
    Label3: TLabel;
    ListBox2: TListBox;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private

  public
    const B1:TBitmap=nil;
  end;

var
  BTForm: TBTForm;

implementation

{$R *.lfm}

{ TBTForm }

Function InR(AA,B,C:Longint):Boolean;
begin
InR:=((AA>=B) And (AA<=C));
End;

// Только 24 Бита ! Запись
Procedure Set_Pixel(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..2] of byte;
var
PA:^TA;
begin
if bb = NIL then exit;
if not InR(x,0,bb.Width-1) then exit;
if not InR(y,0,bb.Height-1) then exit;

Bb.BeginUpdate; ;
pa:=Pointer(  BB.ScanLine[y]+(x *3));
pa^[0]:=Blue(C);
pa^[1]:=Green(C);
pa^[2]:=red(C);
Bb.EndUpdate;
end;
// Только 24 Бита ! Чтение
Function Get_Pixel(Const BB:TBitmap;X,Y:Integer):Integer;
Type
TA=Array[0..2] of byte;
Var
PA:^TA;
  n:integer;
begin
Get_Pixel:=-1;
  if bb = NIL then exit;
  if not InR(x,0,bb.Width-1) then exit;
  if not InR(y,0,bb.Height-1) then exit;
  pa:=Pointer(  BB.ScanLine[y]+(x *3));
  Get_Pixel:=rgb(pa^[2],pa^[1],pa^[0]);
end;


Var
BytePerLine:Longint;

// Доступ к одно битовым битмапам Чтение
function Get_Pixel_State(Var B:TbitMap; x, y: integer): integer;
Var
  addrPixel:PByte;
begin

addrPixel:=Pointer(B.ScanLine[y]+(x div 8));

result:=integer(((addrPixel^ shl (x and 7)) and $80)=$80);

end;

// Доступ к одно битовым битмапам Запись
procedure Change_Pixel_State(Var B:TbitMap; x, y, c: integer);
var
  addrPixel:PByte;
begin
addrPixel:=Pointer(B.ScanLine[y]+(x div 8));
if (c=1) then
     addrPixel^:=Byte(addrPixel^ or ($80 shr (x and 7)))
  else
     addrPixel^:=Byte(addrPixel^ and ($80 shr (x and 7) xor $ff));
end;

// Конверсия
procedure TBTForm.Button2Click(Sender: TObject);
Type A=Array[0..1] Of byte;
var X,Y:Integer;
  BA,ba2:^A;
begin
if B1= nil then b1:=TBitmap.Create ;
B1.PixelFormat:=pf1bit;
b1.SetSize(image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height);

// b1.Canvas.Draw(0,0,image1.Picture.Bitmap); // Так не работает !

image2.Picture.Bitmap.SetSize(B1.Width,b1.Height);
b1.BeginUpdate;
For Y:=0 To b1.Height-1 do For X:=0 To B1.Width-1 do
  begin
    Change_Pixel_State(B1,X,Y,
   Integer(   Get_Pixel(Image1.Picture.Bitmap,X,Y) <>0));
    end;

b1.EndUpdate;
    image2.Picture.Bitmap.Canvas.Draw(0,0,b1);
    label3.Caption:='Размер 24 бита: '+
    IntToStr(Image1.Picture.Bitmap.RawImage.DataSize)+'  Размер 1 бит : '+
    IntToStr(B1.RawImage.DataSize);
end;
// Загрузка ...
procedure TBTForm.Button1Click(Sender: TObject);
Var f:String;
     im:Timage;
begin
GetDir(0,F);
OpenDialog1.InitialDir:=F;
OpenDialog1.FileName:='*.bmp;*.jpg;*.png';
If OpenDialog1.Execute then begin
im:=Timage.Create(nil);
im.Picture.LoadFromFile(OpenDialog1.FileName);
image1.Picture.Bitmap.Canvas.
   StretchDraw(rect(0,0,image1.Picture.Bitmap.Width,image1.Picture.Bitmap.Height),im.Picture.Bitmap);
im.Free;
end;

end;


/// Рекурсивнй поиск границ контура 1Bit
function ScanOBJ_1Bit(Var image:tBitmap;x,y:integer):trect;

const    delta: array[1 .. 8] of record dx, dy: integer;
end =    (      (dx:0; dy:1),
                (dx:1; dy:0),
                (dx:0; dy:-1),
                (dx:-1; dy:0),
                (dx:1; dy:1),
                (dx:1; dy:-1),
                (dx:-1; dy:1),
                (dx:-1; dy:-1)    );

XC : integer=0;
YC: integer=0;
Var
i: byte;
begin
with result do
begin
Left := x; Top := y;
Right := x; Bottom := y;
end;
// if  SumpF Then SUMP:=SUMP+1;
Change_Pixel_State(image,x, y, 1);

for i := 1 to 8 do
begin
if not InR(x+delta[i].dx, 0,image.Width-1) then  continue;
if not InR(y+delta[i].dy, 0,image.Height-1) then  continue;
XC:=x+delta[i].dx;
YC:=y+delta[i].dy;
if Get_Pixel_State(Image,xc,yc)= 0 then
begin
With  ScanOBJ_1Bit(image, XC,YC) do begin
  if Left <= result.left then result.Left := Left;
  if right >= result.right then result.right := right;
  if top <= result.top then result.top := top;
  if bottom >= result.bottom then result.bottom :=bottom;
     end
   end
end
end;

procedure ScanOBJECTS1Bit(Var RL:TList; Var image:tBitmap;DR:Longint;
                        FMySobj:Boolean );
Var
//  W,H:Longint;
  R:^Trect;
  Lf:Boolean;
  I,x,y:Longint;
begin
If image=nil then exit;
Lf:=False;
Repeat
   Lf:=False;

   For Y:=0 to image.Width-1 do
   For X:=0 to image.Height-1 do
   begin

  if  Get_Pixel_State(image,x,y)  =0 then
     begin
      GetMem(R,SizeOf(Trect));
       if FMySobj then begin
         //...
       end else
      R^:=ScanOBJ_1Bit(image,x,y );
      if (ABS(r^.Bottom-R^.Top)>DR) AND (Abs(R^.Right-r^.Left)>DR) then
        begin
          RL.Add(R) ;
          LF:=True;
        end  else FreeMem(R,SizeOf(Trect));

      end
      end;
   Until not LF;
  end;


// Тест ...
procedure TBTForm.Button4Click(Sender: TObject);
Var
myTime:TDateTime;
ts:String;
X,y,i:Integer;
     R:^Trect;
Const
   RL:TList=nil;
   RL2:TList=nil;
   B:TBitmap=nil;
   B2:TBitmap=nil;

begin
if B1= nil then exit;
If RL=nil then RL:=TList.Create else Rl.Clear;;
if B=nil  then B:=TBitmap.Create;
if B2=nil  then begin
  B2:=TBitmap.Create;
  B2.PixelFormat:=pf1bit;
  b2.SetSize(b1.Width,b1.Height ); // !! Тут была собака зарыта ...
end;


//--------------------------------------------
For Y:=0 to b1.Height-1 do begin
b2.BeginUpdate;
  For X:=0 to B2.Width-1 do
begin
Change_Pixel_State(b2,X,Y,Get_Pixel_State(B1,X,Y ));
end;
b2.EndUpdate;
end;
//--------------------------------------------
If RL2=nil then RL2:=TList.Create else Rl2.Clear;// Да, я знаю что тут "микро-утечка" но для теста сойдет ....
b2.BeginUpdate;
myTime:=now;
ScanOBJECTS1Bit(RL2 ,b2 ,5,CheckBox1.Checked );
str((now-myTime)*10e4:2:5,ts);
b2.endUpdate;
Label2.Caption:='Время 1 Bit: '+ts +' Контуров '+IntToStr(rl2.count);


// -------------------------
ListBox2.Clear;
For i:=0 to Rl2.Count-1 do begin
Image2.Picture.Bitmap.Canvas.Pen.Color:=clred;
Image2.Picture.Bitmap.Canvas.Frame(Trect( rl2[i]^));
With Trect( rl2[i]^) do ListBox2.Items.Add(
Format('%d %d %d %d ',[left,top,Right,Bottom]));
end;
end;
end.

Alex2013
энтузиаст
 
Сообщения: 710
Зарегистрирован: 03.04.2013 11:59:44

Re: [ ВОПРОС СНЯТ ! ] Ошибки при запуске в режиме отладки

Сообщение zub » 02.12.2017 12:58:18

>>Зуб, ты прав и неправ одновременно ... :wink:
Простите, а где я не прав?
zub
долгожитель
 
Сообщения: 2275
Зарегистрирован: 14.11.2005 23:51:26

Re: [ ВОПРОС СНЯТ ! ] Ошибки при запуске в режиме отладки

Сообщение Alex2013 » 04.12.2017 22:39:13

zub писал(а):>>Зуб, ты прав и неправ одновременно ... :wink:
Простите, а где я не прав?

Дурная голова(моя разумеется ) даже коду покоя не дает . :D
Но там не только мой код кривой, а потому сработал "эффект домино" ошибки порождают ошибки .
Потому я и стараюсь не использовать "чужой закрытый код" где это только можно .
Бо мои ошибки + ошибки в библиотеке = "тихий УЖОС летящий на крыльях ночи." :shock: .

Про что сейчас, кстати, будет новая тема ... :idea:
Alex2013
энтузиаст
 
Сообщения: 710
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6

Рейтинг@Mail.ru