Недавно добавленные исходники

•  Animation Loaders  807

•  DeLiKaTeS Tetris (Тетрис)  5 773

•  TDictionary Custom Sort  7 729

•  Fast Watermark Sources  7 408

•  3D Designer  10 630

•  Sik Screen Capture  7 944

•  Patch Maker  8 162

•  Айболит (remote control)  8 212

•  ListBox Drag & Drop  7 018

•  Доска для игры Реверси  100 390

•  Графические эффекты  8 286

•  Рисование по маске  7 661

•  Перетаскивание изображений  6 267

•  Canvas Drawing  6 641

•  Рисование Луны  6 564

•  Поворот изображения  5 721

•  Рисование стержней  4 660

•  Paint on Shape  3 362

•  Генератор кроссвордов  4 331

•  Головоломка Paletto  3 489

•  Теорема Монжа об окружностях  4 304

•  Пазл Numbrix  2 783

•  Заборы и коммивояжеры  3 711

•  Игра HIP  2 503

•  Игра Go (Го)  2 495

•  Симулятор лифта  2 890

•  Программа укладки плитки  2 323

•  Генератор лабиринта  3 049

•  Проверка числового ввода  2 554

•  HEX View  2 958

 
скрыть

  Форум  

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

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



Delphi Sources

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



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




Похожие по теме исходники

Примеры работы с БД

Примеры оформления DBGrid

Пример использования DBGrid




Copyright © 2004-2026 "Delphi Sources" by «SiteAnalyzer». Delphi World FAQ

Группа ВКонтакте