Changeset 14 for os/trunk/Xvcl/Xvcl.Controls.pas

Timestamp:

Feb 29, 2016, 5:23:37 PM (8 years ago)

Author:

chronos

Message:

• Modified: TForm title bar implemented using controls.

File:

• os/trunk/Xvcl/Xvcl.Controls.pas (modified) (12 diffs)

os/trunk/Xvcl/Xvcl.Controls.pas

@@ -33 +33 @@
     States: TKeyStateSet;
   end;
+
+  TMouseNotifyEvent = procedure (Sender: TObject; Position: TPoint;
+    Buttons: TMouseButtonSet) of object;
 
   TControlCanvas = class(TCanvas)
@@ -57 +60 @@
     FOnClick: TNotifyEvent;
     FColor: TColor;
-    FOnMouseDown: TNotifyEvent;
-    FOnMouseUp: TNotifyEvent;
+    FOnMouseDown: TMouseNotifyEvent;
+    FOnMouseUp: TMouseNotifyEvent;
+    FOnMouseMove: TMouseNotifyEvent;
     FOnKeyPress: TNotifyEvent;
     FFocused: Boolean;
@@ -69 +73 @@
     function HandleMessage(Message: TMessage): Boolean; virtual;
   public
-    Move: TControlMove;
     function ClientToScreen(Position: TPoint): TPoint; virtual;
     function ScreenToClient(Position: TPoint): TPoint; virtual;
@@ -83 +86 @@
     property Focused: Boolean read FFocused write SetFocused;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
-    property OnMouseDown: TNotifyEvent read FOnMouseDown write FOnMouseDown;
-    property OnMouseUp: TNotifyEvent read FOnMouseUp write FOnMouseUp;
+    property OnMouseDown: TMouseNotifyEvent read FOnMouseDown write FOnMouseDown;
+    property OnMouseUp: TMouseNotifyEvent read FOnMouseUp write FOnMouseUp;
+    property OnMouseMove: TMouseNotifyEvent read FOnMouseMove write FOnMouseMove;
     property OnKeyPress: TNotifyEvent read FOnKeyPress write FOnKeyPress;
   end;
@@ -119 +123 @@
     procedure Paint; override;
     property Caption: string read FCaption write SetCaption;
+    constructor Create; override;
   end;
 
@@ -147 +152 @@
 begin
   inherited;
-  Move := TControlMove.Create;
   FColor := clWhite;
 end;
@@ -153 +157 @@
 destructor TControl.Destroy;
 begin
-  Move.Destroy;
   if Assigned(FCanvas) then FCanvas.Destroy;
   inherited;
@@ -176 +179 @@
 begin
   Result := False;
+  if Message is TMessageMouseDown then
+  with TMessageMouseDown(Message) do begin
+    if Assigned(FOnMouseDown) then begin
+      FOnMouseDown(Self, Position, Buttons);
+      Result := True;
+    end;
+  end else
+  if Message is TMessageMouseUp then
+  with TMessageMouseUp(Message) do begin
+    if Assigned(FOnMouseUp) then begin
+      FOnMouseUp(Self, Position, Buttons);
+      Result := True;
+    end;
+  end else
+  if Message is TMessageMouseMove then
+  with TMessageMouseMove(Message) do begin
+    if Assigned(FOnMouseMove) then begin
+      FOnMouseMove(Self, Position, Buttons);
+      Result := True;
+    end;
+  end;
 end;
 
 procedure TControl.Paint;
 begin
+  if Color <> clNone then
   with Canvas do begin
     Brush.Color := Color;
@@ -189 +214 @@
 begin
   Result := Position.Substract(Bounds.TopLeft);
-  if Assigned(Parent) then Result := Parent.ClientToScreen(Result);
+  if Assigned(Parent) then Result := Parent.ScreenToClient(Result);
 end;
 
@@ -220 +245 @@
 begin
   Result := False;
-  if Message is TMessageMouseDown then begin
-    if Assigned(FOnMouseDown) then FOnMouseDown(Self);
+  if Message is TMessageMouseDown then
+  with TMessageMouseDown(Message) do begin
+    if Assigned(FOnMouseDown) then FOnMouseDown(Self, Position, Buttons);
     Color := clGray;
     Paint;
     Result := True;
   end else
-  if Message is TMessageMouseUp then begin
-    if Assigned(FOnMouseUp) then FOnMouseUp(Self);
+  if Message is TMessageMouseUp then
+  with TMessageMouseUp(Message) do begin
+    if Assigned(FOnMouseUp) then FOnMouseUp(Self, Position, Buttons);
     Color := clSilver;
     Paint;
@@ -321 +348 @@
       end;
   end;
+  if not Result then inherited;
 end;
 
@@ -332 +360 @@
 
 { TLabel }
+
+constructor TLabel.Create;
+begin
+  inherited;
+  Color := clNone;
+end;
 
 procedure TLabel.Paint;