Копирование области изображения и по-пиксельный перебор.

[Vova777]

begin
  //эллипс
  Image1.Canvas.Ellipse(xk - abb1, yk - abb1, xk + abb1, yk + abb1); 

  //копирую область
  Dest.Canvas.CopyRect(Rect(xk - 150, yk - 150, xk + 150, yk + 150), Image1.Canvas, Rect(xk - 150, yk - 150, xk + 150, yk + 150));

  //попиксельный перебор прямоугольной области
  for ipy:= 0 to yk + 150 do
  begin
    for ipx:= 0 to xk + 150 do

    //запись в массив
    if Dest.Canvas.Pixels[ipx, ipy] = clBlack then field[ipx, ipy]:= ab;
  end;

end;

Фрагмент выполняет следующую функцию. Рисуется эллипс, координаты считаются от его центра (xk и yk), потом копируется прямоугольная область в "Dest" (считается от центра эллипса - xk, yk). В переменной "Dest" (это Тbitmap), происходит по-пиксельный анализ (т.е. каждого пикселя - ipx, ipy), и если пиксель черный, то по координатам пикселя (ipx, ipy), переменная "ab" записываются в двумерный массив "field", в ячейку ipx, ipy.

Где-то здесь ошибка, код не работает, вроде все правильно, подскажите.

[Аватар]

Не факт, что черный цвет совпадет с clBlack

[Vova777]

Сообщение от Аватар

Не факт, что черный цвет совпадет с clBlack

нет, вроде совпадает, он мною был программно задан:

Image1.Canvas.Pen.Color:= clBlack;

[chertovich]

не зная что такое

field[ipx, ipy]:= ab;

(я не про код, а про Filed) не известно, записан код правильно или нет, хотя есть подозрение что неправильно =)
Код нужно давать полный или весь исходник.
И какая ошибка? исключение или что?

[Vova777]

Может из-за этого. Так во втором Image только белый фон:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  xk, yk: integer;
  Dest: TBitMap;
begin
  Dest:= TBitMap.Create;
  xk:= StrToInt(Edit1.Text);
  yk:= StrToInt(Edit2.Text);
  Image1.Canvas.Ellipse(xk - 20, yk - 20, xk + 20, yk + 20);

  Dest.Canvas.CopyRect(Rect(xk - 30, yk - 30, xk + 30, yk + 30), Image1.Canvas, Rect(xk - 30, yk - 30, xk + 30, yk + 30));

  Image2.Canvas.Draw(0, 0, Dest);
  Dest.Free;
end;

А так все нормально:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  xk, yk: integer;
  //Dest: TBitMap;
begin
  //Dest:= TBitMap.Create;
  xk:= StrToInt(Edit1.Text);
  yk:= StrToInt(Edit2.Text);
  Image1.Canvas.Ellipse(xk - 20, yk - 20, xk + 20, yk + 20);

  Image2.Canvas.CopyRect(Rect(xk - 30, yk - 30, xk + 30, yk + 30), Image1.Canvas, Rect(xk - 30, yk - 30, xk + 30, yk + 30));

  //Image2.Canvas.Draw(0, 0, Dest);
  //Dest.Free;
end;

Тут что-то не так с переменной Dest. Что можно сделать?

[Vova777]

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

не зная что такое

field[ipx, ipy]:= ab;

(я не про код, а про Filed) не известно, записан код правильно или нет, хотя есть подозрение что неправильно =)
Код нужно давать полный или весь исходник.
И какая ошибка? исключение или что?

Это двумерный массив, в скобках указанны индексы ячейки для сохранения переменной ab. Если я выложу Вам весь исходник вы будете долго его анализировать, не потому что он большой, он не большой, просто там остальное не относится к делу, я уверен, что код не работает именно в этом фрагменте. Ошибок нет, просто он не выполняет свою задачу, т.е. Результат:= nil.

Cм. пост выше

[chertovich]

Написал свой код -все прекрасно работает, правда немного отличающийся, но это можно изменить.

unit Unit1;

interface

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

const
  Size = 100;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Image1: TImage;
    ButtonPaint: TButton;
    ButtonCopy: TButton;
    ButtonGetResult: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ButtonPaintClick(Sender: TObject);
    procedure ButtonCopyClick(Sender: TObject);
    procedure ButtonGetResultClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  A: array of TPoint;

implementation

{$R *.dfm}

procedure TForm1.ButtonCopyClick(Sender: TObject);
var
  R: TRect;
begin
  R.Left := 0;
  R.Top := 0;
  R.Right := Size;
  R.Bottom := Size;

  PaintBox1.Canvas.CopyRect(R, Image1.Canvas, R);
end;

procedure TForm1.ButtonGetResultClick(Sender: TObject);
var
  Count, X, Y: Integer;
  P: TPoint;
begin
  Count := 0;
  SetLength(A, Count);

  for X := 0 to PaintBox1.ClientWidth - 1 do
    for Y := 0 to PaintBox1.ClientHeight - 1 do
    begin
      if PaintBox1.Canvas.Pixels[X, Y] = clBlack then
      begin
        Inc(Count);
        SetLength(A, Count);
        A[Count - 1].X := X;
        A[Count - 1].Y := Y;
      end;
    end;
  ShowMessage('Просмотрите результат в отладчике, поставив BrackPoint на это место');
end;

procedure TForm1.ButtonPaintClick(Sender: TObject);
begin
  with Image1.Canvas do
  begin
    // Очистка белым цветом
    Brush.Color := clWhite;
    FillRect(ClientRect);

    Pen.Color := clBlack;
    Ellipse(0, 0, Size, Size);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
  Image1.Width := Size;
  Image1.Height := Size;
  PaintBox1.Width := Size;
  PaintBox1.Height := Size;
end;

end.

[Vova777]

А альтернативы тут нет? Просто мой фрагмент выполняется в цикле, такой объемный код может существенно его притормозить.

[Vova777]

Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 0047B804 in module 'Project1.exe'. Write of address 00467B66'. Process stopped. Use Step or Run to continue.

Что за ошибка, не подскажите?

[chertovich]

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

Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 0047B804 in module 'Project1.exe'. Write of address 00467B66'. Process stopped. Use Step or Run to continue.

Что за ошибка, не подскажите?

Любимаю ошибка тех, кто что-то хочет залезьь туда, куда не стоит. Ошибка доступа к памяти.
Вы смотрели мой исходник?