Новичок
Профиль
Группа: Участник
Сообщений: 1
Регистрация: 25.4.2008
Репутация: нет
Всего: нет
|
Задача такова: Написать программу построения чертежей планиметрии "протягиванием" от выбранной точки с изображением ее промежуточного положения с возможностью обозначения точек и проведения стандартных линий в треугольнике.Скажим так на 50% я справился сделал бы и на 100% еслибы не одно но....Никак не могу исправить ошибку: для анимации протягивания линий я предыдущюю закрашиваю цветом фона,так вот если я провожу линию поверх старой то соответственно старая линия в этом месте закрашивается цветом фона(алгоритм который это предотвратит я знаю для этого я рисую линию по точкам (проверяем если пиксель который хотим закрасить отличен от цвета фона то не закрашиваем его иначи закрашиваем)) токо вот риализовать это никак не получается | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus;
type
TForm1 = class(TForm)
Image1: TImage;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
procedure Image1Click(Sender: TObject);
procedure image1mousedown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
{ procedure DrawLine4Connected(x1,y1,x2,y2 : Integer); }
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure N9Click(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
cl,tk,tb:boolean;
fx,fy,px,py,pfx,pfy:integer;
implementation
{$R *.dfm}
procedure TForm1.Image1Click(Sender: TObject);
var
p: TPoint;
i:integer;
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y); // Áåðåì êîîðäèíàòû
p := Image1.ScreenToClient(p); // ïðåîáðàçóåì èõ â ëîêàëüíûå
if cl=false then
begin
Image1.Canvas.MoveTo(p.X, p.Y);
fx:=p.x;
fy:=p.y;
cl:=true;
{ tb:=true;}
end;
{ if cl=true then
begin
Image1.Canvas.lineto(p.X, p.Y); // îòîáðàæàåì
cl:=false;
end;
}
end;
procedure TForm1.image1mousedown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p: TPoint;
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y); // Áåðåì êîîðäèíàòû
p := Image1.ScreenToClient(p); // ïðåî
fx:=p.x;
fy:=p.y;
tb:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
tk:=false;
cl:=false;
tb:=false;
Image1.Canvas.brush.Color := clwhite;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawLine4Connected(x1,y1,x2,y2 : Integer;col:tcolor);
var
x, y, dx, dy, sx, sy, z, e, i : Integer;
Ch,cl : Boolean;
begin
x := x1;
y := y1;
dx := Abs(x2-x1);
dy := Abs(y2-y1);
If x2-x1>0 then sx:=1 else sx:=-1;
If y2-y1>0 then sy:=1 else sy:=-1;
e := 2*dy-dx;
Ch:=dy>=dx;
if Ch then begin
z := dx;
dx := dy;
dy := z;
end;
i := 1;
repeat
{if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then }
image1.Canvas.Pixels[x, y]:=col;
if e<dx then begin
if Ch then y := y+sy else x := x+sx;
e := e+2*dy;
end
else begin
if Ch then x := x+sx else y := y+sy;
e := e-2*dx;
end;
i := i+1;
until i>dx+dy;
{ if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then }
image1.Canvas.Pixels[x, y]:=col;
end;
var
p: TPoint;
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y);
p := Image1.ScreenToClient(p);
if tb=false then
DrawLine4Connected(pfx,pfy,px,py ,clwhite);
{Image1.Canvas.lineto(fx,fy);}
if cl=true then
begin
tb:=false;
DrawLine4Connected(fx,fy,p.X,p.Y ,clblack);
px:=p.x;
py:=p.y;
pfx:=fx;
pfy:=fy;
end;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Image1.Canvas.FillRect(Image1.ClientRect);
cl:=false;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{ cl:=false; }
end;
procedure TForm1.Image1DblClick(Sender: TObject);
begin
cl:=false;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
tk:=true;
end;
end.
|
вот собственно программа. | Код |
procedure DrawLine4Connected(x1,y1,x2,y2 : Integer;col:tcolor);
var
x, y, dx, dy, sx, sy, z, e, i : Integer;
Ch,cl : Boolean;
begin
x := x1;
y := y1;
dx := Abs(x2-x1);
dy := Abs(y2-y1);
If x2-x1>0 then sx:=1 else sx:=-1;
If y2-y1>0 then sy:=1 else sy:=-1;
e := 2*dy-dx;
Ch:=dy>=dx;
if Ch then begin
z := dx;
dx := dy;
dy := z;
end;
i := 1;
repeat
{if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then }
image1.Canvas.Pixels[x, y]:=col;
if e<dx then begin
if Ch then y := y+sy else x := x+sx;
e := e+2*dy;
end
else begin
if Ch then x := x+sx else y := y+sy;
e := e-2*dx;
end;
i := i+1;
until i>dx+dy;
{ if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then }
image1.Canvas.Pixels[x, y]:=col;
end;
|
процедура для рисования линии по точкам.Проблема в том как узнать цвет пикселя который хотим закрасить? |
"протягивание" линии от выбранной точки, проблема линии затирают друг друга 
Загрузка ...
