Категории раздела
J2me|java [29]
Basic [6]
Delphix [21]
C+|C++|C# [3]
Pascal [10]
Другие [0]
языки которые не войшли в верхние разделы
Главная » Статьи » Программирования » Delphix

Нарисовать линию точками

Как нарисовать линию без использования процедур LineTo и MoveTo, тоесть закрашивая вручную  пиксели? Сейчас разберемся. Итак, выложите на форму TImage и TButton. Далее объявите глобальную переменную:

var
  BMP: TBitMap;

Теперь необходимо создать ее и установить размеры нашего будущего изображения:

procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP := TBitMap.Create;
  BMP.Width := Image1.Width;
  BMP.Height := Image1.Height;
end;

Далее напишем две процедуры:

procedure setPix(x,y:integer);
begin
  BMP.Canvas.Pixels[x,y]:=clBlack;
end;


procedure DrawLine(x1,y1, x2,y2: Integer);
var b,dx,dy,y,x,i:integer;
begin
  dx:=abs(x2-x1);
  dy:=abs(y2-y1);

  if dx >= dy then
  begin
    if (x1<x2) then
      for i := x1 to x2 do
      begin
        y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
        SetPix(i,y);
      end;

    if (x2<x1) then
      for i := x2 to x1 do
      begin
        y:=Round(((y2-y1)/(x2-x1))*i + (y1-x1*((y2-y1)/(x2-x1))));
        SetPix(i,y);
      end;
  end;

  if dx<dy then
  begin
    if (y1<y2) then
      for i := y1 to y2 do
      begin
        x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
        SetPix(x,i);
      end;

    if (y2<y1) then
      for i := y2 to y1 do
      begin
        x:=Round(((x2-x1)/(y2-y1))*i + (x1-y1*((x2-x1)/(y2-y1))));
        SetPix(x,i);
      end;
  end;

  Form1.Image1.Picture.Bitmap.Assign(bmp);
end;

Первая процедура ничего особенного не делает - устанавливает пикселю нужный цвет. Сделано это для следующего: если, например, понадобится изменить цвет которым рисовать линию, то придется менять в нескольких местах, а в данном случае только в одном месте. Ну и закрашивать нужный пиксель значительно удобнее.

Вторая процедура, собственно, рисует линию из точки A(x1, y1) в точку B(x2,y2).

Ну и остается только вызвать процедуру DrawLine. Для этого и нужна кнопка:

procedure TForm1.Button1Click(Sender: TObject);
begin
  DrawLine(0,0,50,50);
end;
Категория: Delphix | Добавил: graimp (21.12.2011)
Просмотров: 414 | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email *:
Код *:
Наш опрос
Оцените мой сайт
Всего ответов: 25
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0