Changeset 20

Timestamp:

May 6, 2013, 12:16:30 AM (12 years ago)

Author:

chronos

Message:

• Modified: Improved messages passing to controls.
• Modified: Now TButton change background color during mouse click.

Location:

branches/Xvcl

Files:

• . (modified) (1 prop)
• Drivers (modified) (1 prop)
• Drivers/Driver.MouseVCL.pas (modified) (2 diffs)
• Drivers/Driver.VideoVCL.pas (modified) (4 diffs)
• Xvcl.Classes.pas (modified) (4 diffs)
• Xvcl.Controls.pas (modified) (11 diffs)
• Xvcl.Graphics.pas (modified) (4 diffs)
• Xvcl.Kernel.pas (modified) (2 diffs)

branches/Xvcl

@@ -2 +2 @@
 *.local
 Win32
+__history

@@ -2 +2 @@
 *.local
 Win32
+__history

branches/Xvcl/Drivers/Driver.MouseVCL.pas

@@ -24 +24 @@
   Shift: TShiftState; X, Y: Integer);
 begin
-  Kernel.Mouse.HandleClick(TPoint.Create(X, Y));
+  Kernel.Mouse.HandleDown(TPoint.Create(X, Y));
 end;
 
@@ -30 +30 @@
   Shift: TShiftState; X, Y: Integer);
 begin
-
+  Kernel.Mouse.HandleUp(TPoint.Create(X, Y));
 end;
 

branches/Xvcl/Drivers/Driver.VideoVCL.pas

@@ -4 +4 @@
 
 uses
-  Vcl.Forms, Vcl.Graphics, UFormMain, Xvcl.Classes, Xvcl.Kernel, Xvcl.Graphics;
+  Vcl.Forms, Vcl.Graphics, System.Types, UFormMain, Xvcl.Classes, Xvcl.Kernel,
+  Xvcl.Graphics;
 
 type
@@ -16 +17 @@
     CanvasVCL: Vcl.Graphics.TCanvas;
     function ColorToVCL(Color: TColor): Vcl.Graphics.TColor;
+    procedure FillRect(Rect: TRectangle; Color: TColor); override;
     procedure Line(Pos1, Pos2: TPoint; Color: TColor); override;
     procedure TextOut(Position: TPoint; Text: string); override;
@@ -62 +64 @@
 end;
 
+procedure TVideoDeviceVCL.FillRect(Rect: TRectangle; Color: TColor);
+begin
+  inherited;
+  CanvasVCL.Brush.Color := ColorToVCL(Color);
+  CanvasVCL.FillRect(System.Types.Rect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom));
+end;
+
 function TVideoDeviceVCL.GetTextSize(Text: string): TPoint;
 begin
@@ -76 +85 @@
 procedure TVideoDeviceVCL.TextOut(Position: TPoint; Text: string);
 begin
+  CanvasVCL.Brush.Color := clNone;
   CanvasVCL.TextOut(Position.X, Position.Y, Text);
 end;

branches/Xvcl/Xvcl.Classes.pas

@@ -21 +21 @@
     function GetBottomLeft: TPoint;
     function GetBottomRight: TPoint;
-    function GetLeftTop: TPoint;
-    function GetRightTop: TPoint;
+    function GetTopLeft: TPoint;
+    function GetTopRight: TPoint;
+    procedure SetTopLeft(const Value: TPoint);
+    procedure SetBottomRight(const Value: TPoint);
+    procedure SetBottom(const Value: Integer);
+    procedure SetRight(const Value: Integer);
+    procedure SetTopRight(const Value: TPoint);
   public
     Left: Integer;
@@ -28 +33 @@
     Width: Integer;
     Height: Integer;
-    property Right: Integer read GetRight;
-    property Bottom: Integer read GetBottom;
+    property Right: Integer read GetRight write SetRight;
+    property Bottom: Integer read GetBottom write SetBottom;
     property Size: TPoint read GetSize;
     property Position: TPoint read GetPosition;
-    property LeftTop: TPoint read GetLeftTop;
-    property BottomRight: TPoint read GetBottomRight;
-    property RightTop: TPoint read GetRightTop;
+    property TopLeft: TPoint read GetTopLeft write SetTopLeft;
+    property BottomRight: TPoint read GetBottomRight write SetBottomRight;
+    property TopRight: TPoint read GetTopRight write SetTopRight;
     property BottomLeft: TPoint read GetBottomLeft;
     constructor Create(Left, Top, Width, Height: Integer);
@@ -86 +91 @@
 end;
 
-function TRectangle.GetLeftTop: TPoint;
+function TRectangle.GetTopLeft: TPoint;
 begin
   Result := TPoint.Create(Left, Top);
@@ -101 +106 @@
 end;
 
-function TRectangle.GetRightTop: TPoint;
+function TRectangle.GetTopRight: TPoint;
 begin
   Result := TPoint.Create(Right, Top);
+end;
+
+procedure TRectangle.SetBottom(const Value: Integer);
+begin
+  Height := Value - Top;
+end;
+
+procedure TRectangle.SetBottomRight(const Value: TPoint);
+begin
+  Right := Value.X;
+  Bottom := Value.Y;
+end;
+
+procedure TRectangle.SetRight(const Value: Integer);
+begin
+  Width := Value - Left;
+end;
+
+procedure TRectangle.SetTopLeft(const Value: TPoint);
+begin
+  Left := Value.X;
+  Top := Value.Y;
+end;
+
+procedure TRectangle.SetTopRight(const Value: TPoint);
+begin
+  Top := Value.X;
+  Right := Value.Y;
 end;
 

branches/Xvcl/Xvcl.Controls.pas

@@ -9 +9 @@
   TControl = class;
   TWinControl = class;
+
+  TMessage = class
+    Number: Integer;
+    Handled: Boolean;
+  end;
+
+  TMouseButton = (mbLeft, mbRight, mbMiddle);
+  TMouseButtonSet = set of TMouseButton;
+  TMessageMouse = class(TMessage)
+    Position: TPoint;
+    Buttons: TMouseButtonSet;
+  end;
+  TMessageMouseDown = class(TMessageMouse);
+  TMessageMouseUp = class(TMessageMouse);
+
+  TKeyState = (ksShift, ksAlt, ksOS);
+  TKeyStateSet = set of TKeyState;
+  TMessageKeyboard = class(TMessage)
+    KeyCode: Integer;
+    States: TKeyStateSet;
+  end;
 
   TControlCanvas = class(TCanvas)
@@ -25 +46 @@
     FBounds: TRectangle;
     FOnClick: TNotifyEvent;
+    FColor: TColor;
+    FOnMouseDown: TNotifyEvent;
+    FOnMouseUp: TNotifyEvent;
     function GetCanvas: TCanvas;
     procedure SetParent(const Value: TWinControl); virtual;
+    procedure SetColor(const Value: TColor);
   protected
     function GetVideoDevice: TVideoDevice; virtual;
   public
     Controls: TList<TControl>;
+    function HandleMessage(Message: TMessage): Boolean; virtual;
     function ClientToScreen(Position: TPoint): TPoint; virtual;
+    function ScreenToClient(Position: TPoint): TPoint; virtual;
     procedure Paint; virtual;
     constructor Create; override;
@@ -40 +67 @@
     property Parent: TWinControl read FParent write SetParent;
     property VideoDevice: TVideoDevice read GetVideoDevice;
+    property Color: TColor read FColor write SetColor;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
+    property OnMouseDown: TNotifyEvent read FOnMouseDown write FOnMouseDown;
+    property OnMouseUp: TNotifyEvent read FOnMouseUp write FOnMouseUp;
   end;
 
   TWinControl = class(TControl)
+  protected
+  public
     Controls: TList<TControl>;
-    function HandleClick(Position: TPoint): Boolean;
+    function HandleMessage(Message: TMessage): Boolean; override;
     constructor Create; override;
     destructor Destroy; override;
@@ -56 +88 @@
   public
     procedure Paint; override;
+    constructor Create; override;
     property Caption: string read FCaption write SetCaption;
   end;
@@ -75 +108 @@
 function TControl.ClientToScreen(Position: TPoint): TPoint;
 begin
-  Result := TPoint.Create(Bounds.Left + Position.X, Bounds.Top + Position.Y);
+  Result := Position.Add(Bounds.TopLeft);
   if Assigned(Parent) then Result := Parent.ClientToScreen(Result);
 end;
@@ -107 +140 @@
 end;
 
+function TControl.HandleMessage(Message: TMessage): Boolean;
+begin
+  if Message is TMessageMouseDown then begin
+    if Assigned(FOnMouseDown) then FOnMouseDown(Self);
+    Color := clGray;
+    Paint;
+  end else
+  if Message is TMessageMouseUp then begin
+    if Assigned(FOnMouseUp) then FOnMouseUp(Self);
+    Color := clSilver;
+    Paint;
+    if Assigned(FOnClick) then FOnClick(Self);
+  end;
+end;
+
 procedure TControl.Paint;
 var
@@ -112 +160 @@
 begin
   for C in Controls do C.Paint;
+end;
+
+function TControl.ScreenToClient(Position: TPoint): TPoint;
+begin
+  Result := Position.Substract(Bounds.TopLeft);
+  if Assigned(Parent) then Result := Parent.ClientToScreen(Result);
+end;
+
+procedure TControl.SetColor(const Value: TColor);
+begin
+  if FColor <> Value then begin
+    FColor := Value;
+    Paint;
+  end;
 end;
 
@@ -125 +187 @@
 { TButton }
 
+constructor TButton.Create;
+begin
+  inherited;
+  FColor := clSilver;
+end;
+
 procedure TButton.Paint;
 begin
   inherited;
   with Canvas do begin
+    Brush.Color := Color;
+    FillRect(TRectangle.Create(0, 0, Bounds.Width, Bounds.Height));
     MoveTo(TPoint.Create(0, 0));
     LineTo(TPoint.Create(Bounds.Width - 1, 0));
@@ -176 +246 @@
 end;
 
-function TWinControl.HandleClick(Position: TPoint): Boolean;
+function TWinControl.HandleMessage(Message: TMessage): Boolean;
 var
   Control: TControl;
@@ -182 +252 @@
   Result := False;
   for Control in Controls do begin
-    if Control.Bounds.Contains(Position) then begin
-      if Control is TWinControl then begin
-        if TWinControl(Control).HandleClick(Position.Substract(Bounds.LeftTop)) then begin
-          Result := True;
-          Break;
-        end;
-      end else
-      if Assigned(Control.OnClick) then begin
-        Control.OnClick(Self);
+    if Message is TMessageMouse then
+    with TMessageMouse(Message) do begin
+    if Control.Bounds.Contains(ScreenToClient(Position)) then begin
+      if TWinControl(Control).HandleMessage(Message) then begin
         Result := True;
         Break;
@@ -196 +261 @@
     end;
   end;
+  end;
 end;
 

branches/Xvcl/Xvcl.Graphics.pas

@@ -25 +25 @@
   TVideoDevice = class
     Size: TPoint;
+    procedure FillRect(Rect: TRectangle; Color: TColor); virtual;
     procedure Line(Pos1, Pos2: TPoint; Color: TColor); virtual;
     procedure SetPixel(Position: TPoint; Color: TColor); virtual;
@@ -49 +50 @@
     procedure SetPixel(Position: TPoint; Color: TColor);
     function GetPixel(Position: TPoint): TColor;
+    procedure FillRect(Rect: TRectangle);
     constructor Create;
     destructor Destroy; override;
@@ -90 +92 @@
   FPen.Destroy;
   inherited;
+end;
+
+procedure TCanvas.FillRect(Rect: TRectangle);
+begin
+  Rect.TopLeft := AdjustPos(Rect.TopLeft);
+  if Assigned(VideoDevice) then VideoDevice.FillRect(Rect, Brush.Color);
 end;
 
@@ -152 +160 @@
 { TVideoDevice }
 
+procedure TVideoDevice.FillRect(Rect: TRectangle; Color: TColor);
+begin
+
+end;
+
 function TVideoDevice.GetPixel(Position: TPoint): TColor;
 begin

branches/Xvcl/Xvcl.Kernel.pas

@@ -45 +45 @@
   TMouse = class
     Kernel: TKernel;
-    procedure HandleClick(Position: TPoint);
+    procedure HandleDown(Position: TPoint);
+    procedure HandleUp(Position: TPoint);
   end;
 
@@ -199 +200 @@
 { TMouse }
 
-procedure TMouse.HandleClick(Position: TPoint);
+procedure TMouse.HandleDown(Position: TPoint);
 var
   Form: TForm;
-begin
-  for Form in Kernel.Screen.Forms do begin
-    Form.HandleClick(Position.Substract(Form.Bounds.LeftTop));
+  NewMessage: TMessageMouse;
+begin
+  NewMessage := TMessageMouseDown.Create;
+  NewMessage.Position := Position;
+  try
+    for Form in Kernel.Screen.Forms do begin
+      if Form.HandleMessage(NewMessage) then begin
+        Break;
+      end;
+    end;
+  finally
+    NewMessage.Destroy;
+  end;
+end;
+
+procedure TMouse.HandleUp(Position: TPoint);
+var
+  Form: TForm;
+  NewMessage: TMessageMouse;
+begin
+  NewMessage := TMessageMouseUp.Create;
+  NewMessage.Position := Position;
+  try
+    for Form in Kernel.Screen.Forms do begin
+      if Form.HandleMessage(NewMessage) then begin
+        Break;
+      end;
+    end;
+  finally
+    NewMessage.Destroy;
   end;
 end;

@@ -2 +2 @@
 *.local
 Win32
+__history