Подписаться на RSS рассылку
Главная » Статьи по Delphi » Bitmap » Нарисовать линию точками

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

Автор: Борисов Сергей

Как нарисовать линию без использования процедур 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;

Просмотров: 8255

Обсудить на форуме

0   Спам
(24.07.2013)
3. Сергей Иванов (Serzh)
Опасности, подстерегающие нас в Интернете!
http://taxaru.ucoz.org/

0   Спам
(04.07.2012)
2. ExtazY
Можно еще две линии создать на событие перемещения мыши.
Получиться не плохой курсор.

0   Спам
(04.07.2012)
1. ExtazY
Спасибо. Всё давольно просто и понятно.


Имя *:
Email:


Код *:

Copyright © 2008-2016 Программирование на Delphi для начинающих и не только

Полнота авторских прав на все материалы, опубликованные на сервере DelphiDevelop.ru принадлежит их авторам

Перепечатка материалов разрешается с указанием авторства и гиперссылки на первоисточник информации

Хостинг от uCoz

Автор проекта: Борисов Сергей

e-mail: save-x@yandex.ru

Связь с администрацией сайта