Форум: "Media";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];
Внизрисование на канве Найти похожие ветки
← →
@ndrew © (2004-04-08 14:01) [0]Подскажите, как можно нарисовать линию, на канве, т.е. начало линии зафиксировать, о конец линии направить куда необходимо, чтобы визуально отображалась линия...
← →
Алхимик © (2004-04-08 14:22) [1]Canvas, MoveTo, LineTo + F1
← →
MBo © (2004-04-08 14:22) [2]F1 по методам TCanvas
← →
@ndrew © (2004-04-08 14:30) [3]да что-то непонятно немного, можно поджробней
← →
MBo © (2004-04-08 14:35) [4]можно узнать, что именно непонятно?
← →
Gero © (2004-04-08 17:42) [5]Canvas.MoveTo(X_Начала, Y_Начала);
Canvas.LineTo(X_Конца, Y_Конца);
И так не понятно?
← →
@ndrew © (2004-04-09 06:56) [6]да нет, может я не правильно выразился, начало линии при нажатии кнопки мыши фиксируется, а конец линии направить в необходимое место, ну как в Corel сделано, чтобы он мог перемещаться...вобщем вот.
← →
MBo © (2004-04-09 07:21) [7]Логика работает?
1. При нажатии кнопки записываем координаты начальной точки и выставляем флаг "состояние рисования"
2. при движении мыши проверяем флаг, при установленном стираем старую линию (например, перо в xor-mode - тогда достаточно нарисовать ее по старым координатам еще раз).Обновляем кооординаты конца, рисуем новую линию
3. при отпускании кнопки сбрасываем флаг.
← →
Думкин © (2004-04-09 07:22) [8]> @ndrew © (09.04.04 06:56) [6]
Задача звучит так: Я хочу нарисовать линию на некотором холсте. При этом я хочу это сделать следующим образом:
1. Подведя курсор к нужной точке одиночным нажатием фиксируем начало отрезка.
2. Теперь при движении курсора над холстом, за ним прицепом ходит конец отрезка, соответственно отрезок постоянно меняется в соответствии с движением курсора.
3. Повторным нажатием фиксируем второй конец.
Извиняюсь у Профсоюза телепатов, что вышел из отпуска вопреки уставу. :((
← →
@ndrew © (2004-04-09 07:33) [9]
> MBo
это у меня есть...
> Думкин
вот именно это и нужно реализовавть, сорри за невнятность...:(
у меня получается, но получается только одна линия...а мне надо несколько...
← →
@ndrew © (2004-04-09 10:00) [10]ну что никто не может подсказать???
← →
Petro (2004-04-09 11:46) [11]Сказано достаточно.
Несколько.... одного и того же - это Цикл (for, while, ... или твой собственный на MouseDown см. F1).
Организуй цикл (для начала в два :) отрезка). Потом перейдёш на 3 отрезка :).
← →
Petro (2004-04-09 11:48) [12]ДААААААА!
Не забудь потом выйти из цикла :) (например на 2 щелчка или Ввод (Enter)).
← →
@ndrew © (2004-04-09 14:55) [13]я делаю так, как можно это переделать?
type new = record
figure : string[10];
color_l : TColor;
_xs : integer;
_ys : integer;
_xe : array[1..100] of integer;
_ye : array[1..100] of integer;
end;
var
Form1: TForm1;
draw, line, circle:boolean;
_xst, _yst, _x, _y, _i:integer;
l_ine:new;
f:file of new;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
draw:=false;
_i:=1;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
Canvas.Moveto(_xst,_yst);
if line then Canvas.LineTo(_x,_y);
if Circle then Canvas.Ellipse(_xst, _yst, _x,_y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
StatusBar1.Panels[0].Text:=inttostr(x);
StatusBar1.Panels[1].Text:=inttostr(y);
Canvas.Refresh;
_x:=x;
_y:=y;
if draw then
begin
Canvas.Moveto(_xst,_yst);
canvas.fillrect(canvas.cliprect);
if line then Canvas.LineTo(_x,_y);
if Circle then Canvas.Ellipse(_xst, _yst, _x,_y);
l_ine._xe[_i]:=x;
l_ine._ye[_i]:=y;
_i:=_i+1;
end
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if draw then
begin
Canvas.MoveTo(_xst,_yst);
if line then Canvas.LineTo(_x,_y);
if Circle then Canvas.Ellipse(_xst, _yst, _x,_y);
draw:=false;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
draw:=true;
_xst:=x;
_yst:=y;
Canvas.Moveto(_xst,_yst);
l_ine._xs:=_xst;
l_ine._ys:=_yst;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
line:=true;
circle:=false;
l_ine.figure:="line";
Form1.Cursor:=crCross
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
line:=false;
circle:=true;
l_ine.figure:="circle";
Form1.Cursor:=crCross
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate
end;
procedure TForm1.Saveas1Click(Sender: TObject);
begin
if Save.Execute then
begin
AssignFile(f, Save.FileName);
Rewrite(f);
Write(f, l_ine);
CloseFile(f);
end;
end;
procedure TForm1.Loadfile1Click(Sender: TObject);
var i:byte;
begin
if Open.Execute then
begin
AssignFile(f, Open.FileName);
Reset(f);
Read(f,l_ine);
if l_ine.figure="line" then
begin
for i:=1 to 100 do
begin
if l_ine._xe[i]=0 then exit;
Canvas.Pen.Color:=l_ine.color_l;
Canvas.MoveTo(l_ine._xs,l_ine._ys);
Canvas.LineTo(l_ine._xe[i], l_ine._ye[i]);
end;
CloseFile(f);
end;
if l_ine.figure="circle" then
begin
for i:=1 to 100 do
begin
if l_ine._xe[i]=0 then exit;
Canvas.Pen.Color:=l_ine.color_l;
Canvas.Ellipse(l_ine._xs, l_ine._ys, l_ine._xe[i], l_ine._ye[i]);
end;
CloseFile(f);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
canvas.fillrect(canvas.cliprect);
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Canvas.Pen.Color:=ColorGrid1.ForegroundColor;
l_ine.color_l:=ColorGrid1.ForegroundColor;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
Form1.Color:=ColorGrid1.ForegroundColor;
end;
end.
← →
@ndrew © (2004-04-10 07:55) [14]ну кто выскажется по-поводу написанного??? ну помогите разобраться...
← →
Думкин © (2004-04-10 18:03) [15]В грубом варианте, можно так:
type
TfMain = class(TForm)
pbMain : TPaintBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure pbMainClick(Sender: TObject);
private
{ Private declarations }
x1,x2 : TPoint;
inDraw : boolean;
bm : TBitMap;
procedure WMPaint (var Message: TWMPaint); message WM_Paint;
public
{ Public declarations }
end;
var
fMain: TfMain;
implementation
{$R *.dfm}
procedure TfMain.FormCreate(Sender: TObject);
begin
bm := TBitMap.Create;
bm.Width := pbMain.Width;
bm.Height := pbMain.Height;
bm.Canvas.Pen.Color := clRed;
bm.Canvas.Brush.Color := clYellow;
bm.Canvas.FloodFill( 1, 1, clWhite, fsSurface);
pbMain.Canvas.Pen.Color := clBlue;
pbMain.Canvas.Pen.Style := psDot;
inDraw := false
end;
procedure TfMain.FormDestroy(Sender: TObject);
begin
bm.Free
end;
procedure TfMain.WMPaint;
begin
BitBlt(pbMain.Canvas.Handle,
0, 0, pbMain.Width, pbMain.Height,
bm.Canvas.Handle,
0, 0, SRCCOPY);
if inDraw then begin
x2 := pbMain.ScreenToClient(Mouse.CursorPos);
pbMain.Canvas.MoveTo( x1.X, x1.Y);
pbMain.Canvas.LineTo( x2.X, x2.Y)
end
end;
procedure TfMain.pbMainClick(Sender: TObject);
begin
inDraw := not(inDraw);
if inDraw then
x1 := pbMain.ScreenToClient(Mouse.CursorPos)
else begin
x2 := pbMain.ScreenToClient(Mouse.CursorPos);
bm.Canvas.MoveTo( x1.X, x1.Y);
bm.Canvas.LineTo( x2.X, x2.Y)
end
end;
Есть ряд недостатков, но все в твоих руках.
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.043 c