Changeset 253 for branches/highdpi/Packages/DpiControls/UDpiControls.pas

Timestamp:

May 23, 2020, 12:47:45 AM (4 years ago)

Author:

chronos

Message:

• Added: DPI support for TEdit box.

File:

• branches/highdpi/Packages/DpiControls/UDpiControls.pas (modified) (19 diffs)

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -41 +41 @@
     property OnMouseLeave;
     property OnMouseEnter;
+    property ParentFont;
+  end;
+
+  TWinControlEx = class(TWinControl)
+  public
+    property BorderStyle;
   end;
 
@@ -150 +156 @@
     function GetHint: string;
     function GetOnClick: TNotifyEvent;
+    function GetParentFont: Boolean;
     function GetShowHint: Boolean;
     function GetVisible: Boolean;
@@ -166 +173 @@
     procedure SetOnClick(AValue: TNotifyEvent);
     procedure SetOnResize(AValue: TNotifyEvent);
+    procedure SetParentFont(AValue: Boolean);
     procedure SetShowHint(AValue: Boolean);
     procedure NativeFormResize(Sender: TObject);
@@ -181 +189 @@
     procedure MouseEnterHandler(Sender: TObject); virtual;
   protected
+    function GetText: TCaption; virtual;
+    procedure SetText(AValue: TCaption); virtual;
     procedure UpdateBounds; virtual;
     procedure FontChanged(Sender: TObject); virtual;
@@ -200 +210 @@
     procedure MouseLeave; virtual;
     procedure MouseEnter; virtual;
+    property Text: TCaption read GetText write SetText;
+    property ParentFont: Boolean read GetParentFont write SetParentFont default True;
   public
     function ScreenToClient(const APoint: TPoint): TPoint; virtual;
@@ -359 +371 @@
   TDpiWinControl = class(TDpiControl)
   private
+    function GetBorderStyle: TBorderStyle;
     function GetHandle: HWND;
     function GetOnKeyDown: TKeyEvent;
@@ -365 +378 @@
     function GetTabOrder: TTabOrder;
     function GetTabStop: Boolean;
+    procedure SetBorderStyle(AValue: TBorderStyle);
     procedure SetHandle(AValue: HWND);
     procedure SetOnKeyDown(AValue: TKeyEvent);
@@ -374 +388 @@
     function GetNativeControl: TControl; override;
     function GetNativeWinControl: TWinControl; virtual;
+    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
   public
     Controls: TDpiControls;
@@ -527 +542 @@
   TDpiForms = specialize TFPGObjectList<TDpiForm>;
 
+  { TDpiEdit }
+
+  TDpiEdit = class(TDpiWinControl)
+  private
+    FText: string;
+    function GetSelLength: Integer;
+    function GetSelStart: Integer;
+    procedure SetSelLength(AValue: Integer);
+    procedure SetSelStart(AValue: Integer);
+  protected
+    function GetNativeWinControl: TWinControl; override;
+    function GetNativeEdit: TEdit; virtual;
+    function GetText: TCaption; override;
+    procedure SetText(AValue: TCaption); override;
+  public
+    NativeEdit: TEdit;
+    property SelLength: Integer read GetSelLength write SetSelLength;
+    property SelStart: Integer read GetSelStart write SetSelStart;
+  published
+    property Text;
+    property BorderStyle default bsSingle;
+    property ParentFont;
+  end;
+
   { TDpiButton }
 
@@ -911 +950 @@
 function ScaleRectToNative(Value: TRect): TRect;
 function ScaleRectFromNative(Value: TRect): TRect;
+function ScaleFloatToNative(Value: Double): Double;
+function ScaleFloatFromNative(Value: Double): Double;
 
 
@@ -928 +969 @@
   RegisterProjectFileDescriptor(DpiFormFileDesc);
   RegisterComponents('DpiControls', [TDpiButton, TDpiImage, TDpiPaintBox,
-    TDpiListBox, TDpiPopupMenu]);
+    TDpiListBox, TDpiPopupMenu, TDpiEdit]);
 end;
 
@@ -1015 +1056 @@
 end;
 
+function ScaleFloatToNative(Value: Double): Double;
+begin
+  Result := Value * DpiScreen.Dpi / 96;
+end;
+
+function ScaleFloatFromNative(Value: Double): Double;
+begin
+  Result := Value * 96 / DpiScreen.Dpi;
+end;
+
 function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
   YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
@@ -1028 +1079 @@
     ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
   {$ENDIF}
+end;
+
+{ TDpiEdit }
+
+function TDpiEdit.GetText: TCaption;
+begin
+  Result := FText;
+end;
+
+procedure TDpiEdit.SetText(AValue: TCaption);
+begin
+  FText := AValue;
+  GetNativeEdit.Text := AValue;
+end;
+
+function TDpiEdit.GetSelLength: Integer;
+begin
+  Result := GetNativeEdit.SelLength;
+end;
+
+function TDpiEdit.GetSelStart: Integer;
+begin
+  Result := GetNativeEdit.SelStart;
+end;
+
+procedure TDpiEdit.SetSelLength(AValue: Integer);
+begin
+  GetNativeEdit.SelLength := AValue;
+end;
+
+procedure TDpiEdit.SetSelStart(AValue: Integer);
+begin
+  GetNativeEdit.SelStart := AValue;
+end;
+
+function TDpiEdit.GetNativeWinControl: TWinControl;
+begin
+  Result := GetNativeEdit;
+end;
+
+function TDpiEdit.GetNativeEdit: TEdit;
+begin
+  if not Assigned(NativeEdit) then NativeEdit := TEdit.Create(nil);
+  Result := NativeEdit;
 end;
 
@@ -2437 +2532 @@
 { TDpiWinControl }
 
+function TDpiWinControl.GetBorderStyle: TBorderStyle;
+begin
+  Result := TWinControlEx(GetNativeWinControl).BorderStyle;
+end;
+
 function TDpiWinControl.GetHandle: HWND;
 begin
@@ -2465 +2565 @@
 begin
   Result := GetNativeWinControl.TabStop;
+end;
+
+procedure TDpiWinControl.SetBorderStyle(AValue: TBorderStyle);
+begin
+  TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
 end;
 
@@ -2632 +2737 @@
 procedure TDpiScreen.UpdateScreen;
 begin
+  //Dpi := 96 * 2; //Screen.PixelsPerInch;
   Dpi := Screen.PixelsPerInch;
 end;
@@ -2745 +2851 @@
 end;
 
+procedure TDpiControl.SetText(AValue: TCaption);
+begin
+
+end;
+
 procedure TDpiControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
   Y: Integer);
@@ -2952 +3063 @@
 end;
 
+function TDpiControl.GetParentFont: Boolean;
+begin
+  Result := TControlEx(GetNativeControl).ParentFont;
+end;
+
 function TDpiControl.GetShowHint: Boolean;
 begin
   Result := GetNativeControl.ShowHint;
+end;
+
+function TDpiControl.GetText: TCaption;
+begin
+  Result := '';
 end;
 
@@ -3022 +3143 @@
   if FOnResize = AValue then Exit;
   FOnResize := AValue;
+end;
+
+procedure TDpiControl.SetParentFont(AValue: Boolean);
+begin
+  TControlEx(GetNativeControl).ParentFont := AValue;
 end;