Ignore:
Timestamp:
May 23, 2020, 12:47:45 AM (4 years ago)
Author:
chronos
Message:
  • Added: DPI support for TEdit box.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r252 r253  
    4141    property OnMouseLeave;
    4242    property OnMouseEnter;
     43    property ParentFont;
     44  end;
     45
     46  TWinControlEx = class(TWinControl)
     47  public
     48    property BorderStyle;
    4349  end;
    4450
     
    150156    function GetHint: string;
    151157    function GetOnClick: TNotifyEvent;
     158    function GetParentFont: Boolean;
    152159    function GetShowHint: Boolean;
    153160    function GetVisible: Boolean;
     
    166173    procedure SetOnClick(AValue: TNotifyEvent);
    167174    procedure SetOnResize(AValue: TNotifyEvent);
     175    procedure SetParentFont(AValue: Boolean);
    168176    procedure SetShowHint(AValue: Boolean);
    169177    procedure NativeFormResize(Sender: TObject);
     
    181189    procedure MouseEnterHandler(Sender: TObject); virtual;
    182190  protected
     191    function GetText: TCaption; virtual;
     192    procedure SetText(AValue: TCaption); virtual;
    183193    procedure UpdateBounds; virtual;
    184194    procedure FontChanged(Sender: TObject); virtual;
     
    200210    procedure MouseLeave; virtual;
    201211    procedure MouseEnter; virtual;
     212    property Text: TCaption read GetText write SetText;
     213    property ParentFont: Boolean read GetParentFont write SetParentFont default True;
    202214  public
    203215    function ScreenToClient(const APoint: TPoint): TPoint; virtual;
     
    359371  TDpiWinControl = class(TDpiControl)
    360372  private
     373    function GetBorderStyle: TBorderStyle;
    361374    function GetHandle: HWND;
    362375    function GetOnKeyDown: TKeyEvent;
     
    365378    function GetTabOrder: TTabOrder;
    366379    function GetTabStop: Boolean;
     380    procedure SetBorderStyle(AValue: TBorderStyle);
    367381    procedure SetHandle(AValue: HWND);
    368382    procedure SetOnKeyDown(AValue: TKeyEvent);
     
    374388    function GetNativeControl: TControl; override;
    375389    function GetNativeWinControl: TWinControl; virtual;
     390    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
    376391  public
    377392    Controls: TDpiControls;
     
    527542  TDpiForms = specialize TFPGObjectList<TDpiForm>;
    528543
     544  { TDpiEdit }
     545
     546  TDpiEdit = class(TDpiWinControl)
     547  private
     548    FText: string;
     549    function GetSelLength: Integer;
     550    function GetSelStart: Integer;
     551    procedure SetSelLength(AValue: Integer);
     552    procedure SetSelStart(AValue: Integer);
     553  protected
     554    function GetNativeWinControl: TWinControl; override;
     555    function GetNativeEdit: TEdit; virtual;
     556    function GetText: TCaption; override;
     557    procedure SetText(AValue: TCaption); override;
     558  public
     559    NativeEdit: TEdit;
     560    property SelLength: Integer read GetSelLength write SetSelLength;
     561    property SelStart: Integer read GetSelStart write SetSelStart;
     562  published
     563    property Text;
     564    property BorderStyle default bsSingle;
     565    property ParentFont;
     566  end;
     567
    529568  { TDpiButton }
    530569
     
    911950function ScaleRectToNative(Value: TRect): TRect;
    912951function ScaleRectFromNative(Value: TRect): TRect;
     952function ScaleFloatToNative(Value: Double): Double;
     953function ScaleFloatFromNative(Value: Double): Double;
    913954
    914955
     
    928969  RegisterProjectFileDescriptor(DpiFormFileDesc);
    929970  RegisterComponents('DpiControls', [TDpiButton, TDpiImage, TDpiPaintBox,
    930     TDpiListBox, TDpiPopupMenu]);
     971    TDpiListBox, TDpiPopupMenu, TDpiEdit]);
    931972end;
    932973
     
    10151056end;
    10161057
     1058function ScaleFloatToNative(Value: Double): Double;
     1059begin
     1060  Result := Value * DpiScreen.Dpi / 96;
     1061end;
     1062
     1063function ScaleFloatFromNative(Value: Double): Double;
     1064begin
     1065  Result := Value * 96 / DpiScreen.Dpi;
     1066end;
     1067
    10171068function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
    10181069  YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
     
    10281079    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    10291080  {$ENDIF}
     1081end;
     1082
     1083{ TDpiEdit }
     1084
     1085function TDpiEdit.GetText: TCaption;
     1086begin
     1087  Result := FText;
     1088end;
     1089
     1090procedure TDpiEdit.SetText(AValue: TCaption);
     1091begin
     1092  FText := AValue;
     1093  GetNativeEdit.Text := AValue;
     1094end;
     1095
     1096function TDpiEdit.GetSelLength: Integer;
     1097begin
     1098  Result := GetNativeEdit.SelLength;
     1099end;
     1100
     1101function TDpiEdit.GetSelStart: Integer;
     1102begin
     1103  Result := GetNativeEdit.SelStart;
     1104end;
     1105
     1106procedure TDpiEdit.SetSelLength(AValue: Integer);
     1107begin
     1108  GetNativeEdit.SelLength := AValue;
     1109end;
     1110
     1111procedure TDpiEdit.SetSelStart(AValue: Integer);
     1112begin
     1113  GetNativeEdit.SelStart := AValue;
     1114end;
     1115
     1116function TDpiEdit.GetNativeWinControl: TWinControl;
     1117begin
     1118  Result := GetNativeEdit;
     1119end;
     1120
     1121function TDpiEdit.GetNativeEdit: TEdit;
     1122begin
     1123  if not Assigned(NativeEdit) then NativeEdit := TEdit.Create(nil);
     1124  Result := NativeEdit;
    10301125end;
    10311126
     
    24372532{ TDpiWinControl }
    24382533
     2534function TDpiWinControl.GetBorderStyle: TBorderStyle;
     2535begin
     2536  Result := TWinControlEx(GetNativeWinControl).BorderStyle;
     2537end;
     2538
    24392539function TDpiWinControl.GetHandle: HWND;
    24402540begin
     
    24652565begin
    24662566  Result := GetNativeWinControl.TabStop;
     2567end;
     2568
     2569procedure TDpiWinControl.SetBorderStyle(AValue: TBorderStyle);
     2570begin
     2571  TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
    24672572end;
    24682573
     
    26322737procedure TDpiScreen.UpdateScreen;
    26332738begin
     2739  //Dpi := 96 * 2; //Screen.PixelsPerInch;
    26342740  Dpi := Screen.PixelsPerInch;
    26352741end;
     
    27452851end;
    27462852
     2853procedure TDpiControl.SetText(AValue: TCaption);
     2854begin
     2855
     2856end;
     2857
    27472858procedure TDpiControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
    27482859  Y: Integer);
     
    29523063end;
    29533064
     3065function TDpiControl.GetParentFont: Boolean;
     3066begin
     3067  Result := TControlEx(GetNativeControl).ParentFont;
     3068end;
     3069
    29543070function TDpiControl.GetShowHint: Boolean;
    29553071begin
    29563072  Result := GetNativeControl.ShowHint;
     3073end;
     3074
     3075function TDpiControl.GetText: TCaption;
     3076begin
     3077  Result := '';
    29573078end;
    29583079
     
    30223143  if FOnResize = AValue then Exit;
    30233144  FOnResize := AValue;
     3145end;
     3146
     3147procedure TDpiControl.SetParentFont(AValue: Boolean);
     3148begin
     3149  TControlEx(GetNativeControl).ParentFont := AValue;
    30243150end;
    30253151
Note: See TracChangeset for help on using the changeset viewer.