| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

рисование на канве [D6, Win2k]

@ndrew ©   (2004-04-08 14:01:00) 

Подскажите, как можно нарисовать линию, на канве, т.е. начало линии зафиксировать, о конец линии направить куда необходимо, чтобы визуально отображалась линия...

---

Думкин   (2004-04-10 18:03:00) [1]

В грубом варианте, можно так:

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;

Есть ряд недостатков, но все в твоих руках.

---

@ndrew   (2004-04-10 07:55:00) [2]

ну кто выскажется по-поводу написанного??? ну помогите разобраться...

---

@ndrew   (2004-04-09 14:55:00) [3]

я делаю так, как можно это переделать?


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.


---

Petro   (2004-04-09 11:48:00) [4]

ДААААААА!
Не забудь потом выйти из цикла :) (например на 2 щелчка или Ввод (Enter)).

---

Petro   (2004-04-09 11:46:00) [5]

Сказано достаточно.
Несколько.... одного и того же - это Цикл (for, while, ... или твой собственный на MouseDown см. F1).
Организуй цикл (для начала в два :) отрезка). Потом перейдёш на 3 отрезка :).

---

@ndrew   (2004-04-09 10:00:00) [6]

ну что никто не может подсказать???

---

@ndrew   (2004-04-09 07:33:00) [7]

> MBo

это у меня есть...


> Думкин

вот именно это и нужно реализовавть, сорри за невнятность...:(
у меня получается, но получается только одна линия...а мне надо несколько...

---

Думкин   (2004-04-09 07:22:00) [8]

> @ndrew ©   (09.04.04 06:56) [6]

Задача звучит так: Я хочу нарисовать линию на некотором холсте. При этом я хочу это сделать следующим образом:
1. Подведя курсор к нужной точке одиночным нажатием фиксируем начало отрезка.
2. Теперь при движении курсора над холстом, за ним прицепом ходит конец отрезка, соответственно отрезок постоянно меняется в соответствии с движением курсора.
3. Повторным нажатием фиксируем второй конец.

Извиняюсь у Профсоюза телепатов, что вышел из отпуска вопреки уставу. :((

---

MBo   (2004-04-09 07:21:00) [9]

Логика работает?
1. При нажатии кнопки записываем координаты начальной точки и выставляем флаг "состояние рисования"
2. при движении мыши проверяем флаг, при установленном стираем старую линию (например, перо в xor-mode - тогда достаточно нарисовать ее по старым координатам еще раз).Обновляем кооординаты конца, рисуем новую линию
3. при отпускании кнопки сбрасываем флаг.

---

@ndrew   (2004-04-09 06:56:00) [10]

да нет, может я не правильно выразился, начало линии при нажатии кнопки мыши фиксируется, а конец линии направить в необходимое место, ну как в Corel сделано, чтобы он мог перемещаться...вобщем вот.

---

Gero   (2004-04-08 17:42:00) [11]

Canvas.MoveTo(X_Начала, Y_Начала);
Canvas.LineTo(X_Конца, Y_Конца);

И так не понятно?

---

MBo   (2004-04-08 14:35:00) [12]

можно узнать, что именно непонятно?

---

@ndrew   (2004-04-08 14:30:00) [13]

да что-то непонятно немного, можно поджробней

---

Алхимик   (2004-04-08 14:22:00) [14]

Canvas, MoveTo, LineTo + F1

---

MBo   (2004-04-08 14:22:00) [15]

F1 по методам TCanvas

---

Наверх