Текущий архив: 2003.11.17;
Скачать: CL | DM;

Вниз

Сохранение куска битмап в массив   Найти похожие ветки 

← →
Col Isaev   (2003-07-18 13:40) [0]

Помогите, мастера! Что я делаю неправильно - работает только один раз - первый.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

MyPoint = record
X, Y: integer;
Frag: TBitmap;
end;

var
Form1: TForm1;
P: MyPoint;
A: array of MyPoint;
N: integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Dest: TRect;
Source: TRect;
begin

with Image1.Canvas do
begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Ellipse(X-2,Y-2, X+2, Y+2);
A[N].X:= X;
A[N].Y:= Y;
A[N].Frag:= TBitmap.Create;
Dest:= Rect(X-3,Y-3,X+3,Y+3);
Source:= Rect(X-3,Y-3,X+3,Y+3);
A[N].Frag.Canvas.CopyRect(Dest, Image1.Canvas, Source);
A[N].Frag.Free;
end;
inc(N);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
N:= 1;
( A,N) Помогите, мастера! Что я делаю неправильно - работает только один раз - первый.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

MyPoint = record
X, Y: integer;
Frag: TBitmap;
end;

var
Form1: TForm1;
P: MyPoint;
A: array of MyPoint;
N: integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Dest: TRect;
Source: TRect;
begin

with Image1.Canvas do
begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Ellipse(X-2,Y-2, X+2, Y+2);
A[N].X:= X;
A[N].Y:= Y;
A[N].Frag:= TBitmap.Create;
Dest:= Rect(X-3,Y-3,X+3,Y+3);
Source:= Rect(X-3,Y-3,X+3,Y+3);
A[N].Frag.Canvas.CopyRect(Dest, Image1.Canvas, Source);
A[N].Frag.Free;
end;
inc(N);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
N:= 1;
SetLength(A,N);
end;

end.

---

← →
LongIsland ©   (2003-07-18 13:53) [1]

inc(N);
SetLength(A,N);
Забыл?
У тебя массив длинной = 1

---

← →
Col Isaev   (2003-07-18 14:13) [2]

Во я дубина! Но все равно работает 1 - 5 раз и вываливает Access violation at address... Что я исчо забыл?

---

← →
iXuSs   (2003-07-18 15:54) [3]

Я бы ещё задал размеры A[N].Frag прежде чем туда что-либо копировать, хотя не уверен, что в этом ошибка.

И ещё вроде как такая наколка SetLength(A,N) наверное лучше заменить на SetLength(A,N+1), у меня пожизни такая штука в программах бывает, причём AV вылетает только при закрытии формы.

---

← →
Col Isaev   (2003-07-18 16:44) [4]

>iXuSs (18.07.03 15:54)
>Я бы ещё задал размеры A[N].Frag прежде чем туда что-либо >копировать, хотя не уверен, что в этом ошибка.
Это и не ошибка, все имеется через Source и Dest

>И ещё вроде как такая наколка SetLength(A,N) наверное лучше >заменить на SetLength(A,N+1),
А вот это - чудесно работает, хотя я не очень врубаюсь почему. Короче, вот:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

MyPoint = record
X, Y: integer;
Frag: TBitmap;
end;

var
Form1: TForm1;
A: array of MyPoint;
N: integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Dest: TRect;
Source: TRect;
begin
SetLength(A,N+1);
with Image1.Canvas do
begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Ellipse(X-2,Y-2, X+2, Y+2);
A[N].X:= X;
A[N].Y:= Y;
A[N].Frag:= TBitmap.Create;
Dest:= Rect(X-3,Y-3,X+3,Y+3);
Source:= Rect(X-3,Y-3,X+3,Y+3);
A[N].Frag.Canvas.CopyRect(Dest, Image1.Canvas, Source);
A[N].Frag.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
N:= 0;
( A,N) >iXuSs (18.07.03 15:54)
>Я бы ещё задал размеры A[N].Frag прежде чем туда что-либо >копировать, хотя не уверен, что в этом ошибка.
Это и не ошибка, все имеется через Source и Dest

>И ещё вроде как такая наколка SetLength(A,N) наверное лучше >заменить на SetLength(A,N+1),
А вот это - чудесно работает, хотя я не очень врубаюсь почему. Короче, вот:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

MyPoint = record
X, Y: integer;
Frag: TBitmap;
end;

var
Form1: TForm1;
A: array of MyPoint;
N: integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Dest: TRect;
Source: TRect;
begin
SetLength(A,N+1);
with Image1.Canvas do
begin
Pen.Color:= clBlue;
Brush.Color:= clBlue;
Ellipse(X-2,Y-2, X+2, Y+2);
A[N].X:= X;
A[N].Y:= Y;
A[N].Frag:= TBitmap.Create;
Dest:= Rect(X-3,Y-3,X+3,Y+3);
Source:= Rect(X-3,Y-3,X+3,Y+3);
A[N].Frag.Canvas.CopyRect(Dest, Image1.Canvas, Source);
A[N].Frag.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
N:= 0;
SetLength(A,N);
end;

end.
---
И, конечно, спасибо отсюда и до упора. Будем тумкать дальшее.

---

← →
iXuSs   (2003-07-18 17:06) [5]

Дело в том, что SetLength имеет следующее объявление:

procedure SetLength(var S; NewLength: Integer);

Второй парметр получается, что задаёт длину массива начиная с элемента с индексом 0 и кончая элементом NewLength-1, т.е. верний элемент имеет индекс на единицу меньше. Другое дело - как такое дело иногда проходит, а иногда AV - вот это непонятно :).

---

Страницы: 1 вся ветка

Текущий архив: 2003.11.17;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.028 c