умножение компланарных векторов

maddamo4ka · #16 17.10.2008, 17:53

код выглядит так:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  Image1: TImage;
  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;

var
  Form1: TForm1;
  Image1:TImage;
  X:Integer;
  Y:Integer;
  Origin,  MovePt: TPoint;
  Drawing: boolean;

implementation

{$R *.dfm}

procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode);
begin
with Form1.Image1.Canvas do begin
Pen.Mode :=AMode;
MoveTo(TopLeft.X, TopLeft.Y);
LineTo(BottomRight.X,BottomRight.Y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Drawing=true then begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Image1.Canvas.MoveTo(X, Y);
 Origin := Point(X, Y);
 MovePt := Origin;
 Drawing := true;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := false;
end;

end.

Admin: Для оформления кода пользуемся тегами, иначе последуют санкции!

а ошибку выдает в MouseMove: Statement expected but 'PROCEDURE' found и тоже самое в MouseDown

lmikle · #17 17.10.2008, 20:47

Вот код, задающий 2 вектора (извини, стрелки лень рисовать), а потом совмещающий их начала. Дальше, думаю, сама разберешься.

Код:

unit Unit1;

interface

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

type
  TVector = record
    ABegin : TPoint;
    AEnd : TPoint;
  end;

  TForm1 = class(TForm)
    pnToolBar: TPanel;
    btGetVecors: TButton;
    pnBottom: TPanel;
    pbDraw: TPaintBox;
    btMult: TButton;
    procedure pbDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btGetVecorsClick(Sender: TObject);
    procedure pbDrawClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btMultClick(Sender: TObject);
    procedure pbDrawPaint(Sender: TObject);
  private
    { Private declarations }
    FMode : Integer;
    FV1, FV2 : TVector;
    procedure DrawV(AV : TVector);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.pbDrawMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  pnBottom.Caption := Format('X=%d; Y=%d',[X,Y]);
end;

procedure TForm1.btGetVecorsClick(Sender: TObject);
begin
  ShowMessage('Вы вошли в режим ввода векторов.'#13#10'Для ввода первого вектора щелкните по точке его начала, а затем по точке его конца.');
  FMode := 1;
end;

procedure TForm1.pbDrawClick(Sender: TObject);
begin
  Case FMode Of
    1 : // 1st point
      Begin
        FV1.ABegin := ScreenToClient(Mouse.CursorPos);
        FMode := 2;
      End;
    2 : // 2nd point
      Begin
        FV1.AEnd := ScreenToClient(Mouse.CursorPos);
        FMode := 3;
        pbDraw.Repaint;
        ShowMessage('Для ввода второго вектора щелкните по точке его начала, а затем по точке его конца.');
      End;
    3 : // 3rd point
      Begin
        FV2.ABegin := ScreenToClient(Mouse.CursorPos);
        FMode := 4;
      End;
    4 : // 4th point
      Begin
        FV2.AEnd := ScreenToClient(Mouse.CursorPos);
        pbDraw.Repaint;
        FMode := 5;
        pbDraw.Repaint;
        ShowMessage('Вы задади оба вектора. Можете начинать процедуру умножения.');
      End;
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMode := 0;
end;

procedure TForm1.btMultClick(Sender: TObject);
begin
  If FMode = 5
    Then
      Begin
        // First - move V2 to V1
        While (FV1.ABegin.X <> FV2.ABegin.X) Or
              (FV1.ABegin.Y <> FV2.ABegin.Y) Do
          Begin
            FV2.ABegin.X := FV2.ABegin.X - Sign(FV2.ABegin.X - FV1.ABegin.X);
            FV2.ABegin.Y := FV2.ABegin.Y - Sign(FV2.ABegin.Y - FV1.ABegin.Y);
            FV2.AEnd.X := FV2.AEnd.X - Sign(FV2.ABegin.X - FV1.ABegin.X);
            FV2.AEnd.Y := FV2.AEnd.Y - Sign(FV2.ABegin.Y - FV1.ABegin.Y);
            pbDraw.Repaint;
            Sleep(100);
          End;
      End
    Else
      ShowMessage('векторы не заданы. Умножение невозможно.');
end;

procedure TForm1.pbDrawPaint(Sender: TObject);
var
  R : TRect;
begin
  With pbDraw.Canvas Do
    Begin
      Brush.Color := clBtnFace;
      R := Rect(0,0,pbDraw.Width,pbDraw.Height);
      FillRect(R);

      If FMode >= 2 // We have V1
        Then DrawV(FV1);
      If FMode > 4 // We have V2
        Then DrawV(FV2);
    End;
end;

procedure TForm1.DrawV(AV: TVector);
begin
  // Draw vector AV
  With pbDraw.Canvas Do
    Begin
      Pen.Color := clBlack;
      MoveTo(AV.ABegin.X,AV.ABegin.Y);
      LineTo(AV.AEnd.X,AV.AEnd.Y);
    End;
end;

end.

Форма:

Код:

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 870
  Height = 640
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object pbDraw: TPaintBox
    Left = 0
    Top = 41
    Width = 862
    Height = 535
    Align = alClient
    OnClick = pbDrawClick
    OnMouseMove = pbDrawMouseMove
    OnPaint = pbDrawPaint
  end
  object pnToolBar: TPanel
    Left = 0
    Top = 0
    Width = 862
    Height = 41
    Align = alTop
    BevelInner = bvLowered
    TabOrder = 0
    object btGetVecors: TButton
      Left = 8
      Top = 8
      Width = 137
      Height = 25
      Caption = 'Задать векторы'
      TabOrder = 0
      OnClick = btGetVecorsClick
    end
    object btMult: TButton
      Left = 152
      Top = 8
      Width = 145
      Height = 25
      Caption = 'Умножить векторы'
      TabOrder = 1
      OnClick = btMultClick
    end
  end
  object pnBottom: TPanel
    Left = 0
    Top = 576
    Width = 862
    Height = 30
    Align = alBottom
    BevelInner = bvLowered
    TabOrder = 1
  end
end

terehovk · #18 17.10.2008, 21:47

Цитата:

Сообщение от maddamo4ka

код выглядит так:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  Image1: TImage;
  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;

var
  Form1: TForm1;
  Image1:TImage;
  X:Integer;
  Y:Integer;
  Origin,  MovePt: TPoint;
  Drawing: boolean;

implementation

{$R *.dfm}

procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode);
begin
with Form1.Image1.Canvas do begin
Pen.Mode :=AMode;
MoveTo(TopLeft.X, TopLeft.Y);
LineTo(BottomRight.X,BottomRight.Y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Drawing=true then begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Image1.Canvas.MoveTo(X, Y);
 Origin := Point(X, Y);
 MovePt := Origin;
 Drawing := true;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := false;
end;

end.

Admin: Для оформления кода пользуемся тегами, иначе последуют санкции!

а ошибку выдает в MouseMove: Statement expected but 'PROCEDURE' found и тоже самое в MouseDown

исправь на

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  Image1: TImage;
  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;

var
  Form1: TForm1;
  Image1:TImage;
  X:Integer;
  Y:Integer;
  Origin,  MovePt: TPoint;
  Drawing: boolean;

implementation

{$R *.dfm}

procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode);
begin
with Form1.Image1.Canvas do begin
Pen.Mode :=AMode;
MoveTo(TopLeft.X, TopLeft.Y);
LineTo(BottomRight.X,BottomRight.Y);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Drawing=true then begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Image1.Canvas.MoveTo(X, Y);
 Origin := Point(X, Y);
 MovePt := Origin;
 Drawing := true;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := false;
end;

end.

maddamo4ka · #19 18.10.2008, 15:46

Спасибо всем кто помогает))

maddamo4ka · #20 19.10.2008, 05:13

Цитата:

Сообщение от terehovk

исправь на

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  Image1: TImage;
  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;

var
  Form1: TForm1;
  Image1:TImage;
  X:Integer;
  Y:Integer;
  Origin,  MovePt: TPoint;
  Drawing: boolean;

implementation

{$R *.dfm}

procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode);
begin
with Form1.Image1.Canvas do begin
Pen.Mode :=AMode;
MoveTo(TopLeft.X, TopLeft.Y);
LineTo(BottomRight.X,BottomRight.Y);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Drawing=true then begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Image1.Canvas.MoveTo(X, Y);
 Origin := Point(X, Y);
 MovePt := Origin;
 Drawing := true;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := false;
end;

end.

кстати код точно такой же как у меня..так что он не работает

maddamo4ka · #21 19.10.2008, 05:15

lmikle, что это за типы объектов?
pnToolBar: TPanel;
btGetVecors: TButton;
pnBottom: TPanel;
pbDraw: TPaintBox;
btMult: TButton;

AlexSku · #22 20.10.2008, 12:37

Цитата:

Сообщение от maddamo4ka

а ошибку выдает в MouseMove: Statement expected but 'PROCEDURE' found и тоже самое в MouseDown

Это произошло потому, что процедура DrawShape не закончилась (2 раза 'begin' и только один 'end').

maddamo4ka · #23 21.10.2008, 16:00

теперь ошибка в MoseDown и MoseUp

lmikle · #24 21.10.2008, 16:57

Цитата:

Сообщение от maddamo4ka

lmikle, что это за типы объектов?
pnToolBar: TPanel;
btGetVecors: TButton;
pnBottom: TPanel;
pbDraw: TPaintBox;
btMult: TButton;

А это просто панельки и кнопочки. Просто для красоты.
Ну и основная область, где происходит отрисовка (TPaintBox).
просто я их переименовал, что бы не путаться.

Сохрани код в файл .pas, а форму в файл .dfm и открой в Дельфе. И все увидишь. (Естественно, имя у файла должно быть одно, только расширения разные).

lmikle · #25 21.10.2008, 16:58

Если хочешь, скажи мыло, кину исходники и собраный экзешник.

beched · #26 21.10.2008, 18:53

Хех, по-моему неправильно поставлен сам вопрос: я никогда в жизни не слышал о "компланарных" векторах.. Может речь идёт о коллинеарных?))

lmikle · #27 21.10.2008, 19:26

Векторы называются коллинеарными, если их направленные отрезки лежат на параллельных прямых. Коллинеарные векторы a и b обозначаются a || b.

Три и более векторов называются компланарными, если они лежат в одной плоскости.

Взято c http://www.bymath.net/studyguide/alg/sec/alg25.html
Единственное, непонятно почему 3...

lmikle · #28 21.10.2008, 19:34

Кста, прочитав, понял, что, видимо, нужно именно векторное произведение, а не скалярное. Соответсвенно, с этой страницы надо взять формулу и привести ее для компланарных векторов (т.е. третья координата = 0).

lmikle · #29 21.10.2008, 19:42

Т.е. если выводить, то для двух вектров, у которых координата z = 0, их векторное произведение будет
a = (x,y,z)
b = (u,v,w)
[a,b] = k(xv - yu)

т.е. это вектор, перпендикулярный имеющимся, т.е. параллельный оси Z.
Отсюда и рисовать надо.

Фигня какая-то получается.
Т.е. надо либо задавать векторы аналитически (через TEdit, например), либо наворачивать в графике дофига разных возможностей.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты