Moving a TLabel at TPanel
lazarus / 10-Designer

----------------------------------------------------------------------
Mujie · 2009-10-25 04:01

Hi,
I have a problem here. I have a 3 objects/components at TPanel :
TImage, TButton and TLabel. When I move them at TPanel, they went
smoothly except TLabel. Sometimes when I move my mouse too fast,
TLabel likes leave behind until I put my mouse cursor at TLabel again
for move it. I used Lazarus 0.9.29.

I try the code with Delphi 7 and there is no problem.

Here is the code :

Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics,
Dialogs,
  ExtCtrls, LCLIntf, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    StaticText1: TStaticText;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer
      );
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer
      );
    procedure Label1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StaticText1MouseDown(Sender: TObject; Button:
TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StaticText1MouseMove(Sender: TObject; Shift:
TShiftState; X,
      Y: Integer);
    procedure StaticText1MouseUp(Sender: TObject; Button:
TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
    FDownPoint: TPoint;
    FDragging: Boolean;
    FAllowDrag: Boolean;

  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure TForm1.Image1MouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   begin
     FDragging := True;
     GetCursorPos(FDownPoint);
     FDownPoint.X := FDownPoint.X - Image1.Left;
     FDownPoint.Y := FDownPoint.Y - Image1.Top;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FAllowDrag := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X,
  Y: Integer);
var
  MovePoint : TPoint;
begin
  if FDragging and FAllowDrag then
   begin
     GetCursorPos(MovePoint);
     Image1.SetBounds(
       MovePoint.X - FDownPoint.X,
       MovePoint.Y - FDownPoint.Y,
       Image1.Width, Image1.Height
     );
   end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   FDragging := False;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   begin
     FDragging := True;
     GetCursorPos(FDownPoint);
     FDownPoint.X := FDownPoint.X - Label1.Left;
     FDownPoint.Y := FDownPoint.Y - Label1.Top;
   end;
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState;
X,
  Y: Integer);
var
  MovePoint : TPoint;
begin
  if FDragging and FAllowDrag then
   begin
     GetCursorPos(MovePoint);
     Label1.SetBounds(
       MovePoint.X - FDownPoint.X,
       MovePoint.Y - FDownPoint.Y,
       Label1.Width, Label1.Height
     );
     Label1.Update;
     Label2.Caption := 'X: '+ IntToStr(Label1.Left) +' '+'Y: '+
IntToStr(Label1.Top);
   end;
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   FDragging := False;
end;

procedure TForm1.StaticText1MouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   begin
     FDragging := True;
     GetCursorPos(FDownPoint);
     FDownPoint.X := FDownPoint.X - StaticText1.Left;
     FDownPoint.Y := FDownPoint.Y - StaticText1.Top;
   end;
end;

procedure TForm1.StaticText1MouseMove(Sender: TObject; Shift:
TShiftState; X,
  Y: Integer);
var
  MovePoint : TPoint;
begin
  if FDragging and FAllowDrag then
   begin
     GetCursorPos(MovePoint);
     StaticText1.SetBounds(
       MovePoint.X - FDownPoint.X,
       MovePoint.Y - FDownPoint.Y,
       StaticText1.Width, StaticText1.Height
     );
   end;
end;

procedure TForm1.StaticText1MouseUp(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
   FDragging := False;
end;

initialization
  {$I unit1.lrs}

end.

Could it be fixed  ?

Thanks for your assistances.

----------------------------------------------------------------------
Mujie · 2009-10-26 04:15

Hi, any clue ?

Or, where I can see TLabel source code ?

----------------------------------------------------------------------
Leledumbo · 2009-10-26 05:37

I don't know what's wrong but you can see the source code under lcl
directory of your lazarus installation.

----------------------------------------------------------------------
Mujie · 2009-10-26 06:15

Thx mas Leledumbo

I found it, named stdctrls.pp, TLabel used TGraphicControl class.
Unfortunately, I dont know what should I do 

Did you think this is a bug or something? If so, then I will submit
this at bug tracker.