Changeset 23 for branches/Xvcl/Xvcl.Kernel.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.Kernel.pas (modified) (8 diffs)

branches/Xvcl/Xvcl.Kernel.pas

@@ -8 +8 @@
 type
   TKernel = class;
+  TScreen = class;
 
   TProcessState = (psReady, psRunning, psWaiting, psFinished);
@@ -24 +25 @@
     procedure Initialize; virtual;
     procedure Finalize; virtual;
+  end;
+
+  TScreenCanvas = class(TCanvas)
+    Screen: TScreen;
+    function GetVideoDevice: TVideoDevice; override;
   end;
 
@@ -45 +51 @@
   TMouse = class
     Kernel: TKernel;
+    procedure HandleMove(Position: TPoint);
     procedure HandleDown(Position: TPoint);
     procedure HandleUp(Position: TPoint);
@@ -144 +151 @@
   inherited;
   Forms := TList<TForm>.Create;
-  Canvas := TCanvas.Create;
+  Canvas := TScreenCanvas.Create;
 end;
 
@@ -158 +165 @@
   Form: TForm;
 begin
+  Canvas.Brush.Color := clWhite;
+  Canvas.FillRect(TRectangle.Create(0, 0, Size.X, Size.Y));
   for Form in Forms do Form.Paint;
 end;
@@ -203 +212 @@
 var
   Form: TForm;
-  NewMessage: TMessageMouse;
+  NewMessage: TMessageMouseDown;
 begin
   NewMessage := TMessageMouseDown.Create;
   NewMessage.Position := Position;
   try
-    for Form in Kernel.Screen.Forms do begin
+    for Form in Kernel.Screen.Forms do
+    if Form.Bounds.Contains(Position) then begin
       if Form.HandleMessage(NewMessage) then begin
         Break;
@@ -218 +228 @@
 end;
 
-procedure TMouse.HandleUp(Position: TPoint);
-var
-  Form: TForm;
-  NewMessage: TMessageMouse;
-begin
-  NewMessage := TMessageMouseUp.Create;
+procedure TMouse.HandleMove(Position: TPoint);
+var
+  Form: TForm;
+  NewMessage: TMessageMouseMove;
+begin
+  NewMessage := TMessageMouseMove.Create;
   NewMessage.Position := Position;
   try
-    for Form in Kernel.Screen.Forms do begin
+    for Form in Kernel.Screen.Forms do
+    if Form.Bounds.Contains(Position) then begin
       if Form.HandleMessage(NewMessage) then begin
         Break;
@@ -236 +247 @@
 end;
 
+procedure TMouse.HandleUp(Position: TPoint);
+var
+  Form: TForm;
+  NewMessage: TMessageMouseUp;
+begin
+  NewMessage := TMessageMouseUp.Create;
+  NewMessage.Position := Position;
+  try
+    for Form in Kernel.Screen.Forms do
+    if Form.Bounds.Contains(Position) then begin
+      if Form.HandleMessage(NewMessage) then begin
+        Break;
+      end;
+    end;
+  finally
+    NewMessage.Destroy;
+  end;
+end;
+
+{ TScrenCanvas }
+
+function TScreenCanvas.GetVideoDevice: TVideoDevice;
+begin
+  if Assigned(Screen) then Result := Screen.VideoDevice
+    else Result := nil;
+end;
+
 end.