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

Timestamp:

May 8, 2013, 1:52:33 PM (11 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.Forms.pas (modified) (3 diffs)

branches/Xvcl/Xvcl.Forms.pas

@@ -8 +8 @@
 type
   TForm = class(TWinControl)
+  private
+    FFocused: Boolean;
+    procedure SetFocused(const Value: Boolean);
   protected
     function GetVideoDevice: TVideoDevice; override;
   public
+  const
+    TitleBarHeight = 24;
+  var
     Screen: TObject; // TScreen;
     Caption: string;
+    function HandleMessage(Message: TMessage): Boolean; override;
     procedure Paint; override;
+    property Focused: Boolean read FFocused write SetFocused;
   end;
 
@@ -50 +58 @@
 end;
 
+function TForm.HandleMessage(Message: TMessage): Boolean;
+var
+  TitleBarBounds: TRectangle;
+begin
+  Result := False;
+  if Message is TMessageMouseDown then
+  with TMessageMouseDown(Message) do begin
+    TitleBarBounds := TRectangle.Create(0, 0, Bounds.Width, TitleBarHeight);
+    if TitleBarBounds.Contains(ScreenToClient(Position)) then begin
+      Focused := True;
+      Result := True;
+      Move.StartControlPos := Bounds.TopLeft;
+      Move.StartMousePos := Position;
+      Move.Active := True;
+    end;
+  end else
+  if Message is TMessageMouseUp then
+  with TMessageMouseUp(Message) do begin
+    Move.Active := False;
+  end else
+  if Message is TMessageMouseMove then
+  with TMessageMouseUp(Message) do begin
+    if Move.Active then begin
+      Bounds.TopLeft := Move.StartControlPos + (Position - Move.StartMousePos);
+      TScreen(Screen).Paint;
+    end;
+  end;
+  if not Result then inherited;
+end;
+
 procedure TForm.Paint;
-const
-  TitleBarHeight = 24;
 begin
-  inherited;
   with Canvas do begin
+    Canvas.Brush.Color := clWhite;
+    Canvas.FillRect(TRectangle.Create(0, TitleBarHeight, Size.X, Size.Y));
+    if Focused then Brush.Color := clLightBlue else
+      Brush.Color := clSilver;
+    FillRect(TRectangle.Create(0, 0, Bounds.Width - 1, TitleBarHeight));
     MoveTo(TPoint.Create(0, 0));
     LineTo(TPoint.Create(Bounds.Width - 1, 0));
@@ -66 +106 @@
       (TitleBarHeight - GetTextSize(Caption).Y) div 2), Caption);
   end;
+  inherited;
+end;
+
+procedure TForm.SetFocused(const Value: Boolean);
+begin
+  FFocused := Value;
+  Paint;
 end;