Показать сообщение отдельно
  #17  
Старый 17.10.2008, 20:47
lmikle lmikle вне форума
Модератор
 
Регистрация: 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
Ответить с цитированием