Changeset 476 for trunk/Packages/DpiControls

Timestamp:

Dec 4, 2023, 9:46:31 PM (13 months ago)

Author:

chronos

Message:

• Fixed: Build under Linux.

Location:

trunk/Packages/DpiControls

Files:

• Dpi.Common.pas (modified) (3 diffs)
• Dpi.Controls.pas (modified) (11 diffs)
• Dpi.StdCtrls.pas (modified) (1 diff)

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -15 +15 @@
     XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
+{$IFDEF WINDOWS}
 function ScrollDC(hDC: HDC; dx: longint; dy: longint; const lprcScroll: RECT;
   const lprcClip:RECT;hrgnUpdate:HRGN; lprcUpdate: LPRECT): WINBOOL; overload;
+{$ENDIF}
 function ScrollDC(Canvas: TCanvas; dx: Longint; dy: Longint; const lprcScroll: TRect;
   const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean; overload;
@@ -51 +53 @@
 end;
 
+{$IFDEF WINDOWS}
 function ScrollDC(hDC: HDC; dx: longint; dy: longint; const lprcScroll: RECT;
   const lprcClip: RECT; hrgnUpdate: HRGN; lprcUpdate: LPRECT): WINBOOL;
@@ -63 +66 @@
     ScaleRectToNative(lprcScroll), ScaleRectToNative(lprcClip), hrgnUpdate, lprcUpdate);
 end;
+{$ENDIF}
 
 function ScrollDC(Canvas: TCanvas; dx: Longint; dy: Longint;

trunk/Packages/DpiControls/Dpi.Controls.pas

@@ -20 +20 @@
   TControlEx = class(Controls.TControl)
   public
+    property ParentColor;
     property OnMouseDown;
     property OnMouseUp;
@@ -98 +99 @@
     function GetOnClick: TNotifyEvent;
     function GetOnDblClick: TNotifyEvent;
+    function GetParentColor: Boolean;
     function GetParentFont: Boolean;
     function GetShowHint: Boolean;
@@ -117 +119 @@
     procedure SetOnClick(AValue: TNotifyEvent);
     procedure SetOnDblClick(AValue: TNotifyEvent);
+    procedure SetParentColor(AValue: Boolean);
     procedure SetParentFont(AValue: Boolean);
     procedure SetShowHint(AValue: Boolean);
@@ -133 +136 @@
     procedure MouseEnterHandler(Sender: TObject); virtual;
     procedure SetWindowProc(AValue: TWndMethod);
+    function ColorIsStored: Boolean; virtual;
   protected
     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
@@ -158 +162 @@
     property Text: TCaption read GetText write SetText;
     property ParentFont: Boolean read GetParentFont write SetParentFont default True;
+    property ParentColor: Boolean read GetParentColor write SetParentColor default True;
   public
     function ScreenToClient(const APoint: TPoint): TPoint; virtual;
@@ -172 +177 @@
     procedure Update;
     procedure Refresh;
-    function IsParentOf(AControl: TControl): boolean; virtual;
+    function IsParentOf(AControl: TControl): Boolean; virtual;
     function Scale96ToScreen(const ASize: Integer): Integer;
     constructor Create(TheOwner: TComponent); override;
@@ -196 +201 @@
     property Font: TFont read FFont write SetFont;
     property Align: TAlign read GetAlign write SetAlign;
-    property Color: TColor read GetColor write SetColor;
+    property Color: TColor read GetColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
     property Constraints: TSizeConstraints read FConstraints write FConstraints;
     property Cursor: TCursor read GetCursor write SetCursor default crDefault;
@@ -643 +648 @@
 end;
 
+function TControl.ColorIsStored: Boolean;
+begin
+  Result := not ParentColor;
+end;
+
 procedure TControl.DoBorderSpacingChange(Sender: TObject;
   InnerSpaceChanged: Boolean);
@@ -747 +757 @@
 end;
 
-function TControl.IsParentOf(AControl: TControl): boolean;
+function TControl.IsParentOf(AControl: TControl): Boolean;
 begin
   Result := False;
@@ -887 +897 @@
 end;
 
+function TControl.GetParentColor: Boolean;
+begin
+  Result := TControlEx(GetNativeControl).ParentColor;
+end;
+
 function TControl.GetParentFont: Boolean;
 begin
@@ -976 +991 @@
 begin
   TControlEx(GetNativeControl).OnDblClick := AValue;
+end;
+
+procedure TControl.SetParentColor(AValue: Boolean);
+begin
+  TControlEx(GetNativeControl).ParentColor := AValue;
 end;
 

trunk/Packages/DpiControls/Dpi.StdCtrls.pas

@@ -139 +139 @@
     property Count: Integer read GetCount;
   published
+    property ParentColor;
     property TopIndex: Integer read GetTopIndex write SetTopIndex default 0;
     property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;