Menu
▾
▴
[GExperts-Checkins] SF.net SVN: gexperts:[3361] trunk/ExternalSource/dzlib
|
From: <tw...@us...> - 2020-10-23 15:06:16
|
Revision: 3361
http://sourceforge.net/p/gexperts/code/3361
Author: twm
Date: 2020-10-23 15:06:13 +0000 (Fri, 23 Oct 2020)
Log Message:
-----------
synced with current dzlib
Modified Paths:
--------------
trunk/ExternalSource/dzlib/dzlib.inc
trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
trunk/ExternalSource/dzlib/u_dzOsUtils.pas
trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
trunk/ExternalSource/dzlib/u_dzTypes.pas
trunk/ExternalSource/dzlib/u_dzVclUtils.pas
Modified: trunk/ExternalSource/dzlib/dzlib.inc
===================================================================
--- trunk/ExternalSource/dzlib/dzlib.inc 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/dzlib.inc 2020-10-23 15:06:13 UTC (rev 3361)
@@ -62,6 +62,8 @@
// THandleStream.FHandle is declared as THandle (before that it's an Integer)
{$DEFINE THANDLESTREAM_HANDLE_IS_THANDLE}
{$DEFINE HAS_TOBJECT_TOSTRING}
+// TMonitor.PixelsPerInch probably didn't exist in Delphi 2009, it does exist in Delphi 10.2 adjust as necessary
+{$DEFINE HAS_TMONITOR_PIXELSPERINCH}
{$ENDIF}
{$IFDEF DELPHIXE_UP}
@@ -79,7 +81,7 @@
{$ENDIF}
{$IFDEF DELPHIX_TOKYO_UP}
-// this function probably already exist in earlier versions, I just run across a compile error for 10.2 Tokyo
+// this function probably already existed in earlier versions, I just run across a compile error for 10.2 Tokyo
{$DEFINE HAS_INTTOHEX_FUNCTION}
{$DEFINE HAS_INTTOHEX_FUNCTION_64}
{$ENDIF}
Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -78,6 +78,11 @@
end;
type
+ TValueIdxTriple = (vitBlue, vitGreen, vitRed);
+
+type
+ PdzRgbTripleValues = ^TdzRgbTripleValues;
+ TdzRgbTripleValues = packed array[TValueIdxTriple] of Byte;
PdzRgbTriple = ^TdzRgbTriple;
TdzRgbTriple = packed record
// do not change the order of the fields, do not add any fields
@@ -85,6 +90,8 @@
Green: Byte;
Red: Byte;
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ function GetValues(_Idx: TValueIdxTriple): Byte; inline;
+ procedure SetValues(_Idx: TValueIdxTriple; _Value: Byte); inline;
function GetColor: TColor;
procedure SetColor(_Color: TColor);
procedure SetGray(_Value: Byte);
@@ -95,6 +102,7 @@
procedure SetBrightness(_Value: Byte); deprecated; //use SetGray
procedure GetHls(out _Hls: THlsRec);
procedure SetHls(const _Hls: THlsRec);
+ property Values[_Idx: TValueIdxTriple]: Byte read GetValues write SetValues;
{$ENDIF}
end;
@@ -510,8 +518,8 @@
///<summary>
/// Calculates the average brightness of an bitmap with PixelFormat = pf8Bit
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
/// False, if not </summary>
@@ -521,8 +529,8 @@
///<summary>
/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Channel determines how to calculate the brightness
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
@@ -535,8 +543,8 @@
/// Calculates the average brightness of an bitmap with PixelFormat = pf24Bit thereby only
/// using the blue channel.
/// @param bmp is the bitmap to process
-/// @param LowCutoff is the lower brightness limit for pixels to be include in the calculation
-/// @param HighCutoff is the upper brightness limit for pixels to be include in the calculation
+/// @param LowCutoff is the lower brightness limit for pixels to be included in the calculation
+/// @param HighCutoff is the upper brightness limit for pixels to be included in the calculation
/// @param Average returns the calculated average, only valid if Result = True
/// @returns True, if at least on pixel was in the desired interval
/// False, if not </summary>
@@ -544,6 +552,34 @@
out _Average: Byte): Boolean;
type
+ TUInt32Array256 = array[0..255] of UInt32;
+ TUInt64Array256 = array[0..255] of UInt64;
+
+///<summary>
+/// Calculate the histogram for a bitmap with PixelFormat = pf24 for the given channel
+/// @param bmp is the bitmap to process
+/// @param Channel determines how to calculate the brightness
+/// @returns a TUInt32Array256 containing the histogram </summary>
+function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256;
+///<summary>
+/// Calculate the histograms for red, green and blue for a bitmap with PixelFormat = pf24
+/// @param bmp is the bitmap to process
+/// @param Red returns the histogram for the red channel
+/// @param Green returns the histogram for the green channel
+/// @param Blue returns the histogram for the blue channel </summary>
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; out _Red, _Green, _Blue: TUInt64Array256); overload;
+///<summary>
+/// Calculate the histograms for red, green, blue and brightness for a bitmap with PixelFormat = pf24
+/// @param bmp is the bitmap to process
+/// @param Channel determines how to calculate the brightness
+/// @param Red returns the histogram for the red channel
+/// @param Green returns the histogram for the green channel
+/// @param Blue returns the histogram for the blue channel
+/// @param Blue returns the histogram for the selected brightness channel </summary>
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; _BrightnessChannel: TRgbBrightnessChannelEnum;
+ out _Red, _Green, _Blue, _Brightness: TUInt64Array256); overload;
+
+type
// Note: The bitmap is stored upside down, so the y coordinates are reversed!
TPixel24FilterCallback = procedure(_x, _y: Integer; var _Pixel: TdzRgbTriple) of object;
TPixel8FilterCallback = procedure(_x, _y: Integer; var _Pixel: Byte) of object;
@@ -1166,6 +1202,16 @@
Blue := GetBValue(_Color);
end;
+function TdzRgbTriple.GetValues(_Idx: TValueIdxTriple): Byte;
+begin
+ Result := TdzRgbTripleValues(Self)[_Idx];
+end;
+
+procedure TdzRgbTriple.SetValues(_Idx: TValueIdxTriple; _Value: Byte);
+begin
+ TdzRgbTripleValues(Self)[_Idx] := _Value;
+end;
+
procedure TdzRgbTriple.SetBrightness(_Value: Byte);
begin
Red := _Value;
@@ -3218,4 +3264,136 @@
Result := RainbowColor((_Hue - _MinHue) / (_MaxHue - _MinHue + 1));
end;
+function TBitmap24_GetHistogram(_bmp: TBitmap; _Channel: TRgbBrightnessChannelEnum): TUInt64Array256; overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(Result) to High(Result) do
+ Result[x] := 0;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ Inc(Result[PdzRgbTriple(Pixel).GetBrightness(_Channel)]);
+{$ELSE}
+ Inc(Result[GetRgbBrightness(PdzRgbTriple(Pixel).Red, PdzRgbTriple(Pixel).Green, PdzRgbTriple(Pixel).Blue, _Channel)]);
+{$ENDIF}
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; out _Red, _Green, _Blue: TUInt64Array256); overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(_Red) to High(_Red) do begin
+ _Red[x] := 0;
+ _Green[x] := 0;
+ _Blue[x] := 0;
+ end;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ Inc(_Red[PdzRgbTriple(Pixel).Red]);
+ Inc(_Green[PdzRgbTriple(Pixel).Green]);
+ Inc(_Blue[PdzRgbTriple(Pixel).Blue]);
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
+procedure TBitmap24_GetHistograms(_bmp: TBitmap; _BrightnessChannel: TRgbBrightnessChannelEnum;
+ out _Red, _Green, _Blue, _Brightness: TUInt64Array256); overload;
+const
+ BytesPerPixel = SizeOf(TdzRgbTriple);
+var
+ w: Integer;
+ h: Integer;
+ x: Integer;
+ y: Integer;
+ ScanLine: PByte;
+ Pixel: PByte;
+ BytesPerLine: Integer;
+begin
+ for x := Low(_Red) to High(_Red) do begin
+ _Red[x] := 0;
+ _Green[x] := 0;
+ _Blue[x] := 0;
+ _Brightness[x] := 0;
+ end;
+
+ h := _bmp.Height;
+ if h = 0 then begin
+ Exit; //==>
+ end;
+
+ w := _bmp.Width;
+
+ BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
+ Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));
+
+ ScanLine := _bmp.ScanLine[0];
+ for y := 0 to h - 1 do begin
+ Assert(ScanLine = _bmp.ScanLine[y]);
+ Pixel := ScanLine;
+ for x := 0 to w - 1 do begin
+ Inc(_Red[PdzRgbTriple(Pixel).Red]);
+ Inc(_Green[PdzRgbTriple(Pixel).Green]);
+ Inc(_Blue[PdzRgbTriple(Pixel).Blue]);
+{$IFDEF SUPPORTS_ENHANCED_RECORDS}
+ Inc(_Brightness[PdzRgbTriple(Pixel).GetBrightness(_BrightnessChannel)]);
+{$ELSE}
+ Inc(_Brightness[GetRgbBrightness(PdzRgbTriple(Pixel).Red, PdzRgbTriple(Pixel).Green, PdzRgbTriple(Pixel).Blue, _BrightnessChannel)]);
+{$ENDIF}
+ Inc(Pixel, BytesPerPixel);
+ end;
+ Dec(ScanLine, BytesPerLine);
+ end;
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzOsUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -204,7 +204,21 @@
/// is enabled. (according to http://stackoverflow.com/a/1675793/49925)
procedure JiggleMouse;
+type
+ TPowerRequestType = (
+ PowerRequestDisplayRequired = 0,
+ PowerRequestSystemRequired = 1,
+ PowerRequestAwayModeRequired = 2,
+ PowerRequestExecutionRequired = 3);
+
///<summary>
+/// simple interface for the Windows API PowerCreateRequest / PowerSetRequest / PowerClearRequest
+/// Avaiable in Windows 7 and later.
+/// @returns an interface which, when released, calls PowerClearRequest
+/// See also BlockScreenSaver </summary>
+function SetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType): IInterface;
+
+///<summary>
/// Uses the Windows API PowerCreateRequest and PowerSetRequest (Windows 7 and later) to
/// prevent the screen saver from starting.
/// @param Reason is the reason why the screen saver is blocked
@@ -880,12 +894,6 @@
end;
);
end;
-type
- TPowerRequestType = (
- PowerRequestDisplayRequired = 0,
- PowerRequestSystemRequired = 1,
- PowerRequestAwayModeRequired = 2,
- PowerRequestExecutionRequired = 3);
type
TPowerCreateRequest = function(_Context: PReasonContext): THandle; stdcall;
@@ -893,7 +901,7 @@
TPowerClearRequest = function(_Handle: THandle; _RequestType: TPowerRequestType): LongBool; stdcall;
type
- TScreenSaverBlocker = class(TInterfacedObject, IInterface)
+ TPowerRequest = class(TInterfacedObject, IInterface)
private
FDllHandle: HMODULE;
FRequestHandle: THandle;
@@ -903,11 +911,11 @@
FContext: TReasonContext;
FReason: array[0..255] of WideChar;
public
- constructor Create(const _Reason: WideString);
+ constructor Create(const _Reason: WideString; _RequestType: TPowerRequestType);
destructor Destroy; override;
end;
-constructor TScreenSaverBlocker.Create(const _Reason: WideString);
+constructor TPowerRequest.Create(const _Reason: WideString; _RequestType: TPowerRequestType);
begin
inherited Create;
FDllHandle := SafeLoadLibrary(kernel32);
@@ -926,10 +934,10 @@
FRequestHandle := PowerCreateRequest(@FContext);
if FRequestHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError;
- Win32Check(PowerSetRequest(FRequestHandle, PowerRequestDisplayRequired));
+ Win32Check(PowerSetRequest(FRequestHandle, _RequestType));
end;
-destructor TScreenSaverBlocker.Destroy;
+destructor TPowerRequest.Destroy;
begin
if FRequestHandle <> INVALID_HANDLE_VALUE then
CloseHandle(FRequestHandle);
@@ -940,9 +948,14 @@
function BlockScreenSaver(const _Reason: WideString): IInterface;
begin
- Result := TScreenSaverBlocker.Create(_Reason);
+ Result := SetPowerRequest(_Reason, PowerRequestDisplayRequired);
end;
+function SetPowerRequest(const _Reason: WideString; _RequestType: TPowerRequestType): IInterface;
+begin
+ Result := TPowerRequest.Create(_Reason, _RequestType);
+end;
+
function CharToOem(const _s: string): AnsiString;
begin
SetLength(Result, Length(_s));
Modified: trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzStringArrayUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -16,6 +16,8 @@
function TStringArray_Concat(const _Arr1, _Arr2: array of string): TStringArray;
+procedure TStringArray_Append(var _arr: TStringArray; const _Value: string);
+
///<summary>
/// Deletes Count entries from Arr starting from Index.
/// @Note: It is allowed for Index > Length(Arr) and also Index+Count > Length(Arr)
@@ -171,4 +173,13 @@
Result[i + Len1] := _Arr2[i];
end;
+procedure TStringArray_Append(var _arr: TStringArray; const _Value: string);
+var
+ len: Integer;
+begin
+ len := Length(_arr);
+ Setlength(_arr, len + 1);
+ _arr[len] := _Value;
+end;
+
end.
Modified: trunk/ExternalSource/dzlib/u_dzTypes.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzTypes.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -89,6 +89,7 @@
{$IF not Declared(TBytes)}
TBytes = array of Byte;
{$IFEND}
+ TUInt16Array = array of UInt16;
type
TByteMatrix = array of array of Byte;
Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas
===================================================================
--- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-10-11 13:28:27 UTC (rev 3360)
+++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2020-10-23 15:06:13 UTC (rev 3361)
@@ -29,6 +29,7 @@
DBGrids,
Buttons,
Menus,
+ MultiMon, // this unit doesn't exist in older Delphi versions, use a unit alias like Multimon=Windows in that case
{$IFDEF HAS_UNIT_SYSTEM_ACTIONS}
Actions,
{$ENDIF}
@@ -59,7 +60,32 @@
EdzStatusBarNoMatchingPanel = class(EdzVclUtils);
+{$IF not declared(WM_DPICHANGED)}
+const
+ WM_DPICHANGED = $02E0;
+{$IFEND}
+
+{$IF not declared(TWMDpi)}
type
+ TDWordFiller = record
+{$IFDEF CPUX64}
+ Filler: array[1..4] of Byte; // Pad DWORD to make it 8 bytes (4+4) [x64 only]
+{$ENDIF}
+ end;
+
+type
+ TWMDpi = record
+ Msg: Cardinal;
+ MsgFiller: TDWordFiller;
+ YDpi: Word;
+ XDpi: Word;
+ WParamFiller: TDWordFiller;
+ ScaledRect: PRECT;
+ Result: LRESULT;
+ end;
+{$IFEND}
+
+type
///<summary> This is a copy of the TFileFormatsList class from Graphics which
/// is unfortunately only declaread in the implementation section </summary>
TFileFormatsList = class(TList)
@@ -1086,6 +1112,9 @@
function TActionlist_Append(_al: TActionList; const _Caption: string; _ShortCut: TShortCut): TAction; overload;
function TActionlist_Append(_al: TActionList; const _Caption: string; _OnExecute: TNotifyEvent): TAction; overload;
function TActionlist_Append(_al: TActionList; const _Caption: string; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction; overload;
+function TActionlist_Append(_al: TActionList; _ShortCut: TShortCut): TAction; overload;
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent): TAction; overload;
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction; overload;
///<summary>
/// @returns the width of the checkbox in the given TCustomCheckbox
@@ -1215,6 +1244,18 @@
function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum;
_HKEY: HKEY = HKEY_CURRENT_USER): Boolean; overload;
+///<summary>
+/// similar to TForm_ReadPlacement but also adds a hidden component to the form which automatically
+/// calls TForm_StorePlacement when it is being destroyed, so we don't need explicitly call
+/// that in the form's destructor.
+/// @param frm is the form whose placement is to be read
+/// @param Which determines whether the Position and/or the size is to be read
+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
+/// @returns false, if anything goes wrong, including any exceptions that might occur,
+/// true if it worked. </summary>
+function TForm_EnableStorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER): Boolean;
+
///<summary> Generates the registry path for storing a form's placement as used in
/// TForm_Read/StorePlacement. </summary>
function TForm_GetPlacementRegistryPath(_frm: TForm): string; overload; deprecated; // use TForm_GetPlacementRegistryEntry
@@ -1536,6 +1577,8 @@
/// Gets and sets the bottom left coordinates keeping the size </summary>
property BottomLeft: TPoint read GetBottomLeft write SetBottomLeft;
function GetCenter: TPoint;
+ function Right: Integer;
+ function Bottom: Integer;
class operator Implicit(_a: TRect): TRectLTWH;
class operator Implicit(_a: TRectLTWH): TRect;
class function FromLTWH(_Left, _Top, _Width, _Height: Integer): TRectLTWH; static;
@@ -1606,6 +1649,36 @@
procedure TScreen_MakeFullyVisible(var _Rect: TRect); overload;
procedure TScreen_MakeFullyVisible(var _Rect: TRectLTWH); overload;
+
+// this does not compile with Delphi 2007 (it does with Delphi 10.2)
+// todo: find the first verstion that compiles this
+{$IFDEF DELPHI2009_UP}
+{$DEFINE COMPILER_SUPPORTS_TDZSCREEN}
+{$ENDIF}
+
+{$IFDEF COMPILER_SUPPORTS_TDZSCREEN}
+type
+ PdzScreen = ^TdzScreen;
+ TdzScreen = record
+ public
+ type
+ PdzMonitor = ^TdzMonitor;
+ TdzMonitor = record
+ public
+ Handle: HMONITOR;
+ MonitorNum: Integer;
+ BoundsRect: TRectLTWH;
+ WorkArea: TRectLTWH;
+ Name: string;
+ IsPrimary: Boolean;
+ end;
+ type
+ TMonitorArr = array of TdzMonitor;
+ public
+ Monitors: TMonitorArr;
+ class function Create: TdzScreen; static;
+ end;
+{$ENDIF}
///<summary>
/// Sets the given column of the StringList to the given string list,
/// adjusting the RowCount if necessary.
@@ -4478,6 +4551,42 @@
Result := TForm_ReadPlacement(_frm, _Which, TForm_GetPlacementRegistryEntry(_frm), _HKEY);
end;
+type
+ TFormStorePlacementEnabler = class(TComponent)
+ private
+ FForm: TForm;
+ FWhich: TFormPlacementEnum;
+ FHKEY: HKEY;
+ public
+ constructor Create(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER); reintroduce;
+ destructor Destroy; override;
+ end;
+
+{ TFormStorePlacementEnabler }
+
+constructor TFormStorePlacementEnabler.Create(_frm: TForm; _Which: TFormPlacementEnum; _HKEY: HKEY);
+begin
+ inherited Create(_frm);
+ Name := '';
+ FForm := _frm;
+ FWhich := _Which;
+ FHKEY := _HKEY;
+end;
+
+destructor TFormStorePlacementEnabler.Destroy;
+begin
+ TForm_StorePlacement(FForm, FWhich, FHKEY);
+ inherited;
+end;
+
+function TForm_EnableStorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
+ _HKEY: HKEY = HKEY_CURRENT_USER): Boolean;
+begin
+ Result := TForm_ReadPlacement(_frm, _Which, _HKEY);
+ TFormStorePlacementEnabler.Create(_frm, _Which, _HKEY);
+end;
+
procedure TForm_SetMinConstraints(_frm: TForm);
begin
TControl_SetMinConstraints(_frm);
@@ -5952,6 +6061,21 @@
Result.OnExecute := _OnExecute;
end;
+function TActionlist_Append(_al: TActionList; _ShortCut: TShortCut): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _ShortCut);
+end;
+
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _OnExecute);
+end;
+
+function TActionlist_Append(_al: TActionList; _OnExecute: TNotifyEvent; _ShortCut: TShortCut): TAction;
+begin
+ Result := TActionlist_Append(_al, '', _OnExecute, _ShortCut);
+end;
+
{$IFDEF SUPPORTS_ENHANCED_RECORDS}
{ TActionListShortcutHelper }
@@ -6239,6 +6363,16 @@
Result.Assign(_Left, _Top, _Width, _Height);
end;
+function TRectLTWH.Right: Integer;
+begin
+ Result := Left + Width;
+end;
+
+function TRectLTWH.Bottom: Integer;
+begin
+ Result := Top + Height;
+end;
+
function TRectLTWH.GetBottomLeft: TPoint;
begin
Result := Point(Left, Top + Height);
@@ -6659,6 +6793,43 @@
Result.ValueName := _ValueName;
end;
+{$IFDEF COMPILER_SUPPORTS_TDZSCREEN}
+
+{ TdzScreen }
+
+function EnumMonitorsProc(hm: HMONITOR; dc: HDC; r: PRECT; Data: Pointer): Boolean; stdcall;
+var
+ Info: TMonitorInfoEx;
+ M: TdzScreen.PdzMonitor;
+ Screen: PdzScreen;
+ Idx: Integer;
+begin
+ Screen := PdzScreen(Data);
+ Idx := Length(Screen.Monitors);
+ SetLength(Screen.Monitors, Idx + 1);
+ M := @(Screen.Monitors[Idx]);
+ M.Handle := hm;
+ M.MonitorNum := Idx;
+
+ ZeroMemory(@Info, SizeOf(Info));
+ Info.cbSize := SizeOf(Info);
+ // we need to typecast this because we pass a pointer ot TMonitorInfoEx rather than TMonitorInfo
+ if not GetMonitorInfo(hm, PMonitorInfo(@Info)) then
+ RaiseLastOSError;
+
+ M.BoundsRect := Info.rcMonitor;
+ M.WorkArea := Info.rcWork;
+ M.Name := PChar(@Info.szDevice[0]);
+
+ Result := True;
+end;
+
+class function TdzScreen.Create: TdzScreen;
+begin
+ EnumDisplayMonitors(0, nil, TMonitorEnumProc(@EnumMonitorsProc), Windows.LParam(@Result));
+end;
+{$ENDIF}
+
initialization
InitializeCustomMessages;
finalization
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|