Рисование линий на TImage

← →
Alll (2007-03-28 16:46) [0]

Добрый день. подскажите что нужно подправить в этом коде(у меня есть разметка на Timage точки через каждые десять пикселей подобно тому как выглядит форма делфи на этапе конструирования и линии рисуется у меня рывками от точки к точке) но мне нужно чтобы линии рисовались
также только чтобы они рисовались вертикально и горизотально, а не от любой точке к точке. Подскажите пожалуйста.
var
sl,st:string;
X0,Y0,X1,Y1:integer;
kx,ky:integer;
```````````````````````````````````````````
procedure TForm1.PoligonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with Poligon.Canvas do begin
sl:=IntToStr(X div 10)+"0";
st:=IntToStr(Y div 10)+"0";
X0:=StrToInt(sl);
Y0:=StrToInt(st);
if CompliteButton.Down then begin
{режим линии}
X1:=StrToInt(sl);
Y1:=StrToInt(st);
Pen.Mode:=pmNotXor;
Pen.Color:=clblack;
end;
end;

end;

procedure TForm1.PoligonMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Xd,Yd:integer;
begin
sl:=IntToStr(X div 10)+"0";
st:=IntToStr(Y div 10)+"0";

Xd:=StrToInt(sl);
Yd:=StrToInt(st);
kx:=x; ky:=y;
if not (ssLeft in Shift) then exit;
if CompliteButton.Down then begin
if not (ssLeft in Shift) then exit;
X:=StrToInt(sl);
Y:=StrToInt(st);
{режим линии}
with Poligon.Canvas do begin
{стирание прежней линии}
MoveTo(X0,Y0);
LineTo(X1,Y1);
{рисование новой линии}
MoveTo(X0,Y0);
LineTo(X,Y);
{запоминание новых координат конца линии}
X1:=X;
Y1:=Y;
end;
end;
end;

procedure TForm1.PoligonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if CompliteButton.Down then begin
with Poligon.Canvas do begin
sl:=IntToStr(X div 10)+"0";
st:=IntToStr(Y div 10)+"0";
X:=StrToInt(sl); Y:=StrToInt(st);
MoveTo(X0,Y0);
LineTo(X1,Y1);
Pen.Mode:=pmCopy;
MoveTo(X0,Y0);
LineTo(X,Y);
end;
end;
end;

← →
Сергей М. © (2007-03-28 17:01) [1]

> только чтобы они рисовались вертикально и горизотально

А ты не дергай мыша никуда в иные направления, кроме вертикального и горизонтального, тогда и будет тебе "только ... вертикально и горизотально"

← →
Alll (2007-03-28 17:05) [2]

Спасибо вам за мудрый совет, а вдруг рука дрогнет?

← →
Leonid Troyanovsky © (2007-03-28 18:05) [3]

> Alll (28.03.07 17:05) [2]

> Спасибо вам за мудрый совет, а вдруг рука дрогнет?

Надо меньше пить.
Наконец, ты ж не нейрохирург.

--
Regards, LVT.

← →
Alll (2007-03-28 18:22) [4]

Ну подскажите как сделать !!!

← →
TRUNK © (2007-03-28 18:59) [5]

> [4] Alll (28.03.07 18:22)

Сначала переделай вот это:

sl:=IntToStr(X div 10)+"0";
st:=IntToStr(Y div 10)+"0";
X0:=StrToInt(sl);
Y0:=StrToInt(st);

чтоб людей не пугать.

← →
Alll (2007-03-28 21:46) [6]

Если бы я знал как то бы неприменно переделал. Подскажите как плиз ну плиз

← →
RASkov (2007-03-28 21:53) [7]

X0 = X-(x mod 10)

← →
Alll (2007-03-28 22:24) [8]

Заменил я это всё на ваше выражение(работает всё так же), а как же
всё таки сделать чтобы как я задавал в вопросе. Может вы не поняли вопрос
нужно чтобы было так: (к примеру 1)начинаю римсовать линию с точки
[10,10] 2) веду эту линию и если курсор в точке(100,99 и меньше) то линия рисуется горизонтально а если (99 и меньше, 100) то линия рисуется вертикально

← →
Virgo_Style © (2007-03-28 22:38) [9]

if |deltaX|>|deltaY| then горизонтально else вертикально, я так понимаю

← →
Alll (2007-03-28 22:52) [10]

Я тоже так понимаю, но в силу не очень глубокого знания программирования не знаю как это сделать

← →
RASkov (2007-03-28 23:11) [11]

> [8] Alll (28.03.07 22:52)

Диагональных лини не должно быть или как? Я вот вообще не понял, что в итоге у тебя должно получится

Т.е. можно так:
|
|
|
|___________

и нельзя так

\
\
\
\
\__________

Так ли это?

← →
Alll (2007-03-29 01:11) [12]

Да да именно так

← →
RASkov (2007-03-29 01:43) [13]

> [12] Alll (29.03.07 01:11)

type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; XCen, YCen, OldX, OldY: Integer; const CELLSIZE = 10; implementation {$R *.dfm} procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button<>mbLeft then Exit; XCen:=X-(X mod CELLSIZE); YCen:=Y-(Y mod CELLSIZE); OldX:=XCen; OldY:=YCen; Canvas.Pen.Mode:=pmNotXor; Canvas.Ellipse(XCen-2, YCen-2, XCen+2, YCen+2); end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var X1, Y1: Integer; begin if not (ssLeft in Shift) then Exit; Canvas.MoveTo(XCen, YCen); Canvas.LineTo(OldX, OldY); X1:=X-(X mod CELLSIZE); Y1:=Y-(Y mod CELLSIZE); Canvas.MoveTo(XCen, YCen); if ABS(XCen-X1)<ABS(YCen-Y1) then begin Canvas.LineTo(XCen, Y1); OldX:=XCen; OldY:=Y1; end else begin Canvas.LineTo(X1, YCen); OldX:=X1; OldY:=YCen; end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var X1, Y1: Integer; begin if Button<>mbLeft then Exit; Canvas.Ellipse(XCen-2, YCen-2, XCen+2, YCen+2); Canvas.MoveTo(XCen, YCen); Canvas.LineTo(OldX, OldY); X1:=X-(X mod CELLSIZE); Y1:=Y-(Y mod CELLSIZE); Canvas.Pen.Mode:=pmCopy; Canvas.MoveTo(XCen, YCen); if ABS(XCen-X1)<ABS(YCen-Y1) then Canvas.LineTo(XCen, Y1) else Canvas.LineTo(X1, YCen); end;

← →
Alll (2007-03-29 02:28) [14]

Спасибо

← →
RASkov (2007-03-29 03:07) [15]

Блин, зажгло :)

type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; XCen, YCen, OldX, OldY: Integer; const CELLSIZE = 10; HALFCELLSIZE = CELLSIZE div 2; implementation {$R *.dfm} procedure CorrectXY(const FromX, FromY: Integer; var ToX, ToY: Integer; const Diag: Boolean=False); var CorrectX, CorrectY: Integer; begin CorrectX:=(FromX mod CELLSIZE); CorrectY:=(FromY mod CELLSIZE); ToX:=FromX-CorrectX; if CorrectX>HALFCELLSIZE then INC(ToX, CELLSIZE); ToY:=FromY-CorrectY; if CorrectY>HALFCELLSIZE then INC(ToY, CELLSIZE); if Diag then if ABS(XCen-ToX) > ABS(YCen-ToY) then ToY:=YCen else ToX:=XCen; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button<>mbLeft then Exit; CorrectXY(X, Y, XCen, YCen, True); OldX:=XCen; OldY:=YCen; Canvas.Pen.Mode:=pmNotXor; Canvas.Ellipse(XCen-HALFCELLSIZE, YCen-HALFCELLSIZE, XCen+HALFCELLSIZE, YCen+HALFCELLSIZE); end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if not (ssLeft in Shift) then Exit; Canvas.MoveTo(XCen, YCen); Canvas.LineTo(OldX, OldY); CorrectXY(X, Y, X, Y, True); Canvas.MoveTo(XCen, YCen); Canvas.LineTo(X, Y); OldX:=X; OldY:=Y; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button<>mbLeft then Exit; Canvas.Ellipse(XCen-HALFCELLSIZE, YCen-HALFCELLSIZE, XCen+HALFCELLSIZE, YCen+HALFCELLSIZE); Canvas.MoveTo(XCen, YCen); Canvas.LineTo(OldX, OldY); CorrectXY(X, Y, X, Y, True); Canvas.Pen.Mode:=pmCopy; Canvas.Pen.Width:=2; Canvas.MoveTo(XCen, YCen); Canvas.LineTo(X, Y); Canvas.Pen.Width:=1; end; procedure TForm1.FormPaint(Sender: TObject); var W, H: Integer; begin for W :=0 to ClientWidth do for H := 0 to ClientHeight do if ((W mod CELLSIZE)=0) and ((H mod CELLSIZE)=0) then Canvas.Pixels[W, H]:=clBlack; end;

Рисование линий на TImage Найти похожие ветки