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