Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #16  
Старый 17.10.2008, 17:53
maddamo4ka maddamo4ka вне форума
Прохожий
 
Регистрация: 13.10.2008
Сообщения: 42
Репутация: 10
По умолчанию

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

Код:
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

Последний раз редактировалось Admin, 17.10.2008 в 19:18.
Ответить с цитированием
  #17  
Старый 17.10.2008, 20:47
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Вот код, задающий 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
Ответить с цитированием
  #18  
Старый 17.10.2008, 21:47
terehovk terehovk вне форума
Новичок
 
Регистрация: 29.08.2008
Сообщения: 51
Репутация: 10
По умолчанию

Цитата:
Сообщение от 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.
Ответить с цитированием
  #19  
Старый 18.10.2008, 15:46
maddamo4ka maddamo4ka вне форума
Прохожий
 
Регистрация: 13.10.2008
Сообщения: 42
Репутация: 10
По умолчанию

Спасибо всем кто помогает))
Ответить с цитированием
  #20  
Старый 19.10.2008, 05:13
maddamo4ka maddamo4ka вне форума
Прохожий
 
Регистрация: 13.10.2008
Сообщения: 42
Репутация: 10
По умолчанию

Цитата:
Сообщение от 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.
кстати код точно такой же как у меня..так что он не работает
Ответить с цитированием
  #21  
Старый 19.10.2008, 05:15
maddamo4ka maddamo4ka вне форума
Прохожий
 
Регистрация: 13.10.2008
Сообщения: 42
Репутация: 10
По умолчанию

lmikle, что это за типы объектов?
pnToolBar: TPanel;
btGetVecors: TButton;
pnBottom: TPanel;
pbDraw: TPaintBox;
btMult: TButton;
Ответить с цитированием
  #22  
Старый 20.10.2008, 12:37
AlexSku AlexSku вне форума
Специалист
 
Регистрация: 07.05.2007
Адрес: Москва
Сообщения: 884
Репутация: 21699
По умолчанию

Цитата:
Сообщение от maddamo4ka
а ошибку выдает в MouseMove: Statement expected but 'PROCEDURE' found и тоже самое в MouseDown
Это произошло потому, что процедура DrawShape не закончилась (2 раза 'begin' и только один 'end').
Ответить с цитированием
  #23  
Старый 21.10.2008, 16:00
maddamo4ka maddamo4ka вне форума
Прохожий
 
Регистрация: 13.10.2008
Сообщения: 42
Репутация: 10
По умолчанию

теперь ошибка в MoseDown и MoseUp
Ответить с цитированием
  #24  
Старый 21.10.2008, 16:57
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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

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

Сохрани код в файл .pas, а форму в файл .dfm и открой в Дельфе. И все увидишь. (Естественно, имя у файла должно быть одно, только расширения разные).
Ответить с цитированием
  #25  
Старый 21.10.2008, 16:58
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Если хочешь, скажи мыло, кину исходники и собраный экзешник.
Ответить с цитированием
  #26  
Старый 21.10.2008, 18:53
beched beched вне форума
Прохожий
 
Регистрация: 07.10.2008
Сообщения: 1
Репутация: 10
По умолчанию

Хех, по-моему неправильно поставлен сам вопрос: я никогда в жизни не слышал о "компланарных" векторах.. Может речь идёт о коллинеарных?))
Ответить с цитированием
  #27  
Старый 21.10.2008, 19:26
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию


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

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


Взято c http://www.bymath.net/studyguide/alg/sec/alg25.html
Единственное, непонятно почему 3...
Ответить с цитированием
  #28  
Старый 21.10.2008, 19:34
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Кста, прочитав, понял, что, видимо, нужно именно векторное произведение, а не скалярное. Соответсвенно, с этой страницы надо взять формулу и привести ее для компланарных векторов (т.е. третья координата = 0).
Ответить с цитированием
  #29  
Старый 21.10.2008, 19:42
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,036
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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

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

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


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:27.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter