From: <tw...@us...> - 2022-01-22 14:01:46
|
Revision: 3795 http://sourceforge.net/p/gexperts/code/3795 Author: twm Date: 2022-01-22 14:01:43 +0000 (Sat, 22 Jan 2022) Log Message: ----------- synced with dzlib from OSDN Modified Paths: -------------- trunk/ExternalSource/dzlib/dzlib.inc trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas trunk/ExternalSource/dzlib/u_dzVclUtils.pas Modified: trunk/ExternalSource/dzlib/dzlib.inc =================================================================== --- trunk/ExternalSource/dzlib/dzlib.inc 2022-01-17 06:00:05 UTC (rev 3794) +++ trunk/ExternalSource/dzlib/dzlib.inc 2022-01-22 14:01:43 UTC (rev 3795) @@ -106,8 +106,14 @@ {$DEFINE HAS_INTTOHEX_FUNCTION_UINT64} {$ENDIF} +{$IFDEF DELPHIX_TOKYO_UP} +// todo: Adjust to reflect when TPicture.LoadFromStream was made public and suported more than +// TBitmap. +{$DEFINE PICTURE_HAS_PUBLIC_LOADFROMSTREAM} +{$ENDIF} + {$IFDEF DELPHI2010_UP} -{$DEFINE CUSTOMINIFILE_HAS_READSUBSECTIONS} + {$DEFINE CUSTOMINIFILE_HAS_READSUBSECTIONS} {$ENDIF} Modified: trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas 2022-01-17 06:00:05 UTC (rev 3794) +++ trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas 2022-01-22 14:01:43 UTC (rev 3795) @@ -46,27 +46,13 @@ FDesignDpi: Integer; FCurrentDpi: Integer; public - procedure Init(_frm: TCustomForm); overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - procedure Init(_DPI: Integer); overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - procedure Init(_DesignDpi, _CurrentDpi: Integer); overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - procedure SetCurrentDpi(_frm: TCustomForm); overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - procedure SetCurrentDpi(_DPI: Integer); overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - function Calc(_Value: Integer): Integer; overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} - function Calc(const _Value: TRect): TRect; overload; -{$IFDEF SUPPORTS_INLINE} inline; -{$ENDIF} + procedure Init(_frm: TCustomForm); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Init(_Dpi: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Init(_DesignDpi, _CurrentDpi: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure SetCurrentDpi(_frm: TCustomForm); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure SetCurrentDpi(_Dpi: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function Calc(_Value: Integer): Integer; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function Calc(const _Value: TRect): TRect; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} function ScaleFactorPercent: Integer; end; @@ -162,10 +148,10 @@ Result.Bottom := Calc(_Value.Bottom); end; -procedure TDpiScaler.Init(_DPI: Integer); +procedure TDpiScaler.Init(_Dpi: Integer); begin - FDesignDpi := _DPI; - FCurrentDpi := _DPI; + FDesignDpi := _Dpi; + FCurrentDpi := _Dpi; end; procedure TDpiScaler.Init(_DesignDpi, _CurrentDpi: Integer); @@ -210,9 +196,9 @@ Result := MulDiv(100, FCurrentDpi, FDesignDpi); end; -procedure TDpiScaler.SetCurrentDpi(_DPI: Integer); +procedure TDpiScaler.SetCurrentDpi(_Dpi: Integer); begin - FCurrentDpi := _DPI; + FCurrentDpi := _Dpi; end; procedure TDpiScaler.SetCurrentDpi(_frm: TCustomForm); @@ -579,5 +565,3 @@ CloseFile(LogFile); {$ENDIF} end. - - Modified: trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2022-01-17 06:00:05 UTC (rev 3794) +++ trunk/ExternalSource/dzlib/u_dzGraphicsUtils.pas 2022-01-22 14:01:43 UTC (rev 3795) @@ -43,6 +43,7 @@ Windows, Types, SysUtils, + Classes, Graphics, {$IFDEF HAS_UNIT_SYSTEM_UITYPES} System.UITypes, @@ -704,12 +705,20 @@ function TryStr2Color(const _s: string; out _Color: TColor): Boolean; +function TPicture_TryLoadMatchingFile(_pic: TPicture; const _FileMask: string): Boolean; + +function TPicture_TryLoadFromResource(_pic: TPicture; const _ResName: string): Boolean; + implementation uses Math, jpeg, // if you get a compile error here you might need to add Vcl.Imaging to the unit scope names - GraphUtil; +{$IFDEF HAS_UNIT_PNGIMAGE} + pngimage, // support for TImage.LoadGraphics for PNG files +{$ENDIF} + GraphUtil, + u_dzFileUtils; function _(const _s: string): string; {$IFDEF SUPPORTS_INLINE} @@ -1128,7 +1137,7 @@ _Canvas.Polygon([_Tip, Point(BaselineLeft, BaselineY), Point(BaselineRight, BaselineY)]); end; -// Inlined method must be iomplemented before it is called +// Inlined method must be implemented before it is called function GetFastLuminance(const _Red, _Green, _Blue: Byte): Byte; begin Result := Round(0.299 * _Red + 0.587 * _Green + 0.114 * _Blue); @@ -3471,4 +3480,75 @@ end; end; +function TPicture_TryLoadMatchingFile(_pic: TPicture; const _FileMask: string): Boolean; +var + fn: string; +begin + Result := False; + if TFileSystem.FindMatchingFile(_FileMask, fn) = mfFile then begin + try + _pic.LoadFromFile(fn); + Result := True; + except + end; + end; +end; + +{$IFNDEF PICTURE_HAS_PUBLIC_LOADFROMSTREAM} +function TPicture_TryLoadFromJpgStream(_pic: TPicture; _st: TStream): Boolean; +var + jpg: TJPEGImage; +begin + jpg := TJPEGImage.Create; + try + try + _st.Position := 0; + jpg.LoadFromStream(_st); + _pic.Bitmap.Assign(jpg); + Result := True; + except + Result := False; + end; + finally + FreeAndNil(jpg); + end; +end; + +function TPicture_TryLoadFromBmpStream(_pic: TPicture; _st: TStream): Boolean; +begin + try + _st.Position := 0; + _pic.Bitmap.LoadFromStream(_st); + Result := True; + except + Result := False; + end; +end; +{$ENDIF} + +function TPicture_TryLoadFromResource(_pic: TPicture; const _ResName: string): Boolean; +var + ResStream: TResourceStream; +begin + Assert(Assigned(_pic)); + try + ResStream := TResourceStream.Create(HInstance, _ResName, RT_rcdata); + try + ResStream.Position := 0; +{$IFDEF PICTURE_HAS_PUBLIC_LOADFROMSTREAM} + _pic.LoadFromStream(ResStream); + Result := True; +{$ELSE} + Result := TPicture_TryLoadFromJpgStream(_pic, ResStream); + if not Result then + Result := TPicture_TryLoadFromBmpStream(_pic, ResStream); +{$ENDIF} + finally + FreeAndNil(ResStream); + end; + except + Result := False; + end; +end; + end. Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2022-01-17 06:00:05 UTC (rev 3794) +++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2022-01-22 14:01:43 UTC (rev 3795) @@ -1210,6 +1210,14 @@ /// @returns the center of the form as a TPoint </summary> function TForm_GetCenter(_frm: TForm): TPoint; +///<summary> +/// Starts a background thread that waits for a new window to be activated and then centers it +/// on the current active window. It also makes sure that the new windows is fully visible. +/// @NOTE: This procedure must be called *before* opening the window to be centered. +/// @NOTE: This should work with any kind of window, not just common dialogs, but has +/// not been tested </summary> +procedure TCommonDialog_CenterWithBackgroundThread; + type TFormPlacementEnum = (fpePositionOnly, fpeSizeOnly, fpePosAndSize); @@ -1333,9 +1341,11 @@ function TForm_ReadConfigValue(_frm: TForm; const _Name: string; const _Default: string = ''): string; overload; function TForm_ReadConfigValue(_frm: TForm; const _Name: string; _Default: Integer): Integer; overload; +function TForm_ReadConfigValue(_frm: TForm; const _Name: string; _Default: Boolean): Boolean; overload; function TForm_WriteConfigValue(_frm: TForm; const _Name, _Value: string): Boolean; overload; function TForm_WriteConfigValue(_frm: TForm; const _Name: string; _Value: Integer): Boolean; overload; +function TForm_WriteConfigValue(_frm: TForm; const _Name: string; _Value: Boolean): Boolean; overload; ///<summary> Sets the form's Constraints.MinWidth and .MinHeight to the form's current size. </summary> procedure TForm_SetMinConstraints(_frm: TForm); deprecated; // use TControl_SetMinConstraints instead @@ -1577,6 +1587,12 @@ procedure TActionList_SetAllVisible(_al: TActionList; _Visible: Boolean); ///<summary> +/// (Tries to) set the Enabled property of all actions in the action list. +/// This only works for Actions that are derived from TCustomAction (TActionList.Actions contains +/// TBasicAction items, so this is not necessarily true for all actions). +procedure TActionList_SetAllEnabled(_al: TActionList; _Enabled: Boolean); + +///<summary> /// Sets the Enabled property of all actions that match the given category. </summary> procedure TActionList_SetCategoryEnabled(_al: TActionList; const _Category: string; _Enabled: Boolean); @@ -1651,10 +1667,14 @@ procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Left, _Top, _Width, _Height: Integer); overload; procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Left, _Top, _Width, _Height: Integer); overload; procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRect; out _Width, _Height: Integer); overload; +procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRect); overload; +procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRectLTWH); overload; procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRect; out _Width, _Height: Integer); overload; procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRect); overload; procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRectLTWH); overload; procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; _frm: TForm); overload; +procedure TMonitor_MakeFullyVisible(_MonitorHandle: HMonitor; var _Rect: TRect); overload; +procedure TMonitor_MakeFullyVisible(_MonitorHandle: HMonitor; var _Rect: TRectLTWH); overload; ///<summary> /// Tries to get the primary monitor. @@ -1774,7 +1794,8 @@ u_dzLineBuilder, u_dzTypesUtils, u_dzOsUtils, - u_dzStringArrayUtils; + u_dzStringArrayUtils, + u_dzNamedThread; function _(const _s: string): string; {$IFDEF SUPPORTS_INLINE} @@ -2575,8 +2596,8 @@ FLbl.Font.Style := FLbl.Font.Style + [fsUnderline]; FLbl.Font.Color := clBlue; FLbl.Cursor := crHandPoint; - if (FLbl.hint = '') and (Menus.StripHotkey(FLbl.Caption) <> FUrl) then begin - FLbl.hint := FUrl; + if (FLbl.Hint = '') and (Menus.StripHotkey(FLbl.Caption) <> FUrl) then begin + FLbl.Hint := FUrl; FLbl.ShowHint := True; end; end; @@ -4158,7 +4179,7 @@ procedure TControl_SetHint(_Ctrl: TControl; const _Hint: string); begin - _Ctrl.hint := _Hint; + _Ctrl.Hint := _Hint; _Ctrl.ShowHint := True; end; @@ -4332,13 +4353,18 @@ procedure TForm_CenterOn(_frmHwnd: HWND; _Center: TPoint); var - Position: TRect; + FrmRect: TRect; + FrmCenter: TPoint; + MonitorHandle: HMonitor; begin - GetWindowRect(_frmHwnd, Position); + GetWindowRect(_frmHwnd, FrmRect); + FrmCenter := TRect_Center(FrmRect); + TRect_SetOffset(FrmRect, _Center.X - FrmCenter.X, _Center.Y - FrmCenter.Y); + MonitorHandle := MonitorFromRect(@FrmRect, MONITOR_DEFAULTTONEAREST); + TMonitor_MakeFullyVisible(MonitorHandle, FrmRect); SetWindowPos(_frmHwnd, HWND_TOPMOST, - _Center.X - (Position.Right - Position.Left) div 2, - _Center.Y - (Position.Bottom - Position.Top) div 2, - 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE); + FrmRect.Left, FrmRect.Top, 0, 0, + SWP_SHOWWINDOW or SWP_NOSIZE); end; procedure TForm_CenterOn(_frm: TForm; _Center: TWinControl); @@ -4470,6 +4496,11 @@ Result := TRegistry_ReadInteger(TForm_GetConfigRegistryKey(_frm), _Name, _Default); end; +function TForm_ReadConfigValue(_frm: TForm; const _Name: string; _Default: Boolean): Boolean; +begin + Result := TRegistry_ReadBool(TForm_GetConfigRegistryKey(_frm), _Name, _Default); +end; + function TForm_WriteConfigValue(_frm: TForm; const _Name, _Value: string): Boolean; begin try @@ -4490,6 +4521,16 @@ end; end; +function TForm_WriteConfigValue(_frm: TForm; const _Name: string; _Value: Boolean): Boolean; +begin + try + TRegistry_WriteBool(TForm_GetConfigRegistryKey(_frm), _Name, _Value); + Result := True; + except + Result := False; + end; +end; + function TForm_StorePlacement(const _Bounds: TRectLTWH; const _RegEntry: TRegistryEntry; _HKEY: HKEY = HKEY_CURRENT_USER): Boolean; begin @@ -4576,7 +4617,7 @@ var s: string; PosStr: string; - l, t, w, h: Integer; + L, t, w, h: Integer; begin if u_dzOsUtils.IsShiftDown then begin // if the user holds shift, do not restore the form's placement @@ -4588,7 +4629,7 @@ Result := TRegistry_TryReadString(_RegEntry.KeyName, _RegEntry.ValueName, PosStr, _HKEY); if Result then begin s := ExtractStr(PosStr, ','); - if not TryStrToInt(s, l) then + if not TryStrToInt(s, L) then Exit; //==> s := ExtractStr(PosStr, ','); if not TryStrToInt(s, t) then @@ -4600,7 +4641,7 @@ if not TryStrToInt(s, h) then Exit; //==> - _Bounds.Left := l; + _Bounds.Left := L; _Bounds.Top := t; _Bounds.Width := w; _Bounds.Height := h; @@ -5698,6 +5739,18 @@ end; end; +procedure TActionList_SetAllEnabled(_al: TActionList; _Enabled: Boolean); +var + i: Integer; + act: TBasicAction; +begin + for i := 0 to _al.ActionCount - 1 do begin + act := _al[i]; + if act is TCustomAction then + TCustomAction(act).Enabled := _Enabled; + end; +end; + type THackGroupBox = class(TCustomGroupBox) end; @@ -5815,12 +5868,12 @@ begin inherited Create; FCtrl := _Ctrl; - SendMessage(FCtrl.Handle, WM_SETREDRAW, wParam(LongBool(False)), 0); + SendMessage(FCtrl.Handle, WM_SETREDRAW, WPARAM(LongBool(False)), 0); end; destructor TWinControlLocker.Destroy; begin - SendMessage(FCtrl.Handle, WM_SETREDRAW, wParam(LongBool(True)), 0); + SendMessage(FCtrl.Handle, WM_SETREDRAW, WPARAM(LongBool(True)), 0); RedrawWindow(FCtrl.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN); inherited; end; @@ -5876,8 +5929,8 @@ procedure TdzButtonedEdit.Loaded; begin inherited; - if RightButton.Visible and (RightButton.hint = '') then begin - RightButton.hint := _('Ctrl+Return to ''click'' right button.'); + if RightButton.Visible and (RightButton.Hint = '') then begin + RightButton.Hint := _('Ctrl+Return to ''click'' right button.'); ShowHint := True; end; end; @@ -6536,6 +6589,19 @@ _Rect.Bottom := Top + _Height; end; +procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRect); +var + Width: Integer; + Height: Integer; +begin + TMonitor_MakeFullyVisible(_MonitorRect, _Rect, Width, Height); +end; + +procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRectLTWH); +begin + TMonitor_MakeFullyVisible(_MonitorRect, _Rect.Left, _Rect.Top, _Rect.Width, _Rect.Height); +end; + procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRect; out _Width, _Height: Integer); var Left: Integer; @@ -6579,6 +6645,30 @@ _frm.BoundsRect := re; end; +procedure TMonitor_MakeFullyVisible(_MonitorHandle: HMonitor; var _Rect: TRect); +var + MonitorInfo: TMonitorInfo; +begin + MonitorInfo.cbSize := SizeOf(MonitorInfo); + if not GetMonitorInfo(_MonitorHandle, @MonitorInfo) then begin + // no monitor info available, we can't do anything + Exit; //==> + end; + TMonitor_MakeFullyVisible(MonitorInfo.rcWork, _Rect); +end; + +procedure TMonitor_MakeFullyVisible(_MonitorHandle: HMonitor; var _Rect: TRectLTWH); +var + MonitorInfo: TMonitorInfo; +begin + MonitorInfo.cbSize := SizeOf(MonitorInfo); + if not GetMonitorInfo(_MonitorHandle, @MonitorInfo) then begin + // no monitor infor available, we can't do anything + Exit; //==> + end; + TMonitor_MakeFullyVisible(MonitorInfo.rcWork, _Rect); +end; + function TScreen_GetPrimaryMonitor: TMonitor; begin if not TScreen_TryGetPrimaryMonitor(Result) then @@ -6876,7 +6966,7 @@ tb: TTrackBar; begin tb := TrackBar; - tb.hint := IntToStr(tb.Position); + tb.Hint := IntToStr(tb.Position); Application.ActivateHint(Mouse.CursorPos); doOnChange(_Sender); end; @@ -7033,6 +7123,64 @@ WM_WINDOW_PROC_HOOK_HELPER := RegisterWindowMessage('WM_WINDOW_PROC_HOOK_HELPER'); end; +type + TCenterWindowThread = class(TNamedThread) + private + FParentHandle: HWND; + protected + procedure Execute; override; + public + constructor Create(_ParentHandle: HWND); + end; + +{ TCenterWindowThread } + +constructor TCenterWindowThread.Create(_ParentHandle: HWND); +begin + FreeOnTerminate := True; + FParentHandle := _ParentHandle; + inherited Create(False); +end; + +procedure TCenterWindowThread.Execute; +var + MaxTickCount: DWORD; + ThreadInfo: TGUIThreadinfo; + ParentRect: TRect; + ParentCenter: TPoint; +begin + inherited; + + GetWindowRect(FParentHandle, ParentRect); + ParentCenter := TRect_Center(ParentRect); + + ThreadInfo.cbSize := SizeOf(ThreadInfo); + MaxTickCount := GetTickCount + 10000; // 10 Seconds should be plenty + while MaxTickCount > GetTickCount do begin + Sleep(50); + if GetGUIThreadInfo(MainThreadID, ThreadInfo) then begin + if ThreadInfo.hwndActive <> FParentHandle then begin + // After the first call to TForm_CenterOn the window sometimes doesn't get moved, + // at other times it gets shown outside the visible area. Calling it twice with a 50 ms + // delay always seems to work. Only sleeping for 50 ms before the call didn't work either. + TForm_CenterOn(ThreadInfo.hwndActive, ParentCenter); + Sleep(50); + TForm_CenterOn(ThreadInfo.hwndActive, ParentCenter); + Exit; //==> + end; + end; + end; +end; + +procedure TCommonDialog_CenterWithBackgroundThread; +var + ThreadInfo: TGUIThreadinfo; +begin + ThreadInfo.cbSize := SizeOf(ThreadInfo); + GetGUIThreadInfo(MainThreadID, ThreadInfo); + TCenterWindowThread.Create(ThreadInfo.hwndActive); +end; + {$IFDEF SUPPORTS_ENHANCED_RECORDS} { TRegistryEntry } @@ -7091,4 +7239,3 @@ finalization FreeAndNil(gblCheckListBoxHelper); end. - This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |