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

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

Пунктирная линия [D7, WinXP]

I m A ©   (2004-12-12 04:48:00) 

как сделать так, чтобы штрихи были одной длины не зависимо от скорости и угла движения мыши... если у кого есть другие идеи... делитесь... :) буду признательна за любую помощь.
var
   Flag: Boolean;
 Pt: TPoint;

{$R *.dfm}

procedure TForm1.imMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
 var i,j:integer;
begin
if Flag then
 begin
  with Im do //im - image
   begin
  canvas.Pen.Width:=1;
  j:=(x+y)mod 8;
if (j>=2) and (j<=4) then begin
Canvas.Brush.Style := bsClear;
canvas.MoveTo(x,y);
   end
else begin
canvas.Brush.Style:=bssolid;
 Canvas.Pen.Style := pssolid;
    Canvas.LineTo(X, Y);
   end;
end;
 end;
end;

procedure TForm1.imMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
 begin
  Flag := True;
  Pt := Point(X, Y);
  with Im do
   begin
//    Canvas.Pen.Color:=clwhite;
     Canvas.MoveTo(X, Y);
   end;
 end;
 end;

procedure TForm1.imMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if Flag then
 begin
  Flag := False;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
form1.DoubleBuffered:=true;
end;

end.

---

MBo   (2004-12-15 07:16:00) [1]

Ну вот как для TImage можно изменить:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls;

type
 TForm1 = class(TForm)
   Image1: TImage;
   procedure FormCreate(Sender: TObject);
   procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

const
 Dash2: Integer = Sqr(10);

var
 Form1: TForm1;
 lastKey: TPoint;
 DoDash: Boolean;
 DashCasche: TPoint;

implementation

{$R *.dfm}

procedure DrawPointOfLine(x, y: Integer; lpData: LParam); stdcall;
begin
 with TImage(lpData) do begin
   if Sqr(X - lastKey.X) + Sqr(Y - lastKey.Y) < Dash2
     then Exit else
   begin
     if DoDash then
     begin
       Canvas.MoveTo(lastKey.X, lastKey.Y);
       Canvas.LineTo(x, y);
       lastKey := Point(x, y);
       DoDash := False;
     end
     else
     begin
       lastKey := Point(x, y);
       DoDash := True;
     end;
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 lastKey := Point(-1, -1);
 DoubleBuffered := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if ssLeft in Shift then
 begin
   if (Sqr(X - lastKey.X) + Sqr(Y - lastKey.Y)) < Dash2 then
     Exit else
   begin
     LineDDA(lastKey.X, lastKey.Y, X, Y, @DrawPointOfLine, Integer(Sender));
   end;
 end;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 lastKey := Point(X, Y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 lastKey := Point(-1, -1);
end;

end.



---

I m A   (2004-12-15 06:31:00) [2]

блин... :(((((
опять та же феня

---

I m A   (2004-12-15 06:20:00) [3]

разобралась

---

I m A   (2004-12-15 04:17:00) [4]

Вот только возникла маленькая загвостка:(
я немного модернизировала Ваш код так, чтобы он рисовал на имаджине...
поменяла процедуры и  with TObject(lpData) as TmainForm do begin
на TImage...
но в строке  
if Round(Sqrt(Sqr(X - lastKey.X) + Sqr(Y - lastKey.Y))) < Dash then
     Exit else begin linedda(lastKey.X, lastKey.Y, X, Y, @DrawPointOfLine, Integer(Self));

выдается ошибка
statment expected, but expression of type 'TSpeedButton' found

а если не менять Tmainform, то он вообще не рисует...
подскажите, может я что-то где-то упустила :(

---

I m A   (2004-12-15 01:03:00) [5]

Большое спасибо, Михаил ;)

---

Mihey_temporary   (2004-12-12 20:09:00) [6]

Нужно использовать LineDDA и немного математики.


unit mainUnit;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;

type
 TmainForm = class(TForm)
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure FormCreate(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

const
 Dash: Integer = 10;

var
 mainForm: TmainForm;
 lastKey: TPoint;
 DoDash: Boolean;
 DashCasche: TPoint;

procedure DrawPointOfLine(x, y: Integer; lpData: LParam); stdcall;

implementation

{$R *.DFM}

procedure DrawPointOfLine(x, y: Integer; lpData: LParam);
begin
 with TObject(lpData) as TmainForm do begin
   If Round(Sqrt(Sqr(X - lastKey.X) + Sqr(Y - lastKey.Y))) < Dash
     then Exit else
  begin
   if DoDash then
   begin
     Canvas.MoveTo(lastKey.X, lastKey.Y);
     Canvas.LineTo(x, y);
     lastKey := Point(x, y);
     DoDash := False;
   end
    else
     begin
      lastKey := Point(x, y);
      DoDash := True;
     end;
 end;
 end;
end;

procedure TmainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if ssLeft in Shift then
 begin
 // Если в радиусе Dash, то не рисуем
   if Round(Sqrt(Sqr(X - lastKey.X) + Sqr(Y - lastKey.Y))) < Dash then
     Exit else
   begin
     LineDDA(lastKey.X, lastKey.Y, X, Y, @DrawPointOfLine, Integer(Self));
   end;
 end;
end;

procedure TmainForm.FormCreate(Sender: TObject);
begin
 lastKey := Point(-1, -1);
end;

procedure TmainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 lastKey := Point(X, Y);
end;

procedure TmainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 lastKey := Point(-1, -1);
end;

end.


Исходник с откомпилированным проектом:
http://www.hot.ee/mvps15/LineDraw.rar
Скриншот программы в действии:
http://www.hot.ee/mvps15/screen1.png

---

Наверх