Changeset 23 for branches/Xvcl/Xvcl.Controls.pas

Timestamp:

May 8, 2013, 1:52:33 PM (12 years ago)

Author:

chronos

Message:

• Added: Support for mouse move handling. Now forms can be moved by dragging title bar.
• Fixed: Clearing background during painting in screen and forms.

File:

• branches/Xvcl/Xvcl.Controls.pas (modified) (7 diffs)

branches/Xvcl/Xvcl.Controls.pas

@@ -23 +23 @@
   TMessageMouseDown = class(TMessageMouse);
   TMessageMouseUp = class(TMessageMouse);
+  TMessageMouseMove = class(TMessageMouse);
 
   TKeyState = (ksShift, ksAlt, ksOS);
@@ -37 +38 @@
     Control: TControl;
     function AdjustPos(Position: TPoint): TPoint; override;
+  end;
+
+  TControlMove = class
+    Control: TControl;
+    StartControlPos: TPoint;
+    StartMousePos: TPoint;
+    Active: Boolean;
   end;
 
@@ -54 +62 @@
   protected
     function GetVideoDevice: TVideoDevice; virtual;
-  public
-    Controls: TList<TControl>;
     function HandleMessage(Message: TMessage): Boolean; virtual;
+  public
+    Move: TControlMove;
     function ClientToScreen(Position: TPoint): TPoint; virtual;
     function ScreenToClient(Position: TPoint): TPoint; virtual;
@@ -75 +83 @@
   TWinControl = class(TControl)
   protected
+    function HandleMessage(Message: TMessage): Boolean; override;
   public
     Controls: TList<TControl>;
-    function HandleMessage(Message: TMessage): Boolean; override;
+    procedure Paint; override;
     constructor Create; override;
     destructor Destroy; override;
@@ -115 +124 @@
 begin
   inherited;
-  Controls := TList<TControl>.Create;
+  Move := TControlMove.Create;
 end;
 
 destructor TControl.Destroy;
 begin
-  Controls.Destroy;
+  Move.Destroy;
   if Assigned(FCanvas) then FCanvas.Destroy;
   inherited;
@@ -159 +168 @@
 
 procedure TControl.Paint;
-var
-  C: TControl;
-begin
-  for C in Controls do C.Paint;
+begin
 end;
 
@@ -267 +273 @@
 end;
 
+procedure TWinControl.Paint;
+var
+  C: TControl;
+begin
+  inherited;
+  for C in Controls do C.Paint;
+end;
+
 { TLabel }