PHP DM Gate v0.9 » Error 216 <span class="vd">[Delphi, Windows]</span>

RusSun © (21.09.13 17:42) [0]

Всем Доброго времени суток.

Используя контекстное меню вызываю диалог открытия.
Выбираю изображение bmp. Рисую в пейтбоксе.
Выделяю область.
Она инвертируется и на ней рисуется оцифровка кривой.

Error 216 переполнение стека

Понимаю что не верно, но не понятно где?

2 ой вопрос когда выделяю область, то инвертированная картинка
не всегда рисуется правильно.
Если с начала координат, то соотвествует, но стоит выделить
кусок по дальше и уже искажается.

<Цитата>
RusSun © (21.09.13 17:42) [1]

program Project1;

uses
Windows,KOL;
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form: PControl;
public
procedure PMOpen(Dummy : Pointer;Sender: PMenu);
procedure PMExit(Dummy : Pointer;Sender: PMenu);
end;
var
Form1: PForm1;
PopupMenu:pmenu;
Dialog:pOpenSaveDialog;
ext:string; PB: PControl;
bmp: pBitmap;
bmp2: pBitmap;
m:array [1..5000] of integer;

Capturing : bool;
Captured : bool;
one:bool;
StartPlace : TPoint;
EndPlace : TPoint;

function MakeRect(Pt1: TPoint; Pt2: TPoint): TRect;
begin
if pt1.x < pt2.x then
begin
Result.Left := pt1.x;
Result.Right := pt2.x;
end
else
begin
Result.Left := pt2.x;
Result.Right := pt1.x;
end;
if pt1.y < pt2.y then
begin
Result.Top := pt1.y;
Result.Bottom := pt2.y;
end
else
begin
Result.Top := pt2.y;
Result.Bottom := pt1.y;
end;

end;
function InvertBitmap(Bmp: pBitmap): pBitmap;
type
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
var
x, y: integer;
ByteArray: PByteArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.height - 1 do
begin
ByteArray := Bmp.ScanLine[y];
for x := 0 to Bmp.Width*3 - 1 do ByteArray[x] := 255 - ByteArray[x];
end;
Result := Bmp;
end;
procedure MouseDn( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
begin
with Mouse do Begin
if one then Captured := false;
if Captured then
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace, EndPlace));
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;

DrawFocusRect(PB.Canvas.Handle, MakeRect(StartPlace, EndPlace));

Capturing := true;Captured := true;
End;
case Mouse.Button of
mbleft:begin
pb.Invalidate;
pb.Update
end;
end;//end of case
end;
procedure MouseMv( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
begin
with Mouse do Begin
if Capturing then
begin
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace,EndPlace));
EndPlace.x := X;
EndPlace.y := Y;
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace,EndPlace));
end;
End
end;
procedure Bmp2Digit(Bmp: pBitmap);
type
TRGB = record
B, G, R: byte;
end;
ARGB = array [0..1] of TRGB;

PARGB = ^ARGB;

var B1, G1, R1: Byte;
x, y: integer;
p: PARGB;

StrList_hook:PStrList;
begin
r1 := GetRValue($FF); //00FF
g1:= GetGValue($FF);//00FF
b1 := GetBValue($FF); //00FF

//создаём список ловушку для значений оцифрованой кривой

StrList_hook:=NewStrList;//
for x := 0 to bmp.Height-1 do StrList_hook.Add(' ');//заполняем пустотами

for y := 0 to bmp.Height - 1 do
begin
//p := Bmp.ScanLine[y];//-> вызывает error 216 переполнения стека
//х.з. хотя может и не только это
for x := 0 to Bmp.Width - 1 do
begin
if (p[x].R = r1) and (p[x].G = g1) and (p[x].B = b1) then //SL.items[y]
begin
if StrList_hook.Items[y]=' ' then begin
m[y]:=x;
StrList_hook.Items[y]:='0';
end;
end
end;
end;

end;

procedure MouseUp( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
var i:integer;P1,P2,RePlace : TPoint;
begin
Capturing := false;
if StartPlace.x>EndPlace.x then begin
RePlace.X:=StartPlace.x;
StartPlace.x:=EndPlace.x;
EndPlace.x:=RePlace.X;
end;
if StartPlace.y>EndPlace.y then begin
RePlace.y:=StartPlace.y;
StartPlace.y:=EndPlace.y;
EndPlace.y:=RePlace.y;
end;
//коррекция слишком малого выделения
if (EndPlace.x-StartPlace.x)<2 then EndPlace.x:=EndPlace.x+1;
if (EndPlace.y-StartPlace.y)<2 then EndPlace.y:=EndPlace.y+1;

//коррекция координат рамки в 1 пиксель
EndPlace.x:=EndPlace.x-1;EndPlace.y:=EndPlace.y-1;

with pb.Canvas^ do begin
MoveTo(StartPlace.x,StartPlace.y);
LineTo(EndPlace.x,StartPlace.y);
LineTo(EndPlace.x,EndPlace.y);
LineTo(StartPlace.x,EndPlace.y);
LineTo(StartPlace.x,StartPlace.y);
one:=true;
end;//end of with
Bmp2 := NewBitmap( 0, 0 );
Bmp2.PixelFormat:=pf24bit;
Bmp2.Width := (EndPlace.x-StartPlace.x);
Bmp2.Height := (EndPlace.y-StartPlace.y);

P1.X:=0; P1.Y:=0;

P2.X:=Bmp2.Width; P2.Y:=Bmp2.Height;

Bmp2.Canvas.CopyRect(MakeRect(p1,p2),bmp.Canvas,MakeRect(StartPlace,p2));

try
Bmp2Digit(Bmp2);
Bmp2 := InvertBitmap(Bmp2);
Bmp2.Draw(PB.Canvas.Handle,StartPlace.x,StartPlace.y);
finally
Bmp2.Free;
end; //end finally

//цикл построения значений по точечно
//with do
with pb.Canvas^ do begin
Pen.Color:=clred;
for i:=0 to 10 do begin
Pixels[StartPlace.x+ m[i],StartPlace.y+i]:=pen.Color;
Pen.Color:=clDefault;//возвращаем исходный цвет пера
end;//end for
end;//end pb.Canvas^

end;//end procedure

procedure DrawPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
if AnsiCompareText(ext,'.bmp')=0 then
Bmp.Draw(PB.Canvas.Handle,0,0);
end;

procedure TForm1.PMOpen(Dummy : Pointer;Sender: PMenu);
begin

if Dialog = nil then
Dialog := NewOpenSaveDialog('Открыть рисунок','',[]);
if PB = nil then
begin
PB := NewPaintBox(applet); //form не может выполнять
//роль applet error 216 переполнения стека
PB.OnPaint := TOnPaint( MakeMethod( nil, @DrawPaint ) );
PB.OnMouseDown:= TOnMouse(MakeMethod(nil,@MouseDn));
PB.OnMouseMove:= TOnMouse(MakeMethod(nil,@MouseMv));
PB.OnMouseUp := TOnMouse(MakeMethod(nil,@ MouseUp));
end;
Dialog.Filter:='Рисунки (bmp)|*.bmp';

if Dialog.Execute then
begin
ext := ExtractFileExt(Dialog.Filename);

if AnsiCompareText(ext,'.bmp')=0 then
begin
if BMP = nil then
Bmp := NewBitmap( 0, 0 );
Bmp.LoadFromFile(Dialog.Filename);
PB.Width := Bmp.Width ;
PB.Height:= Bmp.Height;
end;
end;
applet.Invalidate;
applet.Update;

end;

procedure TForm1.PMExit(Dummy : Pointer;Sender: PMenu);
begin
Form1.Form.Close
end;

procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
Applet := NewApplet('');
New(Result, Create);
with Result^ do
begin
Form := NewForm(AParent, 'Draw');
Form.Add2AutoFree(Result);
Applet := Form;

Form.SetClientSize(320, 240).CenterOnParent;
NewMenu( form, 0, [ '' ], nil );//
PopupMenu := NewMenu( form, 0, ['Открыть','-' , 'Выход'], nil );
PopupMenu.AssignEvents( 0, [TOnMenuItem(MakeMethod(nil,@TForm1.PMOpen))] );
PopupMenu.AssignEvents( 2, [TOnMenuItem(MakeMethod(nil,@TForm1.PMExit))] );
form.SetAutoPopupMenu( PopupMenu );
one:=false;
Capturing :=false;
Captured := false;
end;
end;

begin
NewForm1(Form1, nil);
Run(Form1.Form);
SetProcessWorkingSetSize(GetCurrentProcess, Cardinal(-1), Cardinal(-1));
end.

<Цитата>
RusSun © (21.09.13 17:45) [2]

то что цикл построения только 10 значений это просто не доделал пока

<Цитата>
RusSun © (28.09.13 16:33) [3]

Посмотрел ещё, исправил ошибки.
но ме могу понять следующий момент.
bmp- это основной рисунок.
bmp2- создается из области выделенной в bmp

for x := 0 to bmp2.Height-1 do StrList_hook.Add(' ');//заполняем пустотами

for y := 0 to bmp2.Height - 1 do
begin
p:= Bmp.ScanLine[y];//<--так работает
(* p:= Bmp2.ScanLine[y]; а так error 216 ? *)

картинка есть создаётся нормально, но ScanLine[y] с ошибкой

как исправить???

<Цитата>
RusSun © (28.09.13 16:34) [4]

program Project1;

uses
Windows,KOL;
{$R *.res}

type
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form: PControl;

public

procedure PMOpen(Dummy : Pointer;Sender: PMenu);
procedure PMExit(Dummy : Pointer;Sender: PMenu);
end;
var
Form1: PForm1;
PB: PControl;
PopupMenu:pmenu;

Dialog:pOpenSaveDialog;

ext:string;
bmp: pBitmap;
bmp2: pBitmap;
m:array [0..5000] of integer;

Capturing : bool;
Captured : bool;
one:bool;
StartPlace : TPoint;
EndPlace : TPoint;

function MakeRect(Pt1: TPoint; Pt2: TPoint): TRect;
begin
if pt1.x < pt2.x then
begin
Result.Left := pt1.x;
Result.Right := pt2.x;
end
else
begin
Result.Left := pt2.x;
Result.Right := pt1.x;
end;

if pt1.y < pt2.y then
begin
Result.Top := pt1.y;
Result.Bottom := pt2.y;
end
else
begin
Result.Top := pt2.y;
Result.Bottom := pt1.y;
end;

end;
function InvertBitmap(Bmp: pBitmap): pBitmap;
type
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
var
x, y: integer;
ByteArray: PByteArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.height - 1 do
begin
ByteArray := Bmp.ScanLine[y];
for x := 0 to Bmp.Width*3 - 1 do ByteArray[x] := 255 - ByteArray[x];

end;
Result := Bmp;
end;
procedure MouseDn( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
begin
with Mouse do Begin
if one then Captured := false;
if Captured then
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace, EndPlace));
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;

DrawFocusRect(PB.Canvas.Handle, MakeRect(StartPlace, EndPlace));

Capturing := true;
Captured := true;
End;
case Mouse.Button of
mbleft:begin
pb.Invalidate;
pb.Update
end;
end;//end of case
end;
procedure MouseMv( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
begin
with Mouse do Begin
if Capturing then
begin
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace,EndPlace));
EndPlace.x := X;
EndPlace.y := Y;
DrawFocusRect(PB.Canvas.Handle,MakeRect(StartPlace,EndPlace));
end;
End
end;
procedure Bmp2Digit(Bmp2: pBitmap);
type
TRGB = record
B, G, R: byte;
end;
ARGB = array [0..1] of TRGB;

PARGB = ^ARGB;

var B1, G1, R1: Byte;
x, y: integer;
p: PARGB;

StrList_hook:PStrList;
begin
r1 := GetRValue($FF);
g1:= GetGValue($FF);
b1 := GetBValue($FF);

//создаём список ловушку для значений оцифрованой кривой
StrList_hook:=NewStrList;//

for x := 0 to bmp2.Height-1 do StrList_hook.Add(' ');//заполняем пустотами

for y := 0 to bmp2.Height - 1 do
begin
p:= Bmp.ScanLine[y];//так работает
(* p:= Bmp2.ScanLine[y]; а так error 216 ? *)
for x := 0 to Bmp2.Width - 1 do
begin
if (p[x].R = r1) and (p[x].G = g1) and (p[x].B = b1) then
begin
if StrList_hook.Items[y]=' ' then begin
m[y]:=x;
StrList_hook.Items[y]:='0';
end;

end
end; //end Bmp2.Width-1
end; //bmp2.Height-1

StrList_hook.Free //освобождаем список

end; //end procedure

procedure MouseUp( Dummy : Pointer; Sender : PControl; var Mouse : TMouseEventData );
var i:integer; RePlace : TPoint;
begin
Capturing := false;
if StartPlace.x>EndPlace.x then begin
RePlace.X:=StartPlace.x;
StartPlace.x:=EndPlace.x;
EndPlace.x:=RePlace.X;
end;
if StartPlace.y>EndPlace.y then begin
RePlace.y:=StartPlace.y;
StartPlace.y:=EndPlace.y;
EndPlace.y:=RePlace.y;
end;
//коррекция слишком малого выделения
if (EndPlace.x-StartPlace.x)<2 then EndPlace.x:=EndPlace.x+1;
if (EndPlace.y-StartPlace.y)<2 then EndPlace.y:=EndPlace.y+1;

//коррекция координат рамки в 1 пиксель
EndPlace.x:=EndPlace.x-1;EndPlace.y:=EndPlace.y-1;

with pb.Canvas^ do begin
MoveTo(StartPlace.x,StartPlace.y);
LineTo(EndPlace.x,StartPlace.y);
LineTo(EndPlace.x,EndPlace.y);
LineTo(StartPlace.x,EndPlace.y);
LineTo(StartPlace.x,StartPlace.y);
one:=true;
end;//end of with
Bmp2 := NewBitmap( 0, 0 );
Bmp2.PixelFormat:=pf24bit;
Bmp2.Width := (EndPlace.x-StartPlace.x);
Bmp2.Height := (EndPlace.y-StartPlace.y);

Bmp2.Canvas.CopyRect(KOL.MakeRect( 0, 0,EndPlace.x,EndPlace.y) ,bmp.Canvas,
KOL.MakeRect(0,0,Bmp2.Width,Bmp2.Height));

try
Bmp2Digit(Bmp2);
Bmp2 := InvertBitmap(Bmp2);
Bmp2.Draw(PB.Canvas.Handle,StartPlace.x,StartPlace.y);
finally
Bmp2.Free;
end; //end finally

//цикл построения значений по точечно
//with do
pb.Canvas.Pen.Color:=clFuchsia;
with pb.Canvas^ do

for i:=0 to Endplace.y-StartPlace.y do
Pixels[StartPlace.x+ m[i],StartPlace.y+i]:=pen.Color;

pb.Canvas.Pen.Color:=clDefault;//возвращаем исходный цвет пера

end;//end procedure

procedure DrawPaint( Dummy: Pointer; Sender: PControl; DC: HDC );
begin
if AnsiCompareText(ext,'.bmp')=0 then
Bmp.Draw(PB.Canvas.Handle,0,0);
end;

procedure TForm1.PMOpen(Dummy : Pointer;Sender: PMenu);
begin

if Dialog = nil then
Dialog := NewOpenSaveDialog('Открыть рисунок','',[]);
if PB = nil then
begin
PB := NewPaintBox(applet); //form не может выполнять
//роль applet error 216 переполнения стека
PB.OnPaint := TOnPaint( MakeMethod( nil, @DrawPaint ) );
PB.OnMouseDown:= TOnMouse(MakeMethod(nil,@MouseDn));
PB.OnMouseMove:= TOnMouse(MakeMethod(nil,@MouseMv));
PB.OnMouseUp := TOnMouse(MakeMethod(nil,@ MouseUp));
end;
Dialog.Filter:='Рисунки (bmp)|*.bmp';

if Dialog.Execute then
begin
ext := ExtractFileExt(Dialog.Filename);

if AnsiCompareText(ext,'.bmp')=0 then
begin
if BMP = nil then
Bmp := NewBitmap( 0, 0 );
Bmp.PixelFormat:=pf24bit;
Bmp.LoadFromFile(Dialog.Filename);
PB.Width := Bmp.Width ;
PB.Height:= Bmp.Height;
end;
end;
applet.Invalidate;
applet.Update;

end;

procedure TForm1.PMExit(Dummy : Pointer;Sender: PMenu);
begin
Form1.Form.Close
end;

procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
Applet := NewApplet('');
New(Result, Create);
with Result^ do
begin
Form := NewForm(AParent, 'Draw');
Form.Add2AutoFree(Result);
Applet := Form;

Form.SetClientSize(320, 240).CenterOnParent;
NewMenu( form, 0, [ '' ], nil );//
PopupMenu := NewMenu( form, 0, ['Открыть','-' , 'Выход'], nil );
PopupMenu.AssignEvents( 0, [TOnMenuItem(MakeMethod(nil,@TForm1.PMOpen))] );
PopupMenu.AssignEvents( 2, [TOnMenuItem(MakeMethod(nil,@TForm1.PMExit))] );
form.SetAutoPopupMenu( PopupMenu );
one:=false;
Capturing :=false;
Captured := false;
end;
end;

begin
NewForm1(Form1, nil);
Run(Form1.Form);
SetProcessWorkingSetSize(GetCurrentProcess, Cardinal(-1), Cardinal(-1));
end.

<Цитата>
RusSun © (28.09.13 16:42) [5]

http://s2.ipicture.ru/uploads/20130928/ne7V8DA2.bmp

<Цитата>
RusSun © (02.02.14 19:00) [6]

Ошибка возникает из-за того, что у нового bmp2
bmp2.ScanLinesize = 0, его по какой-то причине нет.
Или же я неправильно к нему обращаюсь?

Свойство ScanLinesize //read only

for y := 0 to bmp2.Height - 1 do
begin
p:= Bmp2.ScanLine[y];//bmp2.ScanLinesize = 0
//и получаем error 216

Ещё выяснил что, если в первый раз
при создании bmp2 ScanLinesize = 0,
то во второй раз оно нежиданно появляется
и программа отрабатывает оцифровку
кривой и выдаёт результат.

Подскажите, пожалуйста, как это исправить?

<Цитата>
Дмитрий К © (02.02.14 21:33) [7]

Создавай картинку не нулевого размера.

<Цитата>
RusSun © (04.02.14 21:20) [8]

Помогло. Большое Спасибо.)

Bmp2 := NewBitmap(EndPlace.x-StartPlace.x, EndPlace.y-StartPlace.y );
...

<Цитата>