Changeset 23

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.

Location:

branches/Xvcl

Files:

• Applications (modified) (1 prop)
• Applications/TestApplication.pas (modified) (2 diffs)
• Drivers/Driver.MouseVCL.pas (modified) (3 diffs)
• Drivers/Driver.VideoVCL.pas (modified) (1 diff)
• Xvcl.Classes.pas (modified) (5 diffs)
• Xvcl.Controls.pas (modified) (7 diffs)
• Xvcl.Forms.pas (modified) (3 diffs)
• Xvcl.Generics.pas (modified) (2 diffs)
• Xvcl.Graphics.pas (modified) (3 diffs)
• Xvcl.Kernel.pas (modified) (8 diffs)

branches/Xvcl/Applications/TestApplication.pas

@@ -8 +8 @@
 type
   TTestApplication = class(TApplication)
-    Form: TForm;
+    Form1: TForm;
+    Form2: TForm;
     Button: TButton;
     Label1: TLabel;
@@ -31 +32 @@
 procedure TTestApplication.Run;
 begin
-  Form := TForm.Create;
-  Form.Bounds := TRectangle.Create(50, 50, 100, 100);
-  Form.Name := 'Form1';
-  Form.Caption := 'Test application';
-  Form.Screen := Screen;
+  Form1 := TForm.Create;
+  Form1.Bounds := TRectangle.Create(50, 50, 100, 100);
+  Form1.Name := 'Form1';
+  Form1.Caption := 'Test application';
+  Form1.Screen := Screen;
+  Form2 := TForm.Create;
+  Form2.Bounds := TRectangle.Create(250, 150, 200, 150);
+  Form2.Name := 'Form1';
+  Form2.Caption := 'Test application';
+  Form2.Screen := Screen;
   Button := TButton.Create;
-  Button.Parent := Form;
+  Button.Parent := Form1;
   Button.Bounds := TRectangle.Create(50, 50, 60, 24);
   Button.Visible := True;
   Button.Caption := 'Start';
   Button.OnClick := ButtonClick;
-  Form.Controls.Add(Button);
+  Form1.Controls.Add(Button);
   Label1 := TLabel.Create;
-  Label1.Parent := Form;
+  Label1.Parent := Form1;
   Label1.Bounds := TRectangle.Create(50, 70, 60, 24);
   Label1.Visible := True;
   Label1.Caption := '0';
-  Form.Controls.Add(Label1);
-  TScreen(Screen).Forms.Add(Form);
+  Form1.Controls.Add(Label1);
+  Form2.Controls.Add(Label1);
+  TScreen(Screen).Forms.Add(Form1);
   TScreen(Screen).Paint;
 end;

branches/Xvcl/Drivers/Driver.MouseVCL.pas

@@ -13 +13 @@
     procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
+    procedure DoMouseMove(Sender: TObject; Shift: TShiftState;
+      X, Y: Integer);
   public
     Form: Vcl.Forms.TForm;
@@ -25 +27 @@
 begin
   Kernel.Mouse.HandleDown(TPoint.Create(X, Y));
+end;
+
+procedure TDriverMouseVCL.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  Kernel.Mouse.HandleMouseMove(TPoint.Create(X, Y));
 end;
 
@@ -45 +53 @@
   TForm1(Form).Image1.OnMouseDown := DoMouseDown;
   TForm1(Form).Image1.OnMouseUp := DoMouseUp;
+  TForm1(Form).Image1.OnMouseMove := DoMouseMove;
 end;
 

branches/Xvcl/Drivers/Driver.VideoVCL.pas

@@ -56 +56 @@
 begin
   case Color of
-    clBlack: Result := Vcl.Graphics.clBlack;
-    clWhite: Result := Vcl.Graphics.clWhite;
-    clBlue: Result := Vcl.Graphics.clBlue;
-    clGreen: Result := Vcl.Graphics.clGreen;
-    clRed: Result := Vcl.Graphics.clRed;
-    clSilver: Result := Vcl.Graphics.clSilver;
-    clGray: Result := Vcl.Graphics.clGray;
-    else Result := Vcl.Graphics.clBlack;
+    clBlack: Result := $000000;
+    clWhite: Result := $ffffff;
+    clBlue: Result := $ff0000;
+    clGreen: Result := $00ff00;
+    clRed: Result := $0000ff;
+    clSilver: Result := $c0c0c0;
+    clGray: Result := $808080;
+    clLightBlue: Result := $ff8080;
+    clLightRed: Result := $80ff80;
+    clLightGreen: Result := $8080ff;
+    clBrown: Result := $a52a2a;
+    clMagenta: Result := $ff00ff;
+    clCyan: Result := $00ffff;
+    clYellow: Result := $ffff00;
+    else Result := $000000;
   end;
 end;

branches/Xvcl/Xvcl.Classes.pas

@@ -11 +11 @@
     function Substract(Point: TPoint): TPoint;
     function IsZero: Boolean;
+    class operator Add(A, B: TPoint): TPoint;
+    class operator Subtract(A, B: TPoint): TPoint;
   end;
 
@@ -57 +59 @@
   TNotifyEvent = procedure (Sender: TObject) of object;
 
+  TUpdateLock = class
+  private
+    FOnUpdate: TNotifyEvent;
+  published
+    Counter: Integer;
+    procedure Start;
+    procedure Stop;
+    procedure Update;
+    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
+  end;
+
 
 implementation
@@ -157 +170 @@
 end;
 
+class operator TPoint.Add(A, B: TPoint): TPoint;
+begin
+  Result.X := A.X + B.X;
+  Result.Y := A.Y + B.Y;
+end;
+
 constructor TPoint.Create(X, Y: Integer);
 begin
@@ -169 +188 @@
 end;
 
+class operator TPoint.Subtract(A, B: TPoint): TPoint;
+begin
+  Result.X := A.X - B.X;
+  Result.Y := A.Y - B.Y;
+end;
+
 function TPoint.Substract(Point: TPoint): TPoint;
 begin
@@ -174 +199 @@
 end;
 
+{ TUpdateLock }
+
+procedure TUpdateLock.Start;
+begin
+  Inc(Counter);
+end;
+
+procedure TUpdateLock.Stop;
+begin
+  if Counter > 0 then begin
+    Dec(Counter);
+    Update;
+  end;
+end;
+
+procedure TUpdateLock.Update;
+begin
+  if (Counter = 0) and Assigned(FOnUpdate) then
+    FOnUpdate(Self);
+end;
+
 end.

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 }
 

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;
 

branches/Xvcl/Xvcl.Generics.pas

@@ -4 +4 @@
 
 type
-  TList<T> = class;
-
-
-
   TList<T> = class
   private
@@ -35 +31 @@
 implementation
 
-{ TListEnumerator<T> }
+{ TList<T>.TEnumerator }
 
 function TList<T>.TEnumerator.GetCurrent: T;

branches/Xvcl/Xvcl.Graphics.pas

@@ -8 +8 @@
 type
 
-  TColor = (clNone, clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed);
+  TColor = (clNone, clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed,
+    clLightBlue, clLightRed, clLightGreen, clBrown, clYellow, clMagenta, clCyan);
 
   TPen = class
@@ -115 +116 @@
 function TCanvas.GetVideoDevice: TVideoDevice;
 begin
-  Result := nil;
+  Result := FVideoDevice;
 end;
 
@@ -138 +139 @@
 begin
   if Assigned(VideoDevice) then VideoDevice.SetPixel(Position, Color);
+end;
+
+procedure TCanvas.SetVideoDevice(const Value: TVideoDevice);
+begin
+  FVideoDevice := Value;
 end;
 

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.