Changeset 210 for branches/highdpi/Packages/CevoComponents/DrawDlg.pas

Timestamp:

May 9, 2020, 4:02:07 PM (4 years ago)

Author:

chronos

Message:

• Modified: Improved HighDPI branch. Imported new changes from trunk branch.

File:

• branches/highdpi/Packages/CevoComponents/DrawDlg.pas (modified) (9 diffs)

branches/highdpi/Packages/CevoComponents/DrawDlg.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Forms, LCLIntf, LCLType, LMessages, Messages, Graphics,
-  Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools, UDpiControls;
+  UDpiControls, Classes, SysUtils, Forms, LCLIntf, LCLType, {$IFDEF LINUX}LMessages,{$ENDIF}
+  Messages, Graphics, Controls, ButtonBase, ButtonA, ButtonB, Area, ScreenTools;
 
 type
@@ -15 +15 @@
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     procedure SmartInvalidate; virtual;
+  private
+    MoveFormPos: TPoint;
+    MoveMousePos: TPoint;
+    MoveActive: Boolean;
+    procedure VisibleChangedHandler(Sender: TObject);
   protected
-    TitleHeight: integer;
+    TitleHeight: Integer;
     // defines area to grip the window for moving (from top)
     procedure InitButtons;
     procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;
     procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+      override;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseLeave; override;
   end;
 
@@ -58 +69 @@
   inherited;
   TitleHeight := 0;
+  MoveActive := False;
+  AddHandlerOnVisibleChanged(VisibleChangedHandler);
+end;
+
+destructor TDrawDlg.Destroy;
+begin
+  RemoveHandlerOnVisibleChanged(VisibleChangedHandler);
+  inherited Destroy;
 end;
 
@@ -98 +117 @@
 end;
 
+procedure TDrawDlg.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+  Y: Integer);
+{$IFDEF LINUX}
+var
+  MousePosNew: TPoint;
+  NewFormPos: TPoint;
+{$ENDIF}
+begin
+  inherited;
+  {$IFDEF LINUX}
+  // HitTest is not supported under Linux GTK2 so use form inside move mechanizm
+  NewFormPos := ScreenToClient(Mouse.CursorPos);
+  if (NewFormPos.X >= 0) and (NewFormPos.X < Width) and
+    (NewFormPos.Y >= 0) and (NewFormPos.Y < Height) then begin
+    MoveMousePos := ClientToScreen(Point(X, Y));
+    MoveFormPos := Point(Left, Top);
+    MousePosNew := Mouse.CursorPos;
+    // Activate move only if mouse position was not changed during inherited call
+    if (MousePosNew.X = MoveMousePos.X) and (MousePosNew.Y = MoveMousePos.Y) then begin
+      MoveActive := True;
+    end;
+  end else MoveActive := False;
+  {$ENDIF}
+end;
+
+procedure TDrawDlg.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+  MousePos: TPoint;
+begin
+  inherited;
+  if MoveActive then begin
+    MousePos := ClientToScreen(Point(X, Y));
+    SetBounds(MoveFormPos.X + MousePos.X - MoveMousePos.X,
+      MoveFormPos.Y + MousePos.Y - MoveMousePos.Y,
+      Width, Height);
+  end;
+end;
+
+procedure TDrawDlg.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  MoveActive := False;
+  inherited;
+end;
+
+procedure TDrawDlg.MouseLeave;
+begin
+  MoveActive := False;
+  inherited;
+end;
+
+procedure TDrawDlg.VisibleChangedHandler(Sender: TObject);
+begin
+  MoveActive := False;
+end;
+
 procedure TDrawDlg.InitButtons;
 var
@@ -103 +178 @@
   // ButtonDownSound, ButtonUpSound: string;
 begin
-  // ButtonDownSound:=Sounds.Lookup('BUTTON_DOWN');
-  // ButtonUpSound:=Sounds.Lookup('BUTTON_UP');
+  // ButtonDownSound := Sounds.Lookup('BUTTON_DOWN');
+  // ButtonUpSound := Sounds.Lookup('BUTTON_UP');
   for cix := 0 to ComponentCount - 1 do
     if Components[cix] is TButtonBase then
     begin
       TButtonBase(Components[cix]).Graphic := GrExt[HGrSystem].Data;
-      // if ButtonDownSound<>'*' then
-      // DownSound:=HomeDir+'Sounds' + DirectorySeparator + ButtonDownSound + '.wav';
-      // if ButtonUpSound<>'*' then
-      // UpSound:=HomeDir+'Sounds' + DirectorySeparator + ButtonUpSound + '.wav';
+      // if ButtonDownSound <> '*' then
+      // DownSound := GetSoundsDir + DirectorySeparator + ButtonDownSound + '.wav';
+      // if ButtonUpSound <> '*' then
+      // UpSound := GetSoundsDir + DirectorySeparator + ButtonUpSound + '.wav';
       if Components[cix] is TButtonA then
         TButtonA(Components[cix]).Font := UniFont[ftButton];
@@ -125 +200 @@
   r0, r1: HRgn;
 begin
-  r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
+  r0 := DpiCreateRectRgn(0, 0, ClientWidth, ClientHeight);
   for i := 0 to ControlCount - 1 do
     if not(Controls[i] is TArea) and Controls[i].Visible then
     begin
       with Controls[i].BoundsRect do
-        r1 := CreateRectRgn(Left, Top, Right, Bottom);
+        r1 := DpiCreateRectRgn(Left, Top, Right, Bottom);
       CombineRgn(r0, r0, r1, RGN_DIFF);
       DeleteObject(r1);
@@ -142 +217 @@
 procedure TBaseMessgDlg.FormCreate(Sender: TObject);
 begin
-  Left := (Screen.Width - Width) div 2;
+  Left := (DpiScreen.Width - Width) div 2;
   Canvas.Font.Assign(UniFont[ftNormal]);
   Canvas.Brush.Style := bsClear;
   MessgText := '';
   TopSpace := 0;
-  TitleHeight := Screen.Height;
+  TitleHeight := DpiScreen.Height;
   if csDesigning in ComponentState then Exit;
   InitButtons;
@@ -157 +232 @@
 begin
   if csDesigning in ComponentState then Exit;
-  PaintBackground(Self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),
+  PaintBackground(self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),
     ClientHeight - (6 + 2 * Border));
   for i := 0 to Border do
@@ -218 +293 @@
 begin
   ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing;
-  Top := (Screen.Height - ClientHeight) div 2;
+  Top := (DpiScreen.Height - ClientHeight) div 2;
   for i := 0 to ControlCount - 1 do
     Controls[i].Top := ClientHeight - (34 + Border);