скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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



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.
Скачать весь проект





Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook