Po dvou dílech, ve kterých jsme se zabývali soubory MP3, se dnes podíváme opět na něco jiného. Tentokrát budeme pomocí myši posouvat text po formuláři.
Poněkud zamlžený úvod si hned podrobněji vysvětlíme. Příklad, který si teď ukážeme, bude dělat jednoduchou věc. Po kliknutí na formulář se na daném místě objeví textový popisek (Label). Tento Label pak budeme moci po formuláři libovolně přesunovat myší ve stylu drag and drop. Takovýchto Labelů si budete moci na formulář "naklikat" kolik budete chtít, protože jsou vytvářeny až za běhu programu.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
private
{ Private declarations }
downX, downY: Integer;
dragging: Boolean;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TMCapture = Class(TControl);


procedure TForm1.FormClick(Sender: TObject);
var
pt: TPoint;
begin
GetCursorPos( pt );
pt := ScreenToClient( pt );
with TLabel.Create( Self ) do
begin
SetBounds(pt.x, pt.y, width, height);
Caption := Format('Souřadnice %d, %d', [pt.x, pt.y]);
Color := clBlue;
Font.Color := clWhite;
Autosize := True;
Parent := Self;
OnMouseDown := ControlMouseDown;
OnMouseUp := ControlMouseUp;
OnMouseMove := ControlMouseMove;
end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX := X;
downY := Y;
dragging := True;
with TMCapture(Sender) do
begin
MouseCapture := True;
Color := clRed;
end;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if dragging then
with Sender as TControl do
begin
Left := X - downX + Left;
Top := Y - downY + Top;
end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if dragging then
begin
dragging := False;
with TMCapture(Sender) do
begin
MouseCapture := False;
Color := clBlue;
end;
end;
end;

end.