
17.10.2008, 20:47
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,087
Версия 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
|