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

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)
• Xvcl.Controls.pas (modified) (11 diffs)

branches/Xvcl

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

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

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;
 

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