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

•  DeLiKaTeS Tetris (Тетрис)  166

•  TDictionary Custom Sort  3 340

•  Fast Watermark Sources  3 093

•  3D Designer  4 849

•  Sik Screen Capture  3 348

•  Patch Maker  3 554

•  Айболит (remote control)  3 664

•  ListBox Drag & Drop  3 016

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

•  Графические эффекты  3 946

•  Рисование по маске  3 250

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

•  Canvas Drawing  2 754

•  Рисование Луны  2 584

•  Поворот изображения  2 191

•  Рисование стержней  2 169

•  Paint on Shape  1 569

•  Генератор кроссвордов  2 239

•  Головоломка Paletto  1 767

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

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 057

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 219

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 367

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


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-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

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