Пример реализации резиновой нити

Delphi , Графика и Игры , Графика

unit Main;

interface

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

type
  TMainForm = class(TForm)
    ColorDlg: TColorDialog;
    StatusBar: TStatusBar;
    Timer: TTimer;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TimerTimer(Sender: TObject);
  private
    MouseRect: TRect;
    IsDown: Boolean;
    RectColor: TColor;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    with MouseRect do
    begin
      IsDown := True;
      Left := X;
      Top := Y;
      Right := X;
      Bottom := Y;
      Canvas.Pen.Color := RectColor;
    end;
  if (Button = mbRight) and ColorDlg.Execute
    then RectColor := ColorDlg.Color;
end;

procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := False;
  Canvas.Pen.Color := Color;
  with MouseRect do
    Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
      Point(Left, Bottom), Point(Left, Top)]);
  with StatusBar do
  begin
    Panels[4].Text := '';
    Panels[5].Text := '';
  end;
end;

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  with StatusBar do
  begin
    Panels[2].Text := 'X: ' + IntToStr(X);
    Panels[3].Text := 'Y: ' + IntToStr(Y);
  end;
  if not IsDown then Exit;
  Canvas.Pen.Color := Color;
  with mouserect do
  begin
    Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
      Point(Left, Bottom), Point(Left, Top)]);
    Right := X;
    Bottom := Y;
    Canvas.Pen.Color := RectColor;
    Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
      Point(Left, Bottom), Point(Left, Top)]);
  end;
  with StatusBar do
  begin
    Panels[4].Text := 'Ширина: ' + IntToStr(Abs(MouseRect.Right - MouseRect.Left));
    Panels[5].Text := 'Высота: ' + IntToStr(Abs(MouseRect.Bottom - MouseRect.Top));
  end;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
begin
  with StatusBar do
  begin
    Panels[0].Text := 'Дата: ' + DateToStr(Now);
    Panels[1].Text := 'Время: ' + TimeToStr(Now);
  end;
end;

end.

Эта проект Delphi демонстрирует реализацию эффекта "rubber banding", также известного как инструмент "lasso" или "rubber band". Программа позволяет пользователю нарисовать прямоугольник на форме, кликнув и перетаскивая мышь.

Вот разбивка кода:

Основная форма Основная форма определена как TMainForm, которая наследуется от TForm. Она имеет несколько компонентов, включая диалог цветов (ColorDlg), полосу состояния (StatusBar) и таймер (Timer).

Процедуры событий В этой форме определены четыре процедуры событий:

1. FormMouseDown: Эта процедура вызывается при клике мыши. Если левая кнопка мыши была нажата, она устанавливает флаг IsDown в значение True и инициализирует переменную MouseRect текущим положением мыши. Если правая кнопка мыши была нажата, она открывает диалог цветов.
2. FormMouseUp: Эта процедура вызывается при отпускании кнопки мыши. Она устанавливает флаг IsDown в значение False, очищает предыдущий прямоугольник и обновляет полосу состояния.
3. FormMouseMove: Эта процедура вызывается при перемещении мыши, когда левая кнопка мыши нажата. Она обновляет переменную MouseRect новым положением мыши и перерисовывает прямоугольник на форме. Она также обновляет полосу состояния с текущими координатами и размерами прямоугольника.
4. TimerTimer: Эта процедура вызывается каждую секунду (из-за настройки интервала таймера). Она обновляет полосу состояния с текущим временем.

Имплементация Секция реализации содержит код для каждой процедуры событий. Код относительно прост, но есть несколько заметных точек:

• В FormMouseDown программа устанавливает цвет кисти в выбранный цвет из диалога цветов.
• В FormMouseUp программа очищает предыдущий прямоугольник и обновляет полосу состояния.
• В FormMouseMove программа перерисовывает прямоугольник на форме с помощью метода Polyline. Она также обновляет полосу состояния с текущими координатами и размерами прямоугольника.

Заключение Этот проект демонстрирует основной эффект "rubber banding" в Delphi, позволяя пользователям рисовать прямоугольники на форме, кликнув и перетаскивая мышь. Код относительно прост, но он демонстрирует некоторые общепринятые техники, используемые в программировании графики, такие как использование метода Polyline для рисования форм и обновления полосы состояния с реал-тим информацией.

Пример реализации программы на языке Delphi, которая позволяет рисовать резиновую нить на форме при помощи левого и правого кликов мыши.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Графика ::