Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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

Col Isaev © (2003-07-18 13:40:00)
Помогите, мастера! Что я делаю неправильно - работает только один раз - первый.

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.

iXuSs (2003-07-18 17:06:00) [1]

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

procedure SetLength(var S; NewLength: Integer);

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

Col Isaev (2003-07-18 16:44:00) [2]
>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 15:54:00) [3]

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

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

Col Isaev (2003-07-18 14:13:00) [4]

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

LongIsland (2003-07-18 13:53:00) [5]

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

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »