Ignore:
Timestamp:
Nov 30, 2023, 10:16:14 PM (12 months ago)
Author:
chronos
Message:
  • Modified: Updated high dpi branch from trunk.
  • Modified: Use generics.collections instead of fgl.
  • Modified: Compile with Delphi syntax.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r463 r465  
    11unit UDpiControls;
    2 
    3 {$mode objfpc}{$H+}
    42
    53interface
    … …  
    75uses
    86  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms,
    9   FormEditingIntf, ProjectIntf, Controls, StdCtrls, fgl, Graphics, ComCtrls,
    10   ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf, Menus, Math,
    11   UPixelPointer2, Grids, Spin;
     7  Generics.Collections, FormEditingIntf, ProjectIntf, Controls, StdCtrls, Graphics,
     8  ComCtrls, ExtCtrls, LCLType, GraphType, Types, CustApp, LMessages, LCLIntf,
     9  Menus, Math, UPixelPointer2, Grids, Spin;
    1210
    1311const
    14   FixedDpi = -1;
     12  FixedDpi = 192;
    1513
    1614type
    … …  
    8987    procedure SetName(AValue: string);
    9088    procedure SetNativeFont(AValue: TFont);
    91     procedure SetOnChange(AValue: TNotifyEvent);
    9289    procedure SetPixelsPerInch(AValue: Integer);
    9390    procedure SetSize(AValue: Integer);
    … …  
    114111    property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
    115112    property Height: Integer read GetHeight write SetHeight default 0;
    116     property OnChange: TNotifyEvent read FOnChange write SetOnChange;
     113    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    117114  end;
    118115
    … …  
    189186    procedure SetFont(AValue: TDpiFont);
    190187    procedure SetHint(AValue: string);
    191     procedure SetOnChangeBounds(AValue: TNotifyEvent);
    192188    procedure SetOnClick(AValue: TNotifyEvent);
    193189    procedure SetOnDblClick(AValue: TNotifyEvent);
    194     procedure SetOnResize(AValue: TNotifyEvent);
    195190    procedure SetParentFont(AValue: Boolean);
    196191    procedure SetShowHint(AValue: Boolean);
    … …  
    275270    property Constraints: TDpiSizeConstraints read FConstraints write FConstraints;
    276271    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
    277     property OnResize: TNotifyEvent read FOnResize write SetOnResize;
    278     property OnChangeBounds: TNotifyEvent read FOnChangeBounds write SetOnChangeBounds;
     272    property OnResize: TNotifyEvent read FOnResize write FOnResize;
     273    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
    279274    property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
    280275    property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
    … …  
    285280  end;
    286281
    287   TDpiControls = specialize TFPGObjectList<TDpiControl>;
     282  TDpiControls = TObjectList<TDpiControl>;
    288283
    289284  { TDpiControlBorderSpacing }
    … …  
    446441  public
    447442    property NativeCanvas: TCanvas read FNativeCanvas write SetNativeCanvas;
    448     procedure RoundRect(const Rect: TRect; RX, RY: Integer);
     443    procedure RoundRect(const Rect: TRect; RX, RY: Integer); overload;
    449444    procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; virtual;
    450445    procedure Polygon(const Points: array of TPoint; Winding: Boolean;
    451       StartIndex: Integer = 0; NumPts: Integer = -1);
    452     procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual;
    453     procedure Polygon(const Points: array of TPoint);
     446      StartIndex: Integer = 0; NumPts: Integer = -1); overload;
     447    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual; overload;
     448    procedure Polygon(const Points: array of TPoint); overload;
    454449    procedure PolyBezier(const Points: array of TPoint;
    455       Filled: Boolean = False; Continuous: boolean = True);
     450      Filled: Boolean = False; Continuous: boolean = True); overload;
    456451    procedure PolyBezier(Points: PPoint; NumPts: Integer;
    457       Filled: Boolean = False; Continuous: Boolean = True); virtual;
    458     procedure Polyline(const Points: array of TPoint);
    459     procedure Polyline(Points: PPoint; NumPts: Integer); virtual;
    460     procedure Ellipse(x1, y1, x2, y2: Integer); virtual;
    461     procedure Ellipse(const ARect: TRect); virtual;
    462     procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual;
     452      Filled: Boolean = False; Continuous: Boolean = True); virtual; overload;
     453    procedure Polyline(const Points: array of TPoint); overload;
     454    procedure Polyline(Points: PPoint; NumPts: Integer); virtual; overload;
     455    procedure Ellipse(x1, y1, x2, y2: Integer); virtual; overload;
     456    procedure Ellipse(const ARect: TRect); virtual; overload;
     457    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual; overload;
     458    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual; overload;
    463459    procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
    464460      StartX, StartY, EndX, EndY: Integer); virtual;
    465     procedure StretchDraw(const DestRect: TRect; SrcGraphic: TDpiGraphic); virtual;
    466461    procedure FrameRect(Rect: TRect);
    467462    procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
    … …  
    475470    procedure LineTo(X, Y: Integer);
    476471    procedure Line(const p1, p2: TPoint);
    477     procedure FillRect(const ARect: TRect); virtual;
    478     procedure FillRect(X1, Y1, X2, Y2: Integer);
     472    procedure FillRect(const ARect: TRect); virtual; overload;
     473    procedure FillRect(X1, Y1, X2, Y2: Integer); overload;
    479474    procedure Draw(X, Y: Integer; Source: TDpiGraphic);
    480475    procedure CopyRect(Dest: TRect; SrcCanvas: TDpiCanvas; Source: TRect);
    … …  
    708703  end;
    709704
    710   TDpiForms = specialize TFPGObjectList<TDpiForm>;
     705  TDpiForms = TObjectList<TDpiForm>;
    711706
    712707  { TDpiEdit }
    … …  
    12421237    procedure UpdateScreen;
    12431238    procedure UpdateActiveFormFromNativeScreen;
    1244     function DisableForms(SkipForm: TDpiForm; DisabledList: TList = nil): TList;
    1245     procedure EnableForms(var AFormList: TList);
     1239    function DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList = nil): Classes.TList;
     1240    procedure EnableForms(var AFormList: Classes.TList);
    12461241    property FormCount: Integer read GetFormCount;
    12471242    property Forms[Index: Integer]: TDpiForm read GetForms;
    … …  
    14191414  public
    14201415    NativePopupMenu: TPopupMenu;
    1421     procedure PopUp;
    1422     procedure PopUp(X, Y: Integer); virtual;
     1416    procedure PopUp;  overload;
     1417    procedure PopUp(X, Y: Integer); virtual; overload;
    14231418    constructor Create(AOwner: TComponent); override;
    14241419    destructor Destroy; override;
    … …  
    23102305  if not Assigned(NativeListView) then begin
    23112306    NativeListView := TListView.Create(nil);
    2312     NativeListView.OnCustomDrawItem := @DoCustomDrawItem;
     2307    NativeListView.OnCustomDrawItem := DoCustomDrawItem;
    23132308  end;
    23142309  Result := NativeListView;
    … …  
    27812776    NativeMenuItem := TMenuItem.Create(nil);
    27822777    NativeMenuItem.Name := 'Native' + Name;
    2783     NativeMenuItem.OnClick := @OnClickHandler;
     2778    NativeMenuItem.OnClick := OnClickHandler;
    27842779  end;
    27852780  Result := NativeMenuItem;
    … …  
    30843079begin
    30853080  if (FMainForm = nil)
    3086   and (FCreatingForm=AForm)
     3081  and (FCreatingForm = AForm)
    30873082  //and (not (AppDestroying in FFlags))
    30883083  and not (AForm.FormStyle in [fsMDIChild, fsSplash])
    … …  
    30963091var
    30973092  Instance: TComponent;
    3098   ok: Boolean;
     3093  Ok: Boolean;
    30993094  AForm: TDpiForm;
    31003095begin
    … …  
    31053100  TComponent(Reference) := Instance;
    31063101
    3107   ok := False;
     3102  Ok := False;
    31083103  try
    31093104    if (FCreatingForm = nil) and (Instance is TDpiForm) then
    31103105      FCreatingForm := TDpiForm(Instance);
    31113106    Instance.Create(Self);
    3112     ok := true;
     3107    Ok := true;
    31133108  finally
    3114     if not ok then begin
     3109    if not Ok then begin
    31153110      TComponent(Reference) := nil;
    31163111      if FCreatingForm = Instance then
    … …  
    41034098begin
    41044099  inherited;
    4105   TGraphicControlEx(GetNativeGraphicControl).OnPaint := @PaintHandler;
     4100  TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;
    41064101end;
    41074102
    … …  
    41964191begin
    41974192  Result := NativeFont;
    4198 end;
    4199 
    4200 procedure TDpiFont.SetOnChange(AValue: TNotifyEvent);
    4201 begin
    4202   if FOnChange = AValue then Exit;
    4203   FOnChange := AValue;
    42044193end;
    42054194
    … …  
    44094398begin
    44104399  inherited;
    4411   GetNativeWinControl.OnKeyDown := @KeyDownHandler;
     4400  GetNativeWinControl.OnKeyDown := KeyDownHandler;
    44124401end;
    44134402
    … …  
    44484437begin
    44494438  Controls := TDpiControls.Create;
    4450   Controls.FreeObjects := False;
     4439  Controls.OwnsObjects := False;
    44514440  inherited;
    44524441end;
    … …  
    45574546end;
    45584547
    4559 function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: TList
    4560   ): TList;
     4548function TDpiScreen.DisableForms(SkipForm: TDpiForm; DisabledList: Classes.TList
     4549  ): Classes.TList;
    45614550begin
    45624551  Result := Screen.DisableForms(SkipForm.GetNativeForm, DisabledList);
    45634552end;
    45644553
    4565 procedure TDpiScreen.EnableForms(var AFormList: TList);
     4554procedure TDpiScreen.EnableForms(var AFormList: Classes.TList);
    45664555begin
    45674556  Screen.EnableForms(AFormList);
    … …  
    45714560begin
    45724561  FForms := TDpiForms.Create;
    4573   FForms.FreeObjects := False;
     4562  FForms.OwnsObjects := False;
    45744563  FPrevActiveForms := TDpiForms.Create;
    4575   FPrevActiveForms.FreeObjects := False;
     4564  FPrevActiveForms.OwnsObjects := False;
    45764565  // Screen.PixelsPerInch is not initialized at this point
    45774566  Dpi := 96;
    … …  
    46514640begin
    46524641  Font.NativeFont := GetNativeControl.Font;
    4653   GetNativeControl.OnResize := @NativeFormResize;
    4654   GetNativeControl.OnChangeBounds := @NativeChangeBounds;
    4655   TControlEx(GetNativeControl).OnMouseDown := @MouseDownHandler;
    4656   TControlEx(GetNativeControl).OnMouseUp := @MouseUpHandler;
    4657   TControlEx(GetNativeControl).OnMouseMove := @MouseMoveHandler;
    4658   TControlEx(GetNativeControl).OnMouseEnter := @MouseEnterHandler;
    4659   TControlEx(GetNativeControl).OnMouseLeave := @MouseLeaveHandler;
    4660   TControlEx(GetNativeControl).OnMouseWheel := @MouseWheelHandler;
     4642  GetNativeControl.OnResize := NativeFormResize;
     4643  GetNativeControl.OnChangeBounds := NativeChangeBounds;
     4644  TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;
     4645  TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;
     4646  TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;
     4647  TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;
     4648  TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;
     4649  TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;
    46614650end;
    46624651
    … …  
    48304819  inherited;
    48314820  FFont := TDpiFont.Create;
    4832   FFont.OnChange := @FontChanged;
     4821  FFont.OnChange := FontChanged;
    48334822  FConstraints := TDpiSizeConstraints.Create;
    48344823  if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then
    … …  
    50315020end;
    50325021
    5033 procedure TDpiControl.SetOnChangeBounds(AValue: TNotifyEvent);
    5034 begin
    5035   if FOnChangeBounds = AValue then Exit;
    5036   FOnChangeBounds := AValue;
    5037 end;
    5038 
    50395022procedure TDpiControl.SetOnClick(AValue: TNotifyEvent);
    50405023begin
    … …  
    50455028begin
    50465029  TControlEx(GetNativeControl).OnDblClick := AValue;
    5047 end;
    5048 
    5049 procedure TDpiControl.SetOnResize(AValue: TNotifyEvent);
    5050 begin
    5051   if FOnResize = AValue then Exit;
    5052   FOnResize := AValue;
    50535030end;
    50545031
    … …  
    54115388  if not Assigned(NativeForm) then begin
    54125389    NativeForm := TFormEx.CreateNew(nil);
    5413     (NativeForm as TFormEx).OnMessage := @FormMessageHandler;
     5390    (NativeForm as TFormEx).OnMessage := FormMessageHandler;
    54145391    //NativeForm := TForm.Create(nil);
    54155392  end;
    … …  
    54205397begin
    54215398  inherited;
    5422   GetNativeForm.OnActivate := @ActivateHandler;
    5423   GetNativeForm.OnDeactivate := @DeactivateHandler;
    5424   GetNativeForm.OnClose := @CloseHandler;
    5425   GetNativeForm.OnCloseQuery := @CloseQueryHandler;
     5399  GetNativeForm.OnActivate := ActivateHandler;
     5400  GetNativeForm.OnDeactivate := DeactivateHandler;
     5401  GetNativeForm.OnClose := CloseHandler;
     5402  GetNativeForm.OnCloseQuery := CloseQueryHandler;
    54265403  GetNativeForm.Name := Name + 'Native';
    54275404end;
Note: See TracChangeset for help on using the changeset viewer.