├── Main.pas ├── ICON_1.res ├── ICON_2.res ├── ICON_3.res ├── obj ├── gzio.obj ├── JCHUFF.OBJ ├── JCINIT.OBJ ├── JDHUFF.OBJ ├── JERROR.OBJ ├── JUTILS.OBJ ├── crc32.obj ├── trees.obj ├── zutil.obj ├── JCAPIMIN.OBJ ├── JCAPISTD.OBJ ├── JCCOEFCT.OBJ ├── JCCOLOR.OBJ ├── JCDCTMGR.OBJ ├── JCMAINCT.OBJ ├── JCMARKER.OBJ ├── JCMASTER.OBJ ├── JCOMAPI.OBJ ├── JCPARAM.OBJ ├── JCPHUFF.OBJ ├── JCPREPCT.OBJ ├── JCSAMPLE.OBJ ├── JCTRANS.OBJ ├── JDAPIMIN.OBJ ├── JDAPISTD.OBJ ├── JDATADST.OBJ ├── JDATASRC.OBJ ├── JDCOEFCT.OBJ ├── JDCOLOR.OBJ ├── JDDCTMGR.OBJ ├── JDINPUT.OBJ ├── JDMAINCT.OBJ ├── JDMARKER.OBJ ├── JDMASTER.OBJ ├── JDMERGE.OBJ ├── JDPHUFF.OBJ ├── JDPOSTCT.OBJ ├── JDSAMPLE.OBJ ├── JDTRANS.OBJ ├── JFDCTFLT.OBJ ├── JFDCTFST.OBJ ├── JFDCTINT.OBJ ├── JIDCTFLT.OBJ ├── JIDCTFST.OBJ ├── JIDCTINT.OBJ ├── JIDCTRED.OBJ ├── JMEMMGR.OBJ ├── JMEMNOBS.OBJ ├── JPEGTRAN.OBJ ├── JQUANT1.OBJ ├── JQUANT2.OBJ ├── adler32.obj ├── compress.obj ├── deflate.obj ├── infback.obj ├── inffast.obj ├── inflate.obj ├── inftrees.obj └── uncompr.obj ├── Manifest1.res ├── PNGIMAGE_1.res ├── PNGIMAGE_2.res ├── WinXHelper.res ├── .github ├── cover.jpg ├── demo.mp4 ├── snap02.jpg ├── snap02b.jpg ├── snap03.jpg ├── snap03b.jpg ├── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md └── FUNDING.yml ├── WINXCORNERS.ASM ├── WinXCorners.res ├── frmSettings.pas ├── WinXCorners_Icon3.ico ├── thirparty ├── pngimage.pas ├── pnglang.pas ├── DirectX.inc ├── zlibpas.pas ├── DwmApi.pas └── AnimateEasing.pas ├── Main.vlb ├── osdgui.dfm ├── compile.cmd ├── .vscode └── tasks.json ├── GDIPAPIExtra.pas ├── PerMonitorDpiAwareness.manifest ├── LICENSE ├── WinXCorners.dpr ├── Main.dfm ├── frmSettings.dfm ├── .gitignore ├── WinXCorners.groupproj ├── .gitattributes ├── WinXHelper.dpr ├── conditionsHelper.pas ├── osdgui.pas ├── WinXCorners.mes ├── WinXHelper.dproj ├── WinXCorners.bdsproj ├── WinXHelper.bdsproj ├── hotkeyhelper.pas ├── README.md ├── frmAdvanced.dfm ├── XCombobox.pas ├── XCheckbox.pas └── frmAdvanced.pas /Main.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/Main.pas -------------------------------------------------------------------------------- /ICON_1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/ICON_1.res -------------------------------------------------------------------------------- /ICON_2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/ICON_2.res -------------------------------------------------------------------------------- /ICON_3.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/ICON_3.res -------------------------------------------------------------------------------- /obj/gzio.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/gzio.obj -------------------------------------------------------------------------------- /Manifest1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/Manifest1.res -------------------------------------------------------------------------------- /PNGIMAGE_1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/PNGIMAGE_1.res -------------------------------------------------------------------------------- /PNGIMAGE_2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/PNGIMAGE_2.res -------------------------------------------------------------------------------- /WinXHelper.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/WinXHelper.res -------------------------------------------------------------------------------- /obj/JCHUFF.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCHUFF.OBJ -------------------------------------------------------------------------------- /obj/JCINIT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCINIT.OBJ -------------------------------------------------------------------------------- /obj/JDHUFF.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDHUFF.OBJ -------------------------------------------------------------------------------- /obj/JERROR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JERROR.OBJ -------------------------------------------------------------------------------- /obj/JUTILS.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JUTILS.OBJ -------------------------------------------------------------------------------- /obj/crc32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/crc32.obj -------------------------------------------------------------------------------- /obj/trees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/trees.obj -------------------------------------------------------------------------------- /obj/zutil.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/zutil.obj -------------------------------------------------------------------------------- /.github/cover.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/cover.jpg -------------------------------------------------------------------------------- /.github/demo.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/demo.mp4 -------------------------------------------------------------------------------- /WINXCORNERS.ASM: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/WINXCORNERS.ASM -------------------------------------------------------------------------------- /WinXCorners.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/WinXCorners.res -------------------------------------------------------------------------------- /frmSettings.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/frmSettings.pas -------------------------------------------------------------------------------- /obj/JCAPIMIN.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCAPIMIN.OBJ -------------------------------------------------------------------------------- /obj/JCAPISTD.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCAPISTD.OBJ -------------------------------------------------------------------------------- /obj/JCCOEFCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCCOEFCT.OBJ -------------------------------------------------------------------------------- /obj/JCCOLOR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCCOLOR.OBJ -------------------------------------------------------------------------------- /obj/JCDCTMGR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCDCTMGR.OBJ -------------------------------------------------------------------------------- /obj/JCMAINCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCMAINCT.OBJ -------------------------------------------------------------------------------- /obj/JCMARKER.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCMARKER.OBJ -------------------------------------------------------------------------------- /obj/JCMASTER.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCMASTER.OBJ -------------------------------------------------------------------------------- /obj/JCOMAPI.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCOMAPI.OBJ -------------------------------------------------------------------------------- /obj/JCPARAM.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCPARAM.OBJ -------------------------------------------------------------------------------- /obj/JCPHUFF.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCPHUFF.OBJ -------------------------------------------------------------------------------- /obj/JCPREPCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCPREPCT.OBJ -------------------------------------------------------------------------------- /obj/JCSAMPLE.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCSAMPLE.OBJ -------------------------------------------------------------------------------- /obj/JCTRANS.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JCTRANS.OBJ -------------------------------------------------------------------------------- /obj/JDAPIMIN.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDAPIMIN.OBJ -------------------------------------------------------------------------------- /obj/JDAPISTD.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDAPISTD.OBJ -------------------------------------------------------------------------------- /obj/JDATADST.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDATADST.OBJ -------------------------------------------------------------------------------- /obj/JDATASRC.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDATASRC.OBJ -------------------------------------------------------------------------------- /obj/JDCOEFCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDCOEFCT.OBJ -------------------------------------------------------------------------------- /obj/JDCOLOR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDCOLOR.OBJ -------------------------------------------------------------------------------- /obj/JDDCTMGR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDDCTMGR.OBJ -------------------------------------------------------------------------------- /obj/JDINPUT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDINPUT.OBJ -------------------------------------------------------------------------------- /obj/JDMAINCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDMAINCT.OBJ -------------------------------------------------------------------------------- /obj/JDMARKER.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDMARKER.OBJ -------------------------------------------------------------------------------- /obj/JDMASTER.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDMASTER.OBJ -------------------------------------------------------------------------------- /obj/JDMERGE.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDMERGE.OBJ -------------------------------------------------------------------------------- /obj/JDPHUFF.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDPHUFF.OBJ -------------------------------------------------------------------------------- /obj/JDPOSTCT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDPOSTCT.OBJ -------------------------------------------------------------------------------- /obj/JDSAMPLE.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDSAMPLE.OBJ -------------------------------------------------------------------------------- /obj/JDTRANS.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JDTRANS.OBJ -------------------------------------------------------------------------------- /obj/JFDCTFLT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JFDCTFLT.OBJ -------------------------------------------------------------------------------- /obj/JFDCTFST.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JFDCTFST.OBJ -------------------------------------------------------------------------------- /obj/JFDCTINT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JFDCTINT.OBJ -------------------------------------------------------------------------------- /obj/JIDCTFLT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JIDCTFLT.OBJ -------------------------------------------------------------------------------- /obj/JIDCTFST.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JIDCTFST.OBJ -------------------------------------------------------------------------------- /obj/JIDCTINT.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JIDCTINT.OBJ -------------------------------------------------------------------------------- /obj/JIDCTRED.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JIDCTRED.OBJ -------------------------------------------------------------------------------- /obj/JMEMMGR.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JMEMMGR.OBJ -------------------------------------------------------------------------------- /obj/JMEMNOBS.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JMEMNOBS.OBJ -------------------------------------------------------------------------------- /obj/JPEGTRAN.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JPEGTRAN.OBJ -------------------------------------------------------------------------------- /obj/JQUANT1.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JQUANT1.OBJ -------------------------------------------------------------------------------- /obj/JQUANT2.OBJ: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/JQUANT2.OBJ -------------------------------------------------------------------------------- /obj/adler32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/adler32.obj -------------------------------------------------------------------------------- /obj/compress.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/compress.obj -------------------------------------------------------------------------------- /obj/deflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/deflate.obj -------------------------------------------------------------------------------- /obj/infback.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/infback.obj -------------------------------------------------------------------------------- /obj/inffast.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/inffast.obj -------------------------------------------------------------------------------- /obj/inflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/inflate.obj -------------------------------------------------------------------------------- /obj/inftrees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/inftrees.obj -------------------------------------------------------------------------------- /obj/uncompr.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/obj/uncompr.obj -------------------------------------------------------------------------------- /.github/snap02.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/snap02.jpg -------------------------------------------------------------------------------- /.github/snap02b.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/snap02b.jpg -------------------------------------------------------------------------------- /.github/snap03.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/snap03.jpg -------------------------------------------------------------------------------- /.github/snap03b.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/.github/snap03b.jpg -------------------------------------------------------------------------------- /WinXCorners_Icon3.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/WinXCorners_Icon3.ico -------------------------------------------------------------------------------- /thirparty/pngimage.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/thirparty/pngimage.pas -------------------------------------------------------------------------------- /thirparty/pnglang.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/winxcorners/HEAD/thirparty/pnglang.pas -------------------------------------------------------------------------------- /Main.vlb: -------------------------------------------------------------------------------- 1 | [tmrHotSpot] 2 | Coordinates=0,0,79,36 3 | 4 | [emporarydisabled1] 5 | Coordinates=98,1,124,36 6 | 7 | [N1] 8 | Coordinates=79,55,40,36 9 | 10 | [tmrDelay] 11 | Coordinates=260,1,66,36 12 | 13 | [PopupMenu1] 14 | Coordinates=260,56,90,36 15 | 16 | [About1] 17 | Coordinates=20,55,55,36 18 | 19 | [Exit1] 20 | Coordinates=260,111,43,36 21 | 22 | [Advanced1] 23 | Coordinates=171,129,79,36 24 | 25 | -------------------------------------------------------------------------------- /osdgui.dfm: -------------------------------------------------------------------------------- 1 | object frmOSD: TfrmOSD 2 | Left = 0 3 | Top = 0 4 | Caption = 'frmOSD' 5 | ClientHeight = 119 6 | ClientWidth = 148 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnActivate = FormActivate 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | end 20 | -------------------------------------------------------------------------------- /compile.cmd: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | rem SET MSBUILD="C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\MSBuild\Current\Bin\MSBuild.exe" 4 | SET MSBUILD="c:\Program Files (x86)\Microsoft Visual Studio\2019\BuildTools\MSBuild\Current\Bin\MSBuild.exe" 5 | SET RSVARS="C:\Program Files (x86)\Embarcadero\Studio\23.0\bin\rsvars.bat" 6 | 7 | SET PROJECT=WinXCorners.dproj 8 | 9 | call %RSVARS% 10 | %MSBUILD% %PROJECT% "/t:Clean,Make" "/p:config=Release" "/verbosity:minimal" 11 | 12 | if %ERRORLEVEL% NEQ 0 GOTO END 13 | 14 | echo. 15 | :END 16 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Describe alternatives you've considered** 17 | A clear and concise description of any alternative solutions or features you've considered. 18 | 19 | **Additional context** 20 | Add any other context or screenshots about the feature request here. 21 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help me improve 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Steps to reproduce the behavior: 15 | 1. Go to '...' 16 | 2. Click on '....' 17 | 3. See error 18 | 19 | **Expected behavior** 20 | A clear and concise description of what you expected to happen. 21 | 22 | **Screenshots** 23 | If applicable, add screenshots to help explain your problem. 24 | 25 | **Desktop (please complete the following information):** 26 | - Windows 10/11 version: [e.g. Window 11 x64 23H2 build 22631 use winver command or press WIn+Pause] 27 | - WinXcorners Version [e.g. 1.2.1b] 28 | 29 | **Additional context** 30 | Add any other context about the problem here. 31 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [vhanla] # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry 12 | polar: # Replace with a single Polar username 13 | buy_me_a_coffee: # Replace with a single Buy Me a Coffee username 14 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 15 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "tasks": [ 4 | { 5 | "label": "Compile", 6 | "type": "shell", 7 | "command": "${workspaceFolder}\\compile.cmd", 8 | "args": [], 9 | "group": { 10 | "kind": "build", 11 | "isDefault": true 12 | }, 13 | "problemMatcher": { 14 | "owner": "external", 15 | "fileLocation": ["relative", "${workspaceFolder}"], 16 | "pattern": { 17 | "regexp": "((([A-Za-z]):\\\\(?:[^\\/:*?\\\"<>|\\r\\n]+\\\\)*)?[^\\/\\s\\(:*?\\\"<>|\\r\\n]*)\\((\\d+)\\):\\s.*(fatal|error|warning|hint)\\s(.*):\\s(.*)", 18 | "file": 1, 19 | "line": 4, 20 | "severity": 5, 21 | "code": 6, 22 | "message": 7 23 | } 24 | } 25 | } 26 | ] 27 | } -------------------------------------------------------------------------------- /GDIPAPIExtra.pas: -------------------------------------------------------------------------------- 1 | unit GDIPAPIExtra; 2 | 3 | interface 4 | uses GDIPAPI; 5 | { Color functions } 6 | function ARGBMake(const R,G,B : byte) : ARGB; overload; 7 | function ARGBMake(const A,R,G,B : byte) : ARGB; overload; 8 | implementation 9 | 10 | // ----------------------------------------------------------------------------- 11 | // Color class 12 | // ----------------------------------------------------------------------------- 13 | 14 | { ARGB functions } 15 | 16 | function ARGBMake(const R,G,B : byte) : ARGB; overload; 17 | begin 18 | result := ARGB( 19 | ALPHA_MASK or 20 | (R shl RED_SHIFT) or 21 | (G shl GREEN_SHIFT) or 22 | (B shl BLUE_SHIFT) 23 | ); 24 | end; 25 | 26 | function ARGBMake(const A,R,G,B : byte) : ARGB; overload; 27 | begin 28 | result := ARGB( 29 | (A shl ALPHA_SHIFT) or 30 | (R shl RED_SHIFT) or 31 | (G shl GREEN_SHIFT) or 32 | (B shl BLUE_SHIFT) 33 | ); 34 | end; 35 | 36 | end. 37 | -------------------------------------------------------------------------------- /PerMonitorDpiAwareness.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12 | 13 | 14 | 15 | 16 | 17 | 20 | 21 | 22 | 23 | 24 | 26 | True/PM 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2015 Victor Alberto Gil (vhanla) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /WinXCorners.dpr: -------------------------------------------------------------------------------- 1 | program WinXCorners; 2 | {.$R *.dres} 3 | 4 | uses 5 | Forms, 6 | Windows, 7 | Main in 'Main.pas' {frmMain}, 8 | frmSettings in 'frmSettings.pas' {frmTrayPopup}, 9 | XCombobox in 'XCombobox.pas', 10 | osdgui in 'osdgui.pas' {frmOSD}, 11 | frmAdvanced in 'frmAdvanced.pas' {frmAdvSettings}, 12 | functions in 'functions.pas', 13 | hotkeyhelper in 'hotkeyhelper.pas', 14 | settingsHelper in 'settingsHelper.pas', 15 | conditionsHelper in 'conditionsHelper.pas'; 16 | 17 | {$R *.res} 18 | {$R PNGIMAGE_1.res} 19 | {$R PNGIMAGE_2.res} 20 | {$R ICON_1.res} 21 | {$R ICON_2.res} 22 | {$R ICON_3.res} 23 | //{$ifdef ver360} 24 | {$R Manifest1.res} 25 | //{$endif} 26 | 27 | var 28 | AppHandle: HWND; 29 | begin 30 | AppHandle := FindWindow('WinXCorners', nil); 31 | if AppHandle > 0 then 32 | begin 33 | // Application.Terminate; 34 | Exit; 35 | end; 36 | 37 | Application.Initialize; 38 | Application.ShowMainForm := False; 39 | // Application.MainFormOnTaskbar := False; 40 | Application.Title := 'WinXCorners'; 41 | Application.CreateForm(TfrmMain, frmMain); 42 | Application.CreateForm(TfrmTrayPopup, frmTrayPopup); 43 | Application.CreateForm(TfrmOSD, frmOSD); 44 | Application.CreateForm(TfrmAdvSettings, frmAdvSettings); 45 | Application.Run; 46 | end. 47 | -------------------------------------------------------------------------------- /thirparty/DirectX.inc: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { The contents of this file are subject to the Mozilla Public License Version } 4 | { 1.1 (the "License"); you may not use this file except in compliance with the } 5 | { License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ } 6 | { } 7 | { Software distributed under the License is distributed on an "AS IS" basis, } 8 | { WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for } 9 | { the specific language governing rights and limitations under the License. } 10 | { } 11 | { The Original Code is DirectX.inc. } 12 | { } 13 | {******************************************************************************} 14 | 15 | // Borland compilers support 16 | {$INCLUDE versions.inc} 17 | 18 | {$DEFINE TYPE_IDENTITY} 19 | {$DEFINE SUPPORTS_EXCEPTIONS} 20 | 21 | // Additional settings 22 | {$MINENUMSIZE 4} 23 | {$ALIGN ON} 24 | 25 | {$IFDEF COMPILER7_UP} 26 | {$WARN UNSAFE_CODE OFF} 27 | {$WARN UNSAFE_TYPE OFF} 28 | {$WARN UNSAFE_CAST OFF} 29 | {$ENDIF} 30 | -------------------------------------------------------------------------------- /Main.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Margins.Left = 2 5 | Margins.Top = 2 6 | Margins.Right = 2 7 | Margins.Bottom = 2 8 | Caption = 'frmMain' 9 | ClientHeight = 217 10 | ClientWidth = 346 11 | Color = clBtnFace 12 | Font.Charset = DEFAULT_CHARSET 13 | Font.Color = clWindowText 14 | Font.Height = -7 15 | Font.Name = 'Tahoma' 16 | Font.Style = [] 17 | OldCreateOrder = True 18 | OnCreate = FormCreate 19 | OnDestroy = FormDestroy 20 | PixelsPerInch = 96 21 | TextHeight = 8 22 | object tmrHotSpot: TTimer 23 | Enabled = False 24 | Interval = 250 25 | OnTimer = tmrHotSpotTimer 26 | Left = 24 27 | Top = 24 28 | end 29 | object PopupMenu1: TPopupMenu 30 | Left = 96 31 | Top = 24 32 | object About1: TMenuItem 33 | Caption = '&About' 34 | OnClick = About1Click 35 | end 36 | object mnuAutorun: TMenuItem 37 | Caption = '&Start with Windows' 38 | OnClick = mnuAutorunClick 39 | end 40 | object Advanced1: TMenuItem 41 | Caption = 'Ad&vanced' 42 | OnClick = Advanced1Click 43 | end 44 | object N1: TMenuItem 45 | Caption = '-' 46 | end 47 | object tmFullScreen: TMenuItem 48 | Caption = 'Do Nothing on Full Screen ' 49 | OnClick = tmFullScreenClick 50 | end 51 | object LogWindow1: TMenuItem 52 | Caption = 'Log Window' 53 | OnClick = LogWindow1Click 54 | end 55 | object tmLine2: TMenuItem 56 | Caption = '-' 57 | end 58 | object Exit1: TMenuItem 59 | Caption = 'E&xit' 60 | OnClick = Exit1Click 61 | end 62 | end 63 | object tmrDelay: TTimer 64 | Enabled = False 65 | Interval = 250 66 | OnTimer = tmrDelayTimer 67 | Left = 184 68 | Top = 24 69 | end 70 | end 71 | -------------------------------------------------------------------------------- /frmSettings.dfm: -------------------------------------------------------------------------------- 1 | object frmTrayPopup: TfrmTrayPopup 2 | Left = 0 3 | Top = 0 4 | Caption = 'frmTrayPopup' 5 | ClientHeight = 232 6 | ClientWidth = 404 7 | Color = 16744448 8 | Font.Charset = ANSI_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -16 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | FormStyle = fsStayOnTop 14 | OldCreateOrder = False 15 | OnClick = FormClick 16 | OnClose = FormClose 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | OnPaint = FormPaint 20 | OnShow = FormShow 21 | PixelsPerInch = 96 22 | TextHeight = 21 23 | object imgScreenShape: TImage 24 | Left = 143 25 | Top = 45 26 | Width = 96 27 | Height = 96 28 | Margins.Left = 2 29 | Margins.Top = 2 30 | Margins.Right = 2 31 | Margins.Bottom = 2 32 | OnClick = FormClick 33 | end 34 | object Label1: TLabel 35 | Left = 168 36 | Top = 45 37 | Width = 23 38 | Height = 87 39 | Margins.Left = 2 40 | Margins.Top = 2 41 | Margins.Right = 2 42 | Margins.Bottom = 2 43 | Caption = '1' 44 | Font.Charset = ANSI_CHARSET 45 | Font.Color = clWhite 46 | Font.Height = -65 47 | Font.Name = 'Segoe UI Light' 48 | Font.Style = [] 49 | ParentFont = False 50 | OnClick = FormClick 51 | end 52 | object Timer1: TTimer 53 | Interval = 3 54 | OnTimer = Timer1Timer 55 | Left = 208 56 | Top = 184 57 | end 58 | object Timer2: TTimer 59 | Enabled = False 60 | Interval = 100 61 | OnTimer = Timer2Timer 62 | Left = 200 63 | Top = 120 64 | end 65 | object Timer3: TTimer 66 | Enabled = False 67 | OnTimer = Timer3Timer 68 | Left = 136 69 | Top = 144 70 | end 71 | object tmFader: TTimer 72 | Enabled = False 73 | Interval = 20 74 | OnTimer = tmFaderTimer 75 | Left = 56 76 | Top = 160 77 | end 78 | end 79 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | Win32 69 | Notes.txt 70 | 71 | Delphi7version 72 | OtherStuff 73 | thirdparty 74 | prevcode 75 | WinXHelper 76 | *.ini 77 | -------------------------------------------------------------------------------- /WinXCorners.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {DD5D3BF6-79F0-4F0D-A552-E035AA0D9BE0} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | Default.Personality.12 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto 5 | 6 | ############################################################################### 7 | # Set default behavior for command prompt diff. 8 | # 9 | # This is need for earlier builds of msysgit that does not have it on by 10 | # default for csharp files. 11 | # Note: This is only used by command line 12 | ############################################################################### 13 | #*.cs diff=csharp 14 | 15 | ############################################################################### 16 | # Set the merge driver for project and solution files 17 | # 18 | # Merging from the command prompt will add diff markers to the files if there 19 | # are conflicts (Merging from VS is not affected by the settings below, in VS 20 | # the diff markers are never inserted). Diff markers may cause the following 21 | # file extensions to fail to load in VS. An alternative would be to treat 22 | # these files as binary and thus will always conflict and require user 23 | # intervention with every merge. To do so, just uncomment the entries below 24 | ############################################################################### 25 | #*.sln merge=binary 26 | #*.csproj merge=binary 27 | #*.vbproj merge=binary 28 | #*.vcxproj merge=binary 29 | #*.vcproj merge=binary 30 | #*.dbproj merge=binary 31 | #*.fsproj merge=binary 32 | #*.lsproj merge=binary 33 | #*.wixproj merge=binary 34 | #*.modelproj merge=binary 35 | #*.sqlproj merge=binary 36 | #*.wwaproj merge=binary 37 | 38 | ############################################################################### 39 | # behavior for image files 40 | # 41 | # image files are treated as binary by default. 42 | ############################################################################### 43 | #*.jpg binary 44 | #*.png binary 45 | #*.gif binary 46 | 47 | ############################################################################### 48 | # diff behavior for common document formats 49 | # 50 | # Convert binary document formats to text before diffing them. This feature 51 | # is only available from the command line. Turn it on by uncommenting the 52 | # entries below. 53 | ############################################################################### 54 | #*.doc diff=astextplain 55 | #*.DOC diff=astextplain 56 | #*.docx diff=astextplain 57 | #*.DOCX diff=astextplain 58 | #*.dot diff=astextplain 59 | #*.DOT diff=astextplain 60 | #*.pdf diff=astextplain 61 | #*.PDF diff=astextplain 62 | #*.rtf diff=astextplain 63 | #*.RTF diff=astextplain 64 | -------------------------------------------------------------------------------- /WinXHelper.dpr: -------------------------------------------------------------------------------- 1 | library WinXHelper; 2 | 3 | { Important note about DLL memory management: ShareMem must be the 4 | first unit in your library's USES clause AND your project's (select 5 | Project-View Source) USES clause if your DLL exports any procedures or 6 | functions that pass strings as parameters or function results. This 7 | applies to all strings passed to and from your DLL--even those that 8 | are nested in records and classes. ShareMem is the interface unit to 9 | the BORLNDMM.DLL shared memory manager, which must be deployed along 10 | with your DLL. To avoid using BORLNDMM.DLL, pass string information 11 | using PChar or ShortString parameters. } 12 | 13 | uses 14 | Windows, 15 | // SysUtils, 16 | Messages; 17 | 18 | const 19 | MemMapFile = 'WinXCorners'; 20 | type 21 | PDLLGlobal = ^TDLLGlobal; 22 | TDLLGlobal = packed record 23 | HookHandle: HHOOK; 24 | end; 25 | 26 | var 27 | GlobalData: PDLLGlobal; 28 | MMF: THandle; 29 | 30 | {$R *.res} 31 | 32 | function HookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 33 | var 34 | // CurWnd: THandle; 35 | TargetWnd: THandle; 36 | Msg: PCopyDataStruct; 37 | // MsgStr: String; 38 | aNil: Cardinal; 39 | begin 40 | //if Code < 0 then 41 | if (Code < 0) or (Code = HC_NOREMOVE) then 42 | begin 43 | Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam); 44 | Exit; 45 | end; 46 | 47 | if (wParam = WM_MOUSEMOVE) then 48 | begin 49 | // CurWnd := PMouseHookStruct(lParam)^.hwnd; 50 | // CurWnd := GetAncestor(CurWnd, GA_ROOTOWNER); 51 | //SendMessage(CurWnd, WM_SYSCOMMAND,) 52 | // Send IPC command to let main app trigger according to data (X,Y) sent 53 | TargetWnd := FindWindow('WinXCorners', nil); 54 | if TargetWnd <> 0 then 55 | begin 56 | // MsgStr := IntToStr(PMouseHookStruct(lParam)^.pt.X) + ',' 57 | // +IntToStr(PMouseHookStruct(lParam)^.pt.Y); 58 | New(Msg); 59 | Msg^.dwData := 0; 60 | //Msg^.cbData := Length(MsgStr) + 1; 61 | //Msg^.lpData := PAnsiChar(MsgStr); 62 | Msg^.cbData := SizeOf(TMouseHookStruct) + 1; 63 | Msg^.lpData := PMouseHookStruct(lParam); 64 | //PostMessage(TargetWnd, WM_COPYDATA, CurWnd, Integer(Msg)); 65 | aNil := 0; 66 | SendMessageTimeout(TargetWnd, WM_COPYDATA, 0, Integer(Msg), SMTO_ABORTIFHUNG, 50, aNil); 67 | Dispose(Msg); 68 | end; 69 | end; 70 | 71 | Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam); 72 | end; 73 | 74 | procedure CreateGlobalHeap; 75 | begin 76 | MMF := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, 77 | SizeOf(TDLLGlobal), MemMapFile); 78 | 79 | if MMF = 0 then 80 | begin 81 | MessageBox(0, 'CreateFileMapping -', '', 0); 82 | Exit; 83 | end; 84 | 85 | GlobalData := MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TDLLGlobal)); 86 | if GlobalData = nil then 87 | begin 88 | CloseHandle(MMF); 89 | MessageBox(0, 'MapViewFile -', '', 0); 90 | end; 91 | end; 92 | 93 | procedure DeleteGlobalHeap; 94 | begin 95 | if GlobalData <> nil then 96 | UnmapViewOfFile(GlobalData); 97 | 98 | if MMF <> INVALID_HANDLE_VALUE then 99 | CloseHandle(MMF); 100 | end; 101 | 102 | procedure RunHook; stdcall; 103 | const 104 | WH_MOUSE_LL = 14; 105 | begin 106 | GlobalData^.HookHandle := SetWindowsHookEx(WH_MOUSE_LL, @HookProc, HInstance, 0); 107 | if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then 108 | begin 109 | MessageBox(0, 'Error :)', '', MB_OK); 110 | Exit; 111 | end; 112 | end; 113 | 114 | procedure KillHook; stdcall; 115 | begin 116 | if (GlobalData <> nil) and (GlobalData^.HookHandle <> INVALID_HANDLE_VALUE) then 117 | UnhookWindowsHookEx(GlobalData^.HookHandle); 118 | end; 119 | 120 | procedure DLLEntry(dwReason: DWORD); 121 | begin 122 | case dwReason of 123 | DLL_PROCESS_ATTACH: CreateGlobalHeap; 124 | DLL_PROCESS_DETACH: DeleteGlobalHeap; 125 | end; 126 | end; 127 | 128 | exports 129 | KillHook, 130 | RunHook; 131 | 132 | begin 133 | DllProc := @DLLEntry; 134 | DLLEntry(DLL_PROCESS_ATTACH); 135 | end. 136 | -------------------------------------------------------------------------------- /thirparty/zlibpas.pas: -------------------------------------------------------------------------------- 1 | {Portable Network Graphics Delphi ZLIB linking (16 May 2002) } 2 | 3 | {This unit links ZLIB to pngimage unit in order to implement } 4 | {the library. It's now using the new ZLIB version, 1.1.4 } 5 | {Note: The .obj files must be located in the subdirectory \obj} 6 | 7 | unit zlibpas; 8 | 9 | interface 10 | 11 | type 12 | 13 | TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; 14 | TFree = procedure (AppData, Block: Pointer); 15 | 16 | // Internal structure. Ignore. 17 | TZStreamRec = packed record 18 | next_in: PChar; // next input byte 19 | avail_in: Integer; // number of bytes available at next_in 20 | total_in: Integer; // total nb of input bytes read so far 21 | 22 | next_out: PChar; // next output byte should be put here 23 | avail_out: Integer; // remaining free space at next_out 24 | total_out: Integer; // total nb of bytes output so far 25 | 26 | msg: PChar; // last error message, NULL if no error 27 | internal: Pointer; // not visible by applications 28 | 29 | zalloc: TAlloc; // used to allocate the internal state 30 | zfree: TFree; // used to free the internal state 31 | AppData: Pointer; // private data object passed to zalloc and zfree 32 | 33 | data_type: Integer; // best guess about the data type: ascii or binary 34 | adler: Integer; // adler32 value of the uncompressed data 35 | reserved: Integer; // reserved for future use 36 | end; 37 | 38 | function inflateInit_(var strm: TZStreamRec; version: PChar; 39 | recsize: Integer): Integer; forward; 40 | function inflate(var strm: TZStreamRec; flush: Integer): Integer; forward; 41 | function inflateEnd(var strm: TZStreamRec): Integer; forward; 42 | function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; 43 | recsize: Integer): Integer; forward; 44 | function deflate(var strm: TZStreamRec; flush: Integer): Integer; forward; 45 | function deflateEnd(var strm: TZStreamRec): Integer; forward; 46 | 47 | const 48 | zlib_version = '1.2.3'; 49 | 50 | 51 | const 52 | Z_NO_FLUSH = 0; 53 | Z_PARTIAL_FLUSH = 1; 54 | Z_SYNC_FLUSH = 2; 55 | Z_FULL_FLUSH = 3; 56 | Z_FINISH = 4; 57 | 58 | Z_OK = 0; 59 | Z_STREAM_END = 1; 60 | Z_NEED_DICT = 2; 61 | Z_ERRNO = (-1); 62 | Z_STREAM_ERROR = (-2); 63 | Z_DATA_ERROR = (-3); 64 | Z_MEM_ERROR = (-4); 65 | Z_BUF_ERROR = (-5); 66 | Z_VERSION_ERROR = (-6); 67 | 68 | Z_NO_COMPRESSION = 0; 69 | Z_BEST_SPEED = 1; 70 | Z_BEST_COMPRESSION = 9; 71 | Z_DEFAULT_COMPRESSION = (-1); 72 | 73 | Z_FILTERED = 1; 74 | Z_HUFFMAN_ONLY = 2; 75 | Z_DEFAULT_STRATEGY = 0; 76 | 77 | Z_BINARY = 0; 78 | Z_ASCII = 1; 79 | Z_UNKNOWN = 2; 80 | 81 | Z_DEFLATED = 8; 82 | 83 | _z_errmsg: array[0..9] of PChar = ( 84 | 'need dictionary', // Z_NEED_DICT (2) 85 | 'stream end', // Z_STREAM_END (1) 86 | '', // Z_OK (0) 87 | 'file error', // Z_ERRNO (-1) 88 | 'stream error', // Z_STREAM_ERROR (-2) 89 | 'data error', // Z_DATA_ERROR (-3) 90 | 'insufficient memory', // Z_MEM_ERROR (-4) 91 | 'buffer error', // Z_BUF_ERROR (-5) 92 | 'incompatible version', // Z_VERSION_ERROR (-6) 93 | '' 94 | ); 95 | 96 | implementation 97 | 98 | {$L obj\adler32.obj} 99 | {$L obj\deflate.obj} 100 | {$L obj\infback.obj} 101 | {$L obj\inffast.obj} 102 | {$L obj\inflate.obj} 103 | {$L obj\inftrees.obj} 104 | {$L obj\trees.obj} 105 | {$L obj\compress.obj} 106 | {$L obj\crc32.obj} 107 | 108 | 109 | 110 | function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; external; 111 | 112 | procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl; 113 | begin 114 | FillChar(P^, count, B); 115 | end; 116 | 117 | procedure _memcpy(dest, source: Pointer; count: Integer);cdecl; 118 | begin 119 | Move(source^, dest^, count); 120 | end; 121 | 122 | 123 | // deflate compresses data 124 | function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; 125 | recsize: Integer): Integer; external; 126 | function deflate(var strm: TZStreamRec; flush: Integer): Integer; external; 127 | function deflateEnd(var strm: TZStreamRec): Integer; external; 128 | 129 | // inflate decompresses data 130 | function inflateInit_(var strm: TZStreamRec; version: PChar; 131 | recsize: Integer): Integer; external; 132 | function inflate(var strm: TZStreamRec; flush: Integer): Integer; external; 133 | function inflateEnd(var strm: TZStreamRec): Integer; external; 134 | function inflateReset(var strm: TZStreamRec): Integer; external; 135 | 136 | 137 | function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer; 138 | begin 139 | GetMem(Result, Items*Size); 140 | end; 141 | 142 | procedure zcfree(AppData, Block: Pointer); 143 | begin 144 | FreeMem(Block); 145 | end; 146 | 147 | end. 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | -------------------------------------------------------------------------------- /conditionsHelper.pas: -------------------------------------------------------------------------------- 1 | { 2 | Simple pseudo language parser for handling an inline command for invoking hotkeys 3 | } 4 | unit conditionsHelper; 5 | 6 | interface 7 | 8 | uses 9 | Windows, SysUtils, Classes, StrUtils; 10 | 11 | type 12 | TConditionType = (ctForeground, ctGlobal); 13 | 14 | PCondition = ^TCondition; 15 | TCondition = record 16 | ConditionType: TConditionType; 17 | ClassName: string; 18 | TitleText: string; 19 | end; 20 | 21 | TParserState = (psStart, psClass, psTitle, psHotkey, psElseHotkey); 22 | 23 | function ParseAndExecuteCondition(const Input: string): Boolean; 24 | function CheckCondition(const Condition: PCondition): Boolean; 25 | function GetWindowTextSafe(Handle: HWND): string; 26 | implementation 27 | 28 | uses 29 | hotkeyhelper; 30 | 31 | const 32 | TIMEOUT_MS = 100; // 100 ms timeout 33 | 34 | function GetWindowTextSafe(Handle: HWND): string; 35 | var 36 | Length: Integer; 37 | begin 38 | Length := GetWindowTextLength(Handle); 39 | if Length > 0 then 40 | begin 41 | SetLength(Result, Length); 42 | GetWindowText(Handle, PChar(Result), Length + 1); 43 | end 44 | else 45 | Result := ''; 46 | end; 47 | 48 | function GetWindowClassname(hWnd: HWND): string; 49 | var 50 | Buffer: array[0..255] of Char; 51 | begin 52 | if GetClassName(hWnd, Buffer, Length(Buffer)) > 0 then 53 | Result := Buffer 54 | else 55 | Result := ''; 56 | end; 57 | 58 | function ParseAndExecuteCondition(const Input: string): Boolean; 59 | var 60 | State: TParserState; 61 | Conditions: TList; 62 | CurrentCondition: PCondition; 63 | I: Integer; 64 | HotkeySequence, ElseHotkeySequence: string; 65 | ConditionMet: Boolean; 66 | begin 67 | State := psStart; 68 | Conditions := TList.Create; 69 | try 70 | CurrentCondition := nil; 71 | HotkeySequence := ''; 72 | ElseHotkeySequence := ''; 73 | 74 | for I := 1 to Length(Input) do 75 | begin 76 | case Input[I] of 77 | '#', '@': 78 | begin 79 | if State = psStart then 80 | begin 81 | New(CurrentCondition); 82 | if Input[I] = '#' then 83 | CurrentCondition^.ConditionType := ctForeground 84 | else 85 | CurrentCondition^.ConditionType := ctGlobal; 86 | CurrentCondition^.ClassName := ''; 87 | CurrentCondition^.TitleText := ''; 88 | State := psClass; 89 | end; 90 | end; 91 | '[':; // Do nothing, just start of class name 92 | ']': 93 | begin 94 | if State in [psClass, psTitle] then 95 | begin 96 | Conditions.Add(CurrentCondition); 97 | CurrentCondition := nil; 98 | State := psStart; 99 | end; 100 | end; 101 | ',': 102 | begin 103 | if State = psClass then 104 | State := psTitle; 105 | end; 106 | '|': 107 | begin 108 | if State = psStart then 109 | State := psClass; 110 | end; 111 | ':': 112 | begin 113 | if State = psStart then 114 | State := psHotkey; 115 | end; 116 | '(': 117 | begin 118 | if State = psHotkey then 119 | HotkeySequence := ''; 120 | if State = psElseHotkey then 121 | ElseHotkeySequence := ''; 122 | end; 123 | ')': 124 | begin 125 | if State in [psHotkey, psElseHotkey] then 126 | State := psStart; 127 | end; 128 | '?': 129 | begin 130 | if State = psStart then 131 | State := psElseHotkey; 132 | end; 133 | else 134 | case State of 135 | psClass: CurrentCondition^.ClassName := CurrentCondition^.ClassName + Input[I]; 136 | psTitle: CurrentCondition^.TitleText := CurrentCondition^.TitleText + Input[I]; 137 | psHotkey: HotkeySequence := HotkeySequence + Input[I]; 138 | psElseHotkey: ElseHotkeySequence := ElseHotkeySequence + Input[I]; 139 | end; 140 | end; 141 | end; 142 | 143 | ConditionMet := False; 144 | for I := 0 to Conditions.Count - 1 do 145 | begin 146 | if CheckCondition(PCondition(Conditions[I])) then 147 | begin 148 | ConditionMet := True; 149 | Break; 150 | end; 151 | end; 152 | 153 | if ConditionMet then 154 | Result := THotkeyInvoker.Instance.InvokeHotKey(HotkeySequence) 155 | else 156 | Result := THotkeyInvoker.Instance.InvokeHotKey(ElseHotkeySequence); 157 | 158 | finally 159 | for I := 0 to Conditions.Count - 1 do 160 | Dispose(PCondition(Conditions[I])); 161 | Conditions.Free; 162 | end; 163 | end; 164 | 165 | function CheckCondition(const Condition: PCondition): Boolean; 166 | var 167 | ahWnd: HWND; 168 | WindowClass, WindowTitle: string; 169 | begin 170 | Result := False; 171 | 172 | case Condition^.ConditionType of 173 | ctForeground: 174 | begin 175 | ahWnd := GetForegroundWindow; 176 | if ahWnd <> 0 then 177 | begin 178 | WindowClass := GetWindowClassname(ahWnd); 179 | WindowTitle := GetWindowTextSafe(ahWnd); 180 | Result := (CompareText(WindowClass, Condition^.ClassName) = 0) and 181 | ((Condition^.TitleText = '') or ContainsText(WindowTitle, Condition^.TitleText)); 182 | end; 183 | end; 184 | ctGlobal: 185 | begin 186 | if Condition^.TitleText <> '' then 187 | ahWnd := FindWindow(PChar(Condition^.ClassName), Pchar(Condition^.TitleText)) 188 | else 189 | ahWnd := FindWindow(PChar(Condition^.ClassName), nil); 190 | Result := (ahWnd <> 0); 191 | end; 192 | end; 193 | end; 194 | 195 | 196 | end. 197 | -------------------------------------------------------------------------------- /osdgui.pas: -------------------------------------------------------------------------------- 1 | unit osdgui; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, 7 | Controls, Forms, Dialogs, StdCtrls, DWMApi, ActiveX, GDIPapi, GDIPObj; 8 | 9 | type 10 | TfrmOSD = class(TForm) 11 | procedure FormCreate(Sender: TObject); 12 | procedure FormActivate(Sender: TObject); 13 | procedure FormShow(Sender: TObject); 14 | private 15 | { Private declarations } 16 | public 17 | { Public declarations } 18 | procedure DrawBubble(const text: String = ''); 19 | end; 20 | 21 | var 22 | frmOSD: TfrmOSD; 23 | 24 | implementation 25 | 26 | {$R *.dfm} 27 | 28 | uses main; 29 | type 30 | TFixedStreamAdapter = class(TStreamAdapter) 31 | public 32 | // function Stat(out statstg: TStatStg; grfStatFlag: DWORD): HResult; override; stdcall; 33 | function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; virtual; stdcall; 34 | end; 35 | 36 | function TFixedStreamAdapter.Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; 37 | begin 38 | Result := inherited Stat(statstg, grfStatFlag); 39 | statstg.pwcsName := nil; 40 | end; 41 | 42 | procedure TfrmOSD.DrawBubble(const text: String = ''); 43 | var 44 | bmp: TBitmap; 45 | Stream: TStream; 46 | StreamAdapter: IStream; 47 | PNGBitmap: TGPBitmap; 48 | BitmapHandle: HBITMAP; 49 | BlendFunction: TBlendFunction; 50 | BitmapPos: TPoint; 51 | BitmapSize: TSize; 52 | 53 | 54 | xfont: TGPFont; 55 | //style: Integer; 56 | graph: TGPGraphics; 57 | brush: TGPSolidBrush; 58 | stringFormat: TGPStringFormat; 59 | 60 | textval : Integer; 61 | begin 62 | bmp := TBitmap.Create; 63 | try 64 | bmp.PixelFormat := pf32bit; 65 | 66 | textval := 1; 67 | if Trim(text) <> '' then 68 | textval := StrToInt(text); 69 | 70 | 71 | if textval and 1 = 1then 72 | Stream := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA) 73 | else 74 | Stream := TResourceStream.Create(HInstance, 'PngImage_2', RT_RCDATA); 75 | try 76 | StreamAdapter := TFixedStreamAdapter.Create(Stream); 77 | try 78 | PNGBitmap := TGPBitmap.Create(StreamAdapter); 79 | try 80 | PNGBitmap.GetHBITMAP(MakeColor(0, 0, 0, 0), BitmapHandle); 81 | bmp.Handle := BitmapHandle; 82 | finally 83 | PNGBitmap.Free; 84 | end; 85 | finally 86 | StreamAdapter := nil; 87 | end; 88 | finally 89 | Stream.Free; 90 | end; 91 | 92 | Assert(bmp.PixelFormat = pf32bit, 'Wrong bitmap format, must be 32 bits/pixel'); 93 | 94 | //PremultiplyBitmap(bmp); 95 | //bmp.Canvas.FillRect(Rect(0,0,Width,Height)); 96 | 97 | graph := TGPGraphics.Create(bmp.Canvas.Handle); 98 | try 99 | graph.SetSmoothingMode(SmoothingModeAntiAlias); 100 | //style := FontStyleRegular; 101 | //xfont := TGPFont.Create(font.Name, font.Size, style, UnitPoint); 102 | xfont := TGPFont.Create(Canvas.Handle, Font.Handle); 103 | try 104 | brush := TGPSolidBrush.Create(MakeColor(GetRValue(Font.Color), GetGValue(Font.Color), GetBValue(Font.Color))); 105 | try 106 | stringFormat := TGPStringFormat.Create; 107 | try 108 | stringFormat.SetAlignment(StringAlignmentCenter); 109 | stringFormat.SetLineAlignment(StringAlignmentCenter); 110 | stringFormat.SetTrimming(StringTrimmingEllipsisCharacter); 111 | stringFormat.SetFormatFlags(StringFormatFlagsNoWrap); 112 | graph.SetTextRenderingHint(TextRenderingHintAntiAliasGridFit); 113 | graph.DrawString(text,Length(text),xfont,MakePoint((bmp.Width/2 ),(bmp.Height/2 )),stringFormat,brush); 114 | //graph.SetTextRenderingHint(TextRenderingHintSingleBitPerPixelGridFit); 115 | //graph.DrawString(text,Length(text),xfont,MakePoint(12.0,12.0),nil,brush); 116 | finally 117 | stringFormat.Free; 118 | end; 119 | finally 120 | brush.Free; 121 | end; 122 | finally 123 | xfont.Free; 124 | end; 125 | finally 126 | graph.Free; 127 | end; 128 | 129 | ClientWidth := bmp.Width; 130 | ClientHeight := bmp.Height; 131 | 132 | // Position bitmap on form 133 | BitmapPos := Point(0, 0); 134 | BitmapSize.cx := bmp.Width; 135 | BitmapSize.cy := bmp.Height; 136 | 137 | // Setup alpha blending parameters 138 | BlendFunction.BlendOp := AC_SRC_OVER; 139 | BlendFunction.BlendFlags := 0; 140 | BlendFunction.SourceConstantAlpha := 255; // Start completely transparent 141 | BlendFunction.AlphaFormat := AC_SRC_ALPHA; 142 | 143 | UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, bmp.Canvas.Handle, 144 | @BitmapPos, 0, @BlendFunction, ULW_ALPHA); 145 | 146 | finally 147 | bmp.Free; 148 | end; 149 | end; 150 | 151 | procedure TfrmOSD.FormActivate(Sender: TObject); 152 | begin 153 | // SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW); 154 | end; 155 | 156 | {procedure PremultiplyBitmap(Bitmap: TBitmap); 157 | var 158 | Row, Col: integer; 159 | p: PRGBQuad; 160 | PreMult: array[byte, byte] of byte; 161 | begin 162 | // precalculate all possible values of a*b 163 | for Row := 0 to 255 do 164 | for Col := Row to 255 do 165 | begin 166 | PreMult[Row, Col] := Row*Col div 255; 167 | if (Row <> Col) then 168 | PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a 169 | end; 170 | 171 | for Row := 0 to Bitmap.Height-1 do 172 | begin 173 | Col := Bitmap.Width; 174 | p := Bitmap.ScanLine[Row]; 175 | while (Col > 0) do 176 | begin 177 | p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue]; 178 | p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen]; 179 | p.rgbRed := PreMult[p.rgbReserved, p.rgbRed]; 180 | inc(p); 181 | dec(Col); 182 | end; 183 | end; 184 | end; 185 | } 186 | 187 | procedure TfrmOSD.FormCreate(Sender: TObject); 188 | const 189 | DWMWA_EXCLUDED_FROM_PEEK = 12; // [set] LivePreview exclusion information 190 | var 191 | renderPolicy: DWMWINDOWATTRIBUTE; //integer;//DWMWINDOWATTRIBUTE; 192 | begin 193 | frmMain.tmrHotSpot.Enabled := True; 194 | BorderStyle := bsNone; 195 | FormStyle := fsStayOnTop; 196 | Font.Size := 18; 197 | //Font.Color := $00DBBEA6; 198 | Font.Color := $00333333; 199 | 200 | 201 | DwmSetWindowAttribute(Handle, DWMWA_EXCLUDED_FROM_PEEK or DWMWA_FLIP3D_POLICY, @renderpolicy, SizeOf(Integer)); 202 | SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_LAYERED or WS_EX_TRANSPARENT or WS_EX_TOOLWINDOW{ and not WS_EX_APPWINDOW}); 203 | //SetLayeredWindowAttributes(Handle,0,255, LWA_ALPHA); 204 | //SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width, Height,SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE); 205 | 206 | DrawBubble(); 207 | end; 208 | 209 | procedure TfrmOSD.FormShow(Sender: TObject); 210 | begin 211 | ShowWindow(Application.Handle, SW_HIDE); 212 | end; 213 | 214 | end. 215 | -------------------------------------------------------------------------------- /WinXCorners.mes: -------------------------------------------------------------------------------- 1 | [GeneralSettings] 2 | MesVersion=4 3 | HandleExceptions=1 4 | LinkInCode=1 5 | AppendMapFileToBinary=1 6 | NoOwnMadExceptSettings=0 7 | CheckFileCrc=1 8 | CheckForFrozenMainThread=0 9 | FreezeTimeout=60000 10 | ReportLeaks=0 11 | WindowsLogo=0 12 | CrashOnBuffer=0 13 | CrashOnUnderrun=0 14 | AutomaticallySaveBugReport=1 15 | AutoSaveBugReportIfNotSent=1 16 | AutomaticallyMailBugReport=0 17 | AutoMailProgressBox=0 18 | CopyBugReportToClipboard=0 19 | SuspendAllRunningThreads=0 20 | ShowPleaseWaitBox=1 21 | PleaseWaitIcon=plwait1 22 | AutomaticallyContinueApplication=0 23 | AutomaticallyRestartApplication=0 24 | AutomaticallyCloseApplication=0 25 | SendInBackground=1 26 | SendHelper=196608 27 | Send32Icon=send321 28 | UploadViaHttp=0 29 | HttpServer= 30 | HttpSsl=0 31 | HttpPort=0 32 | HttpAccount= 33 | HttpPassword= 34 | UploadToFogBugz=0 35 | UploadToBugZilla=0 36 | UploadToMantis=0 37 | BugTrackerAccount= 38 | BugTrackerPassword= 39 | BugTrackerProject= 40 | BugTrackerArea= 41 | BugTrackerAssignTo= 42 | MailAsSmtpServer=0 43 | MailAsSmtpClient=0 44 | SmtpServer= 45 | SmtpSsl=0 46 | SmtpTls=0 47 | SmtpPort=0 48 | SmtpAccount= 49 | SmtpPassword= 50 | MailViaMapi=1 51 | MailViaMailto=1 52 | MailAddress= 53 | BugReportFile=bugreport.txt 54 | AttachBugReport=1 55 | AttachBugReportFile=1 56 | DeleteBugReportFile=1 57 | BugReportSendAs=bugreport.txt 58 | BugReportZip= 59 | ScreenShotDepth=8 60 | ScreenShotAppOnly=0 61 | ScreenShotSendAs=screenshot.png 62 | ScreenShotZip= 63 | AdditionalAttachments= 64 | AppendBugReports=1 65 | BugReportFileSize=100000 66 | DontSaveDuplicateExceptions=1 67 | DontSaveDuplicateFreezings=1 68 | DuplicateExceptionDefinition=1 69 | DuplicateFreezeDefinition=2 70 | ShowExceptionBox=1 71 | OkBtnText=&OK 72 | DetailsBtnText=&Details 73 | PleaseWaitTitle=Information 74 | PleaseWaitText=Please wait a moment... 75 | BugTrackerTitle=%25appname%25, %25exceptMsg%25 76 | BugTrackerDescr=error details: %0d%0a%25errorDetails%25 77 | MailSubject=bug report 78 | MailBody=please find the bug report attached 79 | SendBoxTitle=Sending bug report... 80 | PrepareAttachMsg=Preparing attachments... 81 | MxLookupMsg=Searching for mail server... 82 | ConnectMsg=Connecting to server... 83 | SendMailMsg=Sending mail... 84 | FieldsMsg=Setting fields... 85 | SendAttachMsg=Sending attachments... 86 | SendFinalizeMsg=Finalizing... 87 | MailFailureMsg=Sorry, sending the bug report didn't work. 88 | VersionVariable= 89 | [ExceptionBox] 90 | ShowButtonMailBugReport=0 91 | ShowButtonSaveBugReport=1 92 | ShowButtonPrintBugReport=0 93 | ShowButtonShowBugReport=1 94 | ShowButtonContinueApplication=1 95 | ShowButtonRestartApplication=1 96 | ShowButtonCloseApplication=1 97 | IconButtonSendBugReport=send1 98 | IconButtonSaveBugReport=save1 99 | IconButtonPrintBugReport=print1 100 | IconButtonShowBugReport=show1 101 | IconButtonContinueApplication=continue1 102 | IconButtonCantContinueApplication=cantContinue1 103 | IconButtonRestartApplication=restart1 104 | IconButtonCloseApplication=close1 105 | FocusedButton=3 106 | SendAssistant=SendAssistant 107 | SaveAssistant=SaveAssistant 108 | PrintAssistant=PrintAssistant 109 | AutomaticallyShowBugReport=0 110 | NoOwnerDrawButtons=0 111 | BigExceptionIcon=big1 112 | TitleBar=%25appname%25 113 | ExceptionMessage=An error occurred in the application. 114 | FrozenMessage=The application seems to be frozen. 115 | BitFaultMsg=The file "%25modname%25" seems to be corrupt! 116 | MailBugReportText=send bug report 117 | SaveBugReportText=save bug report 118 | PrintBugReportText=print bug report 119 | ShowBugReportText=show bug report 120 | ContinueApplicationText=continue application 121 | RestartApplicationText=restart application 122 | CloseApplicationText=close application 123 | [BugReport] 124 | ListThreads=1 125 | ListModules=1 126 | ListHardware=1 127 | ShowCpuRegisters=1 128 | ShowStackDump=1 129 | Disassembly=1 130 | HideUglyItems=0 131 | ShowRelativeAddrs=1 132 | ShowRelativeLines=1 133 | FormatDisassembly=1 134 | LimitDisassembly=10 135 | EnabledPlugins=modules|processes|hardware 136 | [Filters] 137 | Filter1ExceptionClasses=EDBEditError 138 | Filter1DontCreateBugReport=1 139 | Filter1DontCreateScreenshot=1 140 | Filter1DontSuspendThreads=1 141 | Filter1DontCallHandlers=1 142 | Filter1ShowBox=3 143 | Filter1Assis= 144 | Filter2ExceptionClasses= 145 | Filter2DontCreateBugReport=0 146 | Filter2DontCreateScreenshot=0 147 | Filter2DontSuspendThreads=0 148 | Filter2DontCallHandlers=0 149 | Filter2ShowBox=0 150 | Filter2Assis= 151 | GeneralDontCreateBugReport=0 152 | GeneralDontCreateScreenshot=0 153 | GeneralDontSuspendThreads=0 154 | GeneralDontCallHandlers=0 155 | GeneralShowBox=0 156 | GeneralAssis= 157 | [Assistants] 158 | Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm 159 | Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm 160 | Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm 161 | Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08MinWidth%04%00%00%00%00%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%08NameEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%09EmailEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00contact email%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%0bINVCheckBox%08MemCheck%07Caption%0c%0b%00%00%00remember me%07Checked%08%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%00 162 | Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%08MinWidth%04%00%00%00%00%08OnAction%0c%00%00%00%00%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c,%00%00%00what were you doing when the error occurred?%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%0bDetailsMemo%07Colored%09%07Enabled%09%05Lines%04%09%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%00 163 | Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%07Message%0c%18%00%00%00Screenshot Configuration%08MinWidth%04%00%00%00%00%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%05Timer%04%fa%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%0bINVCheckBox%0bAttachCheck%07Caption%0c%25%00%00%00attach a screenshot to the bug report%07Checked%09%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%07Enabled%09%04File%0c%00%00%00%00%06Height%04%00%00%00%00%07Spacing%04%00%00%00%00%05Width%04%00%00%00%00%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%07Enabled%09%07Spacing%04%00%00%00%00%00%00%00 164 | -------------------------------------------------------------------------------- /WinXHelper.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {092751F1-ABBA-4506-831E-7F2462DD8C86} 4 | 18.6 5 | None 6 | WinXHelper.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Library 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | .\$(Platform)\$(Config) 44 | .\$(Platform)\$(Config) 45 | false 46 | false 47 | false 48 | false 49 | false 50 | true 51 | RESTComponents;FireDACIBDriver;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage) 52 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 53 | WinXHelper 54 | 55 | 56 | DBXSqliteDriver;OmniThreadLibraryRuntime;DBXInterBaseDriver;OverbyteIcsD102Run;vclactnband;vclFireDAC;tethering;svnui;FireDACADSDriver;METROVCL;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DragDropDR102T;inetdb;FmxTeeUI;fmx;fmxdae;vclib;dbexpress;IndyCore;OnGuardDR;vclx;EmbeddedWebBrowser_Tokyo;dsnap;EsVclCore;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;EsVclComponents;FireDACMySQLDriver;FireDACCommonODBC;BCEditor.Delphi.Runtime;bindcompdbx;IndyIPCommon;GR32_D;vcl;IndyIPServer;IndySystem;dsnapcon;madExcept_;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;vclimg;Gorilla3D_Delphi_10_2_3_Tokyo;TeeDB;madBasic_;FireDACPgDriver;ibmonitor;FMXTee;DbxCommonDriver;ibxpress;Tee;xmlrtl;ibxbindings;fmxobj;vclwinx;GR32_R;rtl;Win7ComponentsDXE2;DbxClientDriver;madDisAsm_;CustomIPTransport;vcldsnap;DOSCommandDR;bindcomp;appanalytics;IndyIPClient;sapi;bindcompvcl;SynEdit_R;TeeUI;dbxcds;VclSmp;adortl;dsnapxml;dbrtl;inetdbxpress;IndyProtocols;RKAIOXE4U1;fmxase;$(DCC_UsePackage) 57 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 58 | Debug 59 | true 60 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 61 | 1033 62 | 63 | 64 | DBXSqliteDriver;OmniThreadLibraryRuntime;DBXInterBaseDriver;OverbyteIcsD102Run;vclactnband;vclFireDAC;tethering;FireDACADSDriver;vcltouch;vcldb;bindcompfmx;Intraweb;inetdb;FmxTeeUI;fmx;fmxdae;vclib;dbexpress;IndyCore;OnGuardDR;vclx;dsnap;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACMySQLDriver;FireDACCommonODBC;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;IndySystem;dsnapcon;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;vclimg;Gorilla3D_Delphi_10_2_3_Tokyo;TeeDB;FireDACPgDriver;ibmonitor;FMXTee;DbxCommonDriver;ibxpress;Tee;xmlrtl;ibxbindings;fmxobj;vclwinx;GR32_R;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;DOSCommandDR;bindcomp;appanalytics;IndyIPClient;bindcompvcl;SynEdit_R;TeeUI;dbxcds;VclSmp;adortl;dsnapxml;dbrtl;inetdbxpress;IndyProtocols;fmxase;$(DCC_UsePackage) 65 | 66 | 67 | DEBUG;$(DCC_Define) 68 | true 69 | false 70 | true 71 | true 72 | true 73 | 74 | 75 | false 76 | 77 | 78 | false 79 | RELEASE;$(DCC_Define) 80 | 0 81 | 0 82 | 83 | 84 | 85 | MainSource 86 | 87 | 88 | Cfg_2 89 | Base 90 | 91 | 92 | Base 93 | 94 | 95 | Cfg_1 96 | Base 97 | 98 | 99 | 100 | Delphi.Personality.12 101 | Application 102 | 103 | 104 | 105 | WinXHelper.dpr 106 | 107 | 108 | 109 | 110 | True 111 | False 112 | 113 | 114 | 12 115 | 116 | 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /WinXCorners.bdsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | WinXCorners.dpr 14 | 15 | 16 | 7.0 17 | 18 | 19 | 8 20 | 0 21 | 1 22 | 1 23 | 0 24 | 0 25 | 1 26 | 1 27 | 1 28 | 0 29 | 0 30 | 1 31 | 0 32 | 1 33 | 1 34 | 1 35 | 0 36 | 0 37 | 0 38 | 0 39 | 0 40 | 1 41 | 0 42 | 1 43 | 1 44 | 1 45 | True 46 | True 47 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 48 | 49 | False 50 | 51 | True 52 | True 53 | True 54 | True 55 | True 56 | True 57 | True 58 | True 59 | True 60 | True 61 | True 62 | True 63 | True 64 | True 65 | True 66 | True 67 | True 68 | True 69 | True 70 | True 71 | True 72 | True 73 | True 74 | True 75 | True 76 | True 77 | True 78 | True 79 | True 80 | True 81 | True 82 | True 83 | True 84 | True 85 | True 86 | True 87 | True 88 | True 89 | True 90 | True 91 | True 92 | True 93 | True 94 | True 95 | True 96 | True 97 | False 98 | False 99 | False 100 | True 101 | True 102 | True 103 | True 104 | True 105 | True 106 | 107 | 108 | 109 | 0 110 | 0 111 | False 112 | 1 113 | False 114 | False 115 | False 116 | 16384 117 | 1048576 118 | 4194304 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | vcl;rtl;vclx;dbrtl;vcldb;adortl;dbxcds;dbexpress;xmlrtl;vclie;inet;inetdbbde;inetdbxpress;VclSmp;dsnap;bdertl;teeui;teedb;tee;vcldbx;vclactnband 128 | 129 | 130 | False 131 | 132 | 133 | 134 | 135 | 136 | False 137 | 138 | 139 | True 140 | False 141 | 142 | 143 | 144 | $00000000 145 | 146 | 147 | 148 | True 149 | False 150 | 1 151 | 3 152 | 0 153 | 0 154 | False 155 | False 156 | False 157 | False 158 | False 159 | 1033 160 | 1252 161 | 162 | 163 | 164 | 165 | 1.3.0.0 166 | 167 | 168 | 169 | 170 | 171 | 1.0.0.0 172 | 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /WinXHelper.bdsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | WinXHelper.dpr 14 | 15 | 16 | 7.0 17 | 18 | 19 | 8 20 | 0 21 | 1 22 | 1 23 | 0 24 | 0 25 | 1 26 | 1 27 | 1 28 | 0 29 | 0 30 | 1 31 | 0 32 | 1 33 | 1 34 | 1 35 | 0 36 | 0 37 | 0 38 | 0 39 | 0 40 | 1 41 | 0 42 | 1 43 | 1 44 | 1 45 | True 46 | True 47 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 48 | 49 | False 50 | 51 | True 52 | True 53 | True 54 | True 55 | True 56 | True 57 | True 58 | True 59 | True 60 | True 61 | True 62 | True 63 | True 64 | True 65 | True 66 | True 67 | True 68 | True 69 | True 70 | True 71 | True 72 | True 73 | True 74 | True 75 | True 76 | True 77 | True 78 | True 79 | True 80 | True 81 | True 82 | True 83 | True 84 | True 85 | True 86 | True 87 | True 88 | True 89 | True 90 | True 91 | True 92 | True 93 | True 94 | True 95 | True 96 | True 97 | False 98 | False 99 | False 100 | True 101 | True 102 | True 103 | True 104 | True 105 | True 106 | 107 | 108 | 109 | 0 110 | 0 111 | False 112 | 1 113 | False 114 | False 115 | False 116 | 16384 117 | 1048576 118 | 4194304 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | False 131 | 132 | 133 | 134 | 135 | 136 | False 137 | 138 | 139 | True 140 | False 141 | 142 | 143 | 144 | $00000000 145 | 146 | 147 | 148 | False 149 | False 150 | 1 151 | 0 152 | 0 153 | 0 154 | False 155 | False 156 | False 157 | False 158 | False 159 | 2058 160 | 1252 161 | 162 | 163 | 164 | 165 | 1.0.0.0 166 | 167 | 168 | 169 | 170 | 171 | 1.0.0.0 172 | 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /hotkeyhelper.pas: -------------------------------------------------------------------------------- 1 | unit hotkeyhelper; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Classes, SysUtils, Messages, IniFiles, Generics.Collections; 7 | 8 | const 9 | WH_KEYBOARD_LL = 13; 10 | WH_MOUSE_LL = 14; 11 | { Define a record for recording and passing information process wide } 12 | type 13 | PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT; 14 | TKBDLLHOOKSTRUCT = record 15 | vkCode: Cardinal; 16 | scanCode: Cardinal; 17 | flags: Cardinal; 18 | time: Cardinal; 19 | dwExtrainfo: Cardinal; 20 | end; 21 | 22 | type 23 | THotkeyInvoker = class 24 | private 25 | FHook: HHOOK; 26 | FBlockInput: Boolean; 27 | class var FInstance: THotkeyInvoker; 28 | procedure SetBlockInput(const value: Boolean); 29 | class function GetInstance: THotkeyInvoker; static; 30 | protected 31 | constructor Create; 32 | destructor Destroy; override; 33 | public 34 | class property Instance: THotkeyInvoker read GetInstance; 35 | property BlockInput: Boolean read FBlockInput write SetBlockInput; 36 | function InvokeHotKey(const Hotkey: string; Delay: Integer = 10; RepeatCount: Integer = 1): Boolean; 37 | end; 38 | 39 | function LowLevelKeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 40 | 41 | implementation 42 | 43 | var 44 | BlockedKeys: TStringList; 45 | VKMap: TDictionary; 46 | 47 | 48 | // Helper functions 49 | function StartsWith(const Str, Prefix: string): Boolean; 50 | begin 51 | Result := (Length(Str) >= Length(Prefix)) and 52 | (Copy(Str, 1, Length(Prefix)) = Prefix); 53 | end; 54 | 55 | function EndsWith(const Str, Suffix: string): Boolean; 56 | begin 57 | Result := (Length(Str) >= Length(Suffix))and 58 | (Copy(Str, Length(Str) - Length(Suffix) + 1, Length(Suffix)) = Suffix); 59 | end; 60 | 61 | function TrimUnderscores(const Str: string): string; 62 | var 63 | StartPos, EndPos: Integer; 64 | begin 65 | StartPos := 1; 66 | EndPos := Length(Str); 67 | while (StartPos <= EndPos) and (Str[StartPos] = '_') do 68 | Inc(StartPos); 69 | while (EndPos >= StartPos) and (Str[EndPos] = '_') do 70 | Dec(EndPos); 71 | Result := Copy(Str, StartPos, EndPos - StartPos + 1); 72 | 73 | 74 | end; 75 | 76 | function LowLevelKeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 77 | var 78 | pkbhs: PKBDLLHOOKSTRUCT; 79 | begin 80 | if (nCode = HC_ACTION) and THotkeyInvoker.Instance.BlockInput then 81 | begin 82 | pkbhs := PKBDLLHOOKSTRUCT(lParam); 83 | if BlockedKeys.IndexOf(IntToStr(pkbhs.vkCode)) <> -1 then 84 | begin 85 | // Result := 1; 86 | // Exit; 87 | end; 88 | end; 89 | Result := CallNextHookEx(THotKeyInvoker.Instance.FHook, nCode, wParam, lParam); 90 | end; 91 | 92 | { THotkeyInvoker } 93 | 94 | constructor THotkeyInvoker.Create; 95 | begin 96 | inherited; 97 | FHook := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardproc, 0, 0); 98 | BlockedKeys := TStringList.Create; 99 | VKMap := TDictionary.Create; 100 | 101 | // allowed virtual keys 102 | VKMap.Add('LBUTTON',VK_LBUTTON ); 103 | VKMap.Add('RBUTTON',VK_RBUTTON ); 104 | VKMap.Add('CANCEL',VK_CANCEL ); 105 | VKMap.Add('MBUTTON',VK_MBUTTON ); 106 | VKMap.Add('XBUTTON1',VK_XBUTTON1 ); 107 | VKMap.Add('XBUTTON2',VK_XBUTTON2 ); 108 | VKMap.Add('BACK',VK_BACK ); 109 | VKMap.Add('TAB',VK_TAB ); 110 | VKMap.Add('CLEAR',VK_CLEAR ); 111 | VKMap.Add('RETURN',VK_RETURN ); 112 | VKMap.Add('SHIFT',VK_SHIFT ); 113 | VKMap.Add('CONTROL',VK_CONTROL ); 114 | // VKMap.Add('MENU',VK_MENU ); 115 | VKMap.Add('ALT',VK_MENU ); 116 | VKMap.Add('PAUSE',VK_PAUSE ); 117 | VKMap.Add('CAPITAL',VK_CAPITAL ); 118 | VKMap.Add('KANA',VK_KANA ); 119 | VKMap.Add('HANGUL',VK_HANGUL ); 120 | VKMap.Add('JUNJA',VK_JUNJA ); 121 | VKMap.Add('FINAL',VK_FINAL ); 122 | VKMap.Add('HANJA',VK_HANJA ); 123 | VKMap.Add('KANJI',VK_KANJI ); 124 | VKMap.Add('CONVERT',VK_CONVERT ); 125 | VKMap.Add('NONCONVERT',VK_NONCONVERT ); 126 | VKMap.Add('ACCEPT',VK_ACCEPT ); 127 | VKMap.Add('MODECHANGE',VK_MODECHANGE ); 128 | VKMap.Add('ESCAPE',VK_ESCAPE ); 129 | VKMap.Add('SPACE',VK_SPACE ); 130 | VKMap.Add('PRIOR',VK_PRIOR ); 131 | VKMap.Add('NEXT',VK_NEXT ); 132 | VKMap.Add('END',VK_END ); 133 | VKMap.Add('HOME',VK_HOME ); 134 | VKMap.Add('LEFT',VK_LEFT ); 135 | VKMap.Add('UP',VK_UP ); 136 | VKMap.Add('RIGHT',VK_RIGHT ); 137 | VKMap.Add('DOWN',VK_DOWN ); 138 | VKMap.Add('SELECT',VK_SELECT ); 139 | VKMap.Add('PRINT',VK_PRINT ); 140 | VKMap.Add('EXECUTE',VK_EXECUTE ); 141 | VKMap.Add('SNAPSHOT',VK_SNAPSHOT ); 142 | VKMap.Add('INSERT',VK_INSERT ); 143 | VKMap.Add('DELETE',VK_DELETE ); 144 | VKMap.Add('HELP',VK_HELP ); 145 | VKMap.Add('WIN',VK_LWIN ); 146 | VKMap.Add('RWIN',VK_RWIN ); 147 | VKMap.Add('APPS',VK_APPS ); 148 | VKMap.Add('SLEEP',VK_SLEEP ); 149 | VKMap.Add('NUMPAD0',VK_NUMPAD0 ); 150 | VKMap.Add('NUMPAD1',VK_NUMPAD1 ); 151 | VKMap.Add('NUMPAD2',VK_NUMPAD2 ); 152 | VKMap.Add('NUMPAD3',VK_NUMPAD3 ); 153 | VKMap.Add('NUMPAD4',VK_NUMPAD4 ); 154 | VKMap.Add('NUMPAD5',VK_NUMPAD5 ); 155 | VKMap.Add('NUMPAD6',VK_NUMPAD6 ); 156 | VKMap.Add('NUMPAD7',VK_NUMPAD7 ); 157 | VKMap.Add('NUMPAD8',VK_NUMPAD8 ); 158 | VKMap.Add('NUMPAD9',VK_NUMPAD9 ); 159 | VKMap.Add('MULTIPLY',VK_MULTIPLY ); 160 | VKMap.Add('ADD',VK_ADD ); 161 | VKMap.Add('SEPARATOR',VK_SEPARATOR ); 162 | VKMap.Add('SUBTRACT',VK_SUBTRACT ); 163 | VKMap.Add('DECIMAL',VK_DECIMAL ); 164 | VKMap.Add('DIVIDE',VK_DIVIDE ); 165 | VKMap.Add('F1',VK_F1 ); 166 | VKMap.Add('F2',VK_F2 ); 167 | VKMap.Add('F3',VK_F3 ); 168 | VKMap.Add('F4',VK_F4 ); 169 | VKMap.Add('F5',VK_F5 ); 170 | VKMap.Add('F6',VK_F6 ); 171 | VKMap.Add('F7',VK_F7 ); 172 | VKMap.Add('F8',VK_F8 ); 173 | VKMap.Add('F9',VK_F9 ); 174 | VKMap.Add('F10',VK_F10 ); 175 | VKMap.Add('F11',VK_F11 ); 176 | VKMap.Add('F12',VK_F12 ); 177 | VKMap.Add('F13',VK_F13 ); 178 | VKMap.Add('F14',VK_F14 ); 179 | VKMap.Add('F15',VK_F15 ); 180 | VKMap.Add('F16',VK_F16 ); 181 | VKMap.Add('F17',VK_F17 ); 182 | VKMap.Add('F18',VK_F18 ); 183 | VKMap.Add('F19',VK_F19 ); 184 | VKMap.Add('F20',VK_F20 ); 185 | VKMap.Add('F21',VK_F21 ); 186 | VKMap.Add('F22',VK_F22 ); 187 | VKMap.Add('F23',VK_F23 ); 188 | VKMap.Add('F24',VK_F24 ); 189 | VKMap.Add('NUMLOCK',VK_NUMLOCK ); 190 | VKMap.Add('SCROLL',VK_SCROLL ); 191 | //VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys. 192 | //Used only as parameters to GetAsyncKeyState() and GetKeyState().); 193 | //No other API or message will distinguish left and right keys in this way. }); 194 | VKMap.Add('LSHIFT',VK_LSHIFT ); 195 | VKMap.Add('RSHIFT',VK_RSHIFT ); 196 | VKMap.Add('LCONTROL',VK_LCONTROL ); 197 | VKMap.Add('RCONTROL',VK_RCONTROL ); 198 | VKMap.Add('LMENU',VK_LMENU ); 199 | VKMap.Add('RMENU',VK_RMENU ); 200 | VKMap.Add('BROWSER_BACK',VK_BROWSER_BACK ); 201 | VKMap.Add('BROWSER_FORWARD',VK_BROWSER_FORWARD ); 202 | VKMap.Add('BROWSER_REFRESH',VK_BROWSER_REFRESH ); 203 | VKMap.Add('BROWSER_STOP',VK_BROWSER_STOP ); 204 | VKMap.Add('BROWSER_SEARCH',VK_BROWSER_SEARCH ); 205 | VKMap.Add('BROWSER_FAVORITES',VK_BROWSER_FAVORITES ); 206 | VKMap.Add('BROWSER_HOME',VK_BROWSER_HOME ); 207 | VKMap.Add('VOLUME_MUTE',VK_VOLUME_MUTE ); 208 | VKMap.Add('VOLUME_DOWN',VK_VOLUME_DOWN ); 209 | VKMap.Add('VOLUME_UP',VK_VOLUME_UP ); 210 | VKMap.Add('MEDIA_NEXT_TRACK',VK_MEDIA_NEXT_TRACK ); 211 | VKMap.Add('MEDIA_PREV_TRACK',VK_MEDIA_PREV_TRACK ); 212 | VKMap.Add('MEDIA_STOP',VK_MEDIA_STOP ); 213 | VKMap.Add('MEDIA_PLAY_PAUSE',VK_MEDIA_PLAY_PAUSE ); 214 | VKMap.Add('LAUNCH_MAIL',VK_LAUNCH_MAIL ); 215 | VKMap.Add('LAUNCH_MEDIA_SELECT',VK_LAUNCH_MEDIA_SELECT ); 216 | VKMap.Add('LAUNCH_APP1',VK_LAUNCH_APP1 ); 217 | VKMap.Add('LAUNCH_APP2',VK_LAUNCH_APP2 ); 218 | VKMap.Add('OEM_1',VK_OEM_1 ); 219 | VKMap.Add('OEM_PLUS',VK_OEM_PLUS ); 220 | VKMap.Add('OEM_COMMA',VK_OEM_COMMA ); 221 | VKMap.Add('OEM_MINUS',VK_OEM_MINUS ); 222 | VKMap.Add('OEM_PERIOD',VK_OEM_PERIOD ); 223 | VKMap.Add('OEM_2',VK_OEM_2 ); 224 | VKMap.Add('OEM_3',VK_OEM_3 ); 225 | VKMap.Add('OEM_4',VK_OEM_4 ); 226 | VKMap.Add('OEM_5',VK_OEM_5 ); 227 | VKMap.Add('OEM_6',VK_OEM_6 ); 228 | VKMap.Add('OEM_7',VK_OEM_7 ); 229 | VKMap.Add('OEM_8',VK_OEM_8 ); 230 | VKMap.Add('OEM_102',VK_OEM_102 ); 231 | VKMap.Add('PACKET',VK_PACKET ); 232 | VKMap.Add('PROCESSKEY',VK_PROCESSKEY ); 233 | VKMap.Add('ATTN',VK_ATTN ); 234 | VKMap.Add('CRSEL',VK_CRSEL ); 235 | VKMap.Add('EXSEL',VK_EXSEL ); 236 | VKMap.Add('EREOF',VK_EREOF ); 237 | VKMap.Add('PLAY',VK_PLAY ); 238 | VKMap.Add('ZOOM',VK_ZOOM ); 239 | VKMap.Add('NONAME',VK_NONAME ); 240 | VKMap.Add('PA1',VK_PA1 ); 241 | VKMap.Add('OEM_CLEAR',VK_OEM_CLEAR); 242 | end; 243 | 244 | destructor THotkeyInvoker.Destroy; 245 | begin 246 | if FHook <> 0 then 247 | UnhookWindowsHookEx(FHook); 248 | VKMap.Clear; 249 | VKMap.Free; 250 | BlockedKeys.Free; 251 | 252 | inherited; 253 | end; 254 | 255 | class function THotkeyInvoker.GetInstance: THotkeyInvoker; 256 | begin 257 | if FInstance = nil then 258 | FInstance := THotkeyInvoker.Create; 259 | Result := FInstance; 260 | end; 261 | 262 | function THotkeyInvoker.InvokeHotKey(const Hotkey: string; Delay, 263 | RepeatCount: Integer): Boolean; 264 | var 265 | Keys: TStringList; 266 | Key: string; 267 | VK: Byte; 268 | IsHoldDown, IsRelease: Boolean; 269 | I, J: Integer; 270 | HeldKeys: TList; 271 | 272 | procedure SendKey(VirtualKey: Byte; Flag: DWORD); 273 | begin 274 | keybd_event(VirtualKey, MapVirtualKey(VirtualKey, 0), Flag, 0); 275 | Sleep(Delay); 276 | end; 277 | 278 | function GetVirtualKey(const Key: string): Byte; 279 | var 280 | VK: Byte; 281 | begin 282 | if VKMap.TryGetValue(Key,VK) then 283 | Result := VK 284 | else 285 | Result := Ord(Key[1]); 286 | end; 287 | 288 | 289 | begin 290 | Result := False; 291 | Keys := TStringList.Create; 292 | HeldKeys := TList.Create; 293 | try 294 | Keys.Delimiter := '+'; 295 | Keys.DelimitedText := UpperCase(HotKey);// StringReplace(Hotkey, '\+', #1, [rfReplaceAll]); 296 | 297 | // for I := 0 to Keys.Count - 1 do 298 | // Keys[I] := StringReplace(Keys[I], #1, '+', [rfReplaceAll]); 299 | 300 | BlockedKeys.Clear; 301 | for I := 0 to Keys.Count - 1 do 302 | begin 303 | Key := Keys[I]; 304 | IsHoldDown := StartsWith(Key, '_'); 305 | IsRelease := EndsWith(Key, '_'); 306 | Key := TrimUnderscores(Key); 307 | 308 | // if Key = 'CTRL' then VK := VK_CONTROL 309 | // else if Key = 'ALT' then VK := VK_MENU 310 | // else if Key = 'SHIFT' then VK := VK_SHIFT 311 | // else if Key = 'WIN' then VK := VK_LWIN 312 | // else if Key = 'TAB' then VK := VK_TAB 313 | // else VK := Ord(UpperCase(Key)[1]); 314 | VK := GetVirtualKey(Key); 315 | 316 | BlockedKeys.Add(IntToStr(VK)); 317 | end; 318 | 319 | BlockInput := True; 320 | try 321 | for J := 1 to RepeatCount do 322 | begin 323 | for I := 0 to Keys.Count - 1 do 324 | begin 325 | Key := Keys[I]; 326 | IsHoldDown := StartsWith(Key, '_'); 327 | IsRelease := EndsWith(Key, '_'); 328 | Key := TrimUnderscores(Key); 329 | 330 | // if Key = 'CTRL' then VK := VK_CONTROL 331 | // else if Key = 'ALT' then VK := VK_MENU 332 | // else if Key = 'SHIFT' then VK := VK_SHIFT 333 | // else if Key = 'WIN' then VK := VK_LWIN 334 | // else if Key = 'TAB' then VK := VK_TAB 335 | // else VK := Ord(UpperCase(Key)[1]); 336 | VK := GetVirtualKey(Key); 337 | 338 | if IsHoldDown and not IsRelease then 339 | begin 340 | SendKey(VK, 0); 341 | HeldKeys.Add(Pointer(VK)); 342 | end 343 | else if not IsHoldDown and not IsRelease then 344 | begin 345 | SendKey(VK, 0); 346 | SendKey(VK, KEYEVENTF_KEYUP); 347 | end 348 | else if IsRelease then 349 | begin 350 | if HeldKeys.IndexOf(Pointer(VK)) >= 0 then 351 | HeldKeys.Remove(Pointer(VK)); 352 | SendKey(VK, KEYEVENTF_KEYUP); 353 | end; 354 | end; 355 | 356 | // Release any remaining held keys in reverse order 357 | for I := HeldKeys.Count - 1 downto 0 do 358 | begin 359 | SendKey(Byte(HeldKeys[I]), KEYEVENTF_KEYUP); 360 | end; 361 | 362 | HeldKeys.Clear; 363 | 364 | if J < RepeatCount then 365 | Sleep(Delay); 366 | end; 367 | 368 | Result := True; 369 | 370 | finally 371 | BlockInput := False; 372 | end; 373 | 374 | 375 | finally 376 | HeldKeys.Free; 377 | Keys.Free; 378 | end; 379 | end; 380 | 381 | procedure THotkeyInvoker.SetBlockInput(const value: Boolean); 382 | begin 383 | FBlockInput := Value; 384 | end; 385 | 386 | initialization 387 | THotkeyInvoker.FInstance := THotkeyInvoker.Create; 388 | 389 | finalization 390 | FreeAndNil(THotkeyInvoker.FInstance); 391 | 392 | end. 393 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

2 | 3 | # WinXcorners 4 | 5 |

6 | 7 | 8 | license 9 | 10 | 11 | 12 | total downloads 13 | 14 | 15 | 16 | total latest downloads 17 | 18 | 19 | 20 | total latest downloads 21 | 22 | 23 | 24 | total latest downloads 25 | 26 |
27 | 28 |
29 |

30 | 31 | WinXcorners 32 | 33 | | 34 | 35 | Features 36 | 37 | | 38 | 39 | How To 40 | 41 | | 42 | 43 | Download 44 | 45 | | 46 | 47 | Development 48 | 49 | | 50 | 51 | Contribution 52 | 53 |

54 |
55 | 56 | 62 | 63 | ## WinXcorners 64 | WinXcorners is a lightweight utility for Windows 10 and Windows 11 that enhances your desktop experience by allowing you to assign custom actions triggered when you hover your mouse cursor over the corners of your main monitor. Whether you're a power user, developer, or just someone who appreciates efficiency, WinXcorners provides a seamless way to streamline your workflow. 65 | 66 | ## Key Features ⬆️ 67 | 68 | 1. **Corner Actions**: Choose from a variety of predefined actions for each corner: 69 | - [x] **Show All Windows**: Activate Windows' Task View `Win`+`Tab` to manage your open applications. 70 | - [x] **Show Desktop**: Quickly minimize all windows and reveal the desktop. 71 | - [x] **Start Screen Saver**: Trigger your screen saver for privacy or energy-saving purposes. 72 | - [x] **Turn Off Monitors**: Conveniently turn off your display when not in use. 73 | - [x] **Start Menu**: Invoke the Start Menu on hovering a corner. 74 | - [x] **Action Center**: Invoke the Action Center without hassle. 75 | - [x] **Hide Other Windows**: Just like `Win`+`Home`. 76 | - [x] **Custom**: Invoke other executables with command line params 77 | - [x] 🆕 **Custom**: Execute custom hotkeys (sequence of key hold/release) *___v1.3.1___ ( How to ⬇️) 78 | 79 | 2. **Customization**: Tailor WinXcorners to your preferences: 80 | - Assign different actions to different corners. 81 | - Fine-tune hover sensitivity and delay settings. 82 | - Enable or disable automatic startup with Windows. 83 | 84 | 3. **System Tray Integration**: WinXcorners runs discreetly in the system tray, ensuring it doesn't clutter your desktop or Taskbar. 85 | 86 | 4. **Unobstrusive**: Its usage won't interfere with your common tasks, unless you decide to do so. 87 | - It won't trigger actions while dragging content with your mouse. 88 | - It won't trigger while using a **Full Screen application**, like games or media, for instance. 89 | - You can disable it temporarily right from the popup window with the switch toggle. 90 | 91 | 5. **Visible Countdown Counter**: Helps you, visually, to know if a corner action is about to be triggered (Advanced feature). 92 | 93 | 6. **Windows 10/11 Theme aware**: Partially supports Windows 10 and 11 dark and light theme, so it will look like part of your OS. 94 |

:crescent_moon:themes:high_brightness:

95 | 96 | 97 | | Dark Theme Windows 11 | Light Theme Windows 11 | 98 | |:-------------------------------------------------:|:-----------------------------------------------:| 99 | | ![snap02](https://github.com/vhanla/winxcorners/blob/master/.github/snap02.jpg?raw=true) | ![snap02b](https://github.com/vhanla/winxcorners/blob/master/.github/snap02b.jpg?raw=true) | 100 | | Dark Theme Windows 10 | Light Theme Windows 10 May 2019 Update onwards | 101 | | ![snp4](https://lh3.googleusercontent.com/-7ja-oixZ058/Vh-zjp8pRpI/AAAAAAAALQo/h4y4EPuoBbY/WinXCorners%25255B9%25255D%25255B1%25255D.jpg?imgmax=800)| ![imagen](https://user-images.githubusercontent.com/1015823/59126095-d2835e80-8929-11e9-9b89-6023164aaa8d.png)| 102 | 103 | ## Demo Video 104 |
105 | 106 | 🎞 107 | 108 |

This demonstration would change on following versions.

109 |
110 |

111 | 112 | ## Installation (Portable) ⬆️ 113 | 1. Download the latest release from the GitHub repository. 114 | 2. Just unzip into a secure folder. 115 | 3. Run the single small executable, settings will be written/saved there. 116 | 4. 💡 It will run minimized and hidden in the **System Tray** 117 | 118 | ## Requirements 119 | 120 | — OS: Windows 10 x86/x64 | Windows 11 121 | — HDD: 1.4 MB 122 | — RAM: 9 MB 123 | 124 | 125 | 126 | ## Download and Installation *(?)* 127 | 128 | ![platform](https://img.shields.io/static/v1.svg?label=Platform&message=Win-32&style=for-the-badge) 129 | 130 | | v1.3.2 (2024) | v1.3.0 (2024) | v1.2.1b (2019) | 131 | |:---------------:|:---------------:|:-----------------:| 132 | | ![](https://raw.githubusercontent.com/wiki/ryanoasis/nerd-fonts/screenshots/v1.0.x/windows-pass-sm.png)| ![](https://raw.githubusercontent.com/wiki/ryanoasis/nerd-fonts/screenshots/v1.0.x/windows-pass-sm.png)| ![](https://raw.githubusercontent.com/wiki/ryanoasis/nerd-fonts/screenshots/v1.0.x/windows-pass-sm.png)| 133 | | [![latest versionbeta](https://img.shields.io/github/downloads/vhanla/winxcorners/latest/winxcorners1.3.2.zip.svg)](https://github.com/vhanla/winxcorners/releases/download/1.3.2/winxcorners1.3.2.zip) | [![latest version](https://img.shields.io/github/downloads/vhanla/winxcorners/1.3.0/winxcorners130.zip.svg)](https://github.com/vhanla/winxcorners/releases/download/1.3.0/winxcorners130.zip) | [![latest version](https://img.shields.io/github/downloads/vhanla/winxcorners/1.2.1b/WinXCornersRegistryFix.zip.svg)](https://github.com/vhanla/winxcorners/releases/download/1.2.1b/WinXCornersRegistryFix.zip) | 134 | 135 | 136 | 137 | ## How To Use ⬆️ 138 | 1. Launch WinXcorners popup window from the system tray icon. 139 | 2. Configure your preferred actions for each corner. 140 | 3. Hover your mouse cursor over a corner to trigger the assigned action. 141 | 142 | ## Advanced Usage 143 | 1. Right click the WinXcorners tray icon. 144 | 2. Select **Advanced** to open the more advanced options. 145 | 146 | | | | 147 | |:-------------------------------------------------:|:-------------------------------------------------:| 148 | |![snap02](https://github.com/vhanla/winxcorners/blob/master/.github/snap03.jpg?raw=true)|![snp5](https://lh3.googleusercontent.com/-NtNXrUcUUus/V6VlOWJMPeI/AAAAAAAALxM/hmfgAnoSvK8/image%25255B12%25255D.png?imgmax=800)| 149 | |Advanced options v 1.3.0 | Advanced options v 1.2.1b *old snapshot* | 150 | 151 | 3. There you can: 152 | - Set a global delay, so the action will trigger after some few seconds. 153 | - Set specific delay for each corner. 154 | - Enable or Disable the triggering of actions while on Full Screen applications, it can also be done via the right click on the system tray icon for WinXcorners. 155 | 4. Add up to 4 custom actions: Just write the commands and its respective arguments to launch, set hidden launch or visible. 156 | 157 | ## Custom Hotkeys ⬆️ 158 | *___v1.3.1___ 159 | 160 | The hotkeys will be as follows: 161 | `_control` or `control` or `control_` where `_` means hold or release (prefixed, appended) and without it, a full key press. This will be useful if you have a sequence of hotkeys to do, like `_control+k+control_+_control+_b` for VSCode for instance, that will do a `ctrl+k` then `ctrl+b` to toggle the sidebar. 162 | 163 | There is more, it will check for windows on foreground/currently focused, or globally, whether by only its classname or with titlebar text too. The conditional pseudo script will be as follows: 164 | ``` 165 | ! = follows sequence of hotkeys as mentioned above 166 | # = follows [classname,title] there title is optional to match with current focused window 167 | @ = follows [classname,title] there title is optional to match with any opened window 168 | ``` 169 | 170 | ### Rule: 171 | 172 | `#[classname,title]:(sequence of hotkeys)?(optional sequence of hotkeys in case condition is not met)` 173 | 174 | For instance the following will check if current window is VSCode's and will invoke `ctrl+k` `ctrl+b` sequence of hotkeys, other wise if not on VSCode, just invoke the Start Menu. 175 | 176 | `#[Chrome_WidgetWin_1]:(_control+k+control_+_control+_b)?(win)` 177 | 178 | E.g. `#[conditional match]:(hotkey if match)?(hotkey if not)` 179 | 180 | Another example for Windows 10: 181 | 182 | This will check if Alt+Tab's window is visible, if so, it will hide it, otherwise it will invoke it, as a faster alternative to Task View. 183 | `#[MultitaskingViewFrame]:(escape)?(_control+_alt+tab)` 184 | 185 | ![snap03](https://github.com/vhanla/winxcorners/blob/master/.github/snap03b.jpg?raw=true) 186 | 187 | ## Notes 188 | - WinXcorners works seamlessly on your primary monitor but secondary monitors haven't been tested throughfully, consider it partially supported. 189 | - If you encounter issues with elevated privileges software, try restarting WinXcorners as an administrator specially if you use those kind of elevated privileged software most of the time, otherwise triggering won't work due to the nature of separate privileges. 190 | - If you encounter other unknown issues, please fill a bug report at the GitHub issues page. 191 | 192 | **Limitations**: 193 | 194 | Sometimes the application won't detect the screen edges if you are using (focused) an elevated privileged application. But you can always restart the application as administrator. 195 | 196 | ## Development ⬆️ 197 | 198 | Build with Delphi 2006 onwards, third party units are in thirdparty and all rights belong to each of them, they're open source too. 199 | 200 | ## Contribution ⬆️ 201 | 202 | You're welcome to PR your improvements. 203 | 204 | MIT License 205 | 206 | Copyright (c) 2015 Victor Alberto Gil (vhanla) 207 | 208 | Permission is hereby granted, free of charge, to any person obtaining a copy 209 | of this software and associated documentation files (the "Software"), to deal 210 | in the Software without restriction, including without limitation the rights 211 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 212 | copies of the Software, and to permit persons to whom the Software is 213 | furnished to do so, subject to the following conditions: 214 | 215 | The above copyright notice and this permission notice shall be included in all 216 | copies or substantial portions of the Software. 217 | 218 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 219 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 220 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 221 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 222 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 223 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 224 | SOFTWARE. 225 | -------------------------------------------------------------------------------- /frmAdvanced.dfm: -------------------------------------------------------------------------------- 1 | object frmAdvSettings: TfrmAdvSettings 2 | Left = 0 3 | Top = 0 4 | AlphaBlend = True 5 | Caption = 'WinXCorners - Advanced Options' 6 | ClientHeight = 427 7 | ClientWidth = 438 8 | Color = 2960685 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWhite 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | OnShow = FormShow 18 | DesignSize = ( 19 | 438 20 | 427) 21 | PixelsPerInch = 96 22 | TextHeight = 13 23 | object Label4: TLabel 24 | Left = 16 25 | Top = 398 26 | Width = 91 27 | Height = 15 28 | Cursor = crHandPoint 29 | Margins.Left = 2 30 | Margins.Top = 2 31 | Margins.Right = 2 32 | Margins.Bottom = 2 33 | Anchors = [akLeft, akBottom] 34 | Caption = 'Support my work' 35 | Font.Charset = ANSI_CHARSET 36 | Font.Color = 15626577 37 | Font.Height = -12 38 | Font.Name = 'Segoe UI' 39 | Font.Style = [] 40 | ParentFont = False 41 | OnClick = Label4Click 42 | end 43 | object Label5: TLabel 44 | Left = 147 45 | Top = 398 46 | Width = 96 47 | Height = 15 48 | Cursor = crHandPoint 49 | Margins.Left = 2 50 | Margins.Top = 2 51 | Margins.Right = 2 52 | Margins.Bottom = 2 53 | Anchors = [akLeft, akBottom] 54 | Caption = 'Check for updates' 55 | Color = 16744448 56 | Font.Charset = ANSI_CHARSET 57 | Font.Color = 15626577 58 | Font.Height = -12 59 | Font.Name = 'Segoe UI' 60 | Font.Style = [] 61 | ParentColor = False 62 | ParentFont = False 63 | OnClick = Label5Click 64 | end 65 | object Label2: TLabel 66 | Left = 307 67 | Top = 163 68 | Width = 124 69 | Height = 14 70 | Margins.Left = 2 71 | Margins.Top = 2 72 | Margins.Right = 2 73 | Margins.Bottom = 2 74 | Caption = 'Beta build (20240630)' 75 | Color = clWhite 76 | Font.Charset = DEFAULT_CHARSET 77 | Font.Color = clGray 78 | Font.Height = -12 79 | Font.Name = 'Tahoma' 80 | Font.Style = [] 81 | ParentColor = False 82 | ParentFont = False 83 | end 84 | object btnCancel: TButton 85 | Left = 351 86 | Top = 394 87 | Width = 75 88 | Height = 25 89 | Anchors = [akRight, akBottom] 90 | Caption = '&Cancel' 91 | TabOrder = 1 92 | OnClick = btnCancelClick 93 | end 94 | object btnOK: TButton 95 | Left = 270 96 | Top = 394 97 | Width = 75 98 | Height = 25 99 | Anchors = [akRight, akBottom] 100 | Caption = '&OK' 101 | TabOrder = 0 102 | OnClick = btnOKClick 103 | end 104 | object ATTabs1: TATTabs 105 | AlignWithMargins = True 106 | Left = 8 107 | Top = 191 108 | Width = 422 109 | Height = 35 110 | Margins.Left = 8 111 | Margins.Right = 8 112 | Margins.Bottom = 0 113 | Align = alBottom 114 | Tabs = < 115 | item 116 | TabCaption = 'Command 1' 117 | TabHideXButton = True 118 | end 119 | item 120 | TabCaption = 'Command 2' 121 | TabHideXButton = True 122 | end 123 | item 124 | TabCaption = 'Command 3' 125 | TabHideXButton = True 126 | end 127 | item 128 | TabCaption = 'Command 4' 129 | TabHideXButton = True 130 | end> 131 | DoubleBuffered = True 132 | ColorBg = 2960685 133 | ColorBorderPassive = 6579300 134 | ColorTabPassive = 2960685 135 | ColorActiveMark = 16744448 136 | OptButtonLayout = '<>,v' 137 | OptShowAngleTangent = 2.599999904632568000 138 | OptShowFlat = True 139 | OptShowFlatSepar = False 140 | OptShowXButtons = atbxShowNone 141 | OptShowPlusTab = False 142 | OptShowModifiedText = '*' 143 | OptMouseDragOutEnabled = False 144 | OptHintForX = 'Close tab' 145 | OptHintForPlus = 'Add tab' 146 | OptHintForArrowLeft = 'Scroll tabs left' 147 | OptHintForArrowRight = 'Scroll tabs right' 148 | OptHintForArrowMenu = 'Show tabs list' 149 | OptHintForUser0 = '0' 150 | OptHintForUser1 = '1' 151 | OptHintForUser2 = '2' 152 | OptHintForUser3 = '3' 153 | OptHintForUser4 = '4' 154 | OnTabClick = ATTabs1TabClick 155 | end 156 | object Panel1: TPanel 157 | AlignWithMargins = True 158 | Left = 8 159 | Top = 8 160 | Width = 422 161 | Height = 145 162 | Margins.Left = 8 163 | Margins.Top = 8 164 | Margins.Right = 8 165 | Margins.Bottom = 8 166 | Align = alTop 167 | BevelOuter = bvNone 168 | BorderStyle = bsSingle 169 | Caption = 'Panel1' 170 | Ctl3D = False 171 | ParentCtl3D = False 172 | ShowCaption = False 173 | TabOrder = 3 174 | object chkDelayBotLeft: TXCheckbox 175 | Left = 24 176 | Top = 71 177 | Width = 44 178 | Height = 20 179 | Caption = 'Top Bottom Delay' 180 | Color = 16744448 181 | DisabledColor = 5592405 182 | PressedColor = 6710886 183 | Checked = False 184 | OnClick = chkDelayBotLeftClick 185 | Font.Charset = DEFAULT_CHARSET 186 | Font.Color = clWhite 187 | Font.Height = -12 188 | Font.Name = 'Segoe UI' 189 | Font.Style = [] 190 | ParentColor = True 191 | Labeled = True 192 | LabelPosition = lpRight 193 | end 194 | object chkDelayBotRight: TXCheckbox 195 | Left = 213 196 | Top = 71 197 | Width = 44 198 | Height = 20 199 | Caption = 'Top Bottom delay' 200 | Color = 16744448 201 | DisabledColor = 5592405 202 | PressedColor = 6710886 203 | Checked = False 204 | OnClick = chkDelayBotRightClick 205 | Font.Charset = DEFAULT_CHARSET 206 | Font.Color = clWhite 207 | Font.Height = -12 208 | Font.Name = 'Segoe UI' 209 | Font.Style = [] 210 | ParentColor = True 211 | Labeled = True 212 | LabelPosition = lpRight 213 | end 214 | object chkDelayGlobal: TXCheckbox 215 | Left = 16 216 | Top = 5 217 | Width = 44 218 | Height = 20 219 | Caption = 'Set a global delay in seconds:' 220 | Color = 16744448 221 | DisabledColor = 5592405 222 | PressedColor = 6710886 223 | Checked = False 224 | OnClick = chkDelayGlobalClick 225 | Font.Charset = DEFAULT_CHARSET 226 | Font.Color = clWhite 227 | Font.Height = -12 228 | Font.Name = 'Segoe UI' 229 | Font.Style = [] 230 | ParentColor = True 231 | Labeled = True 232 | LabelPosition = lpRight 233 | end 234 | object chkDelayTopLeft: TXCheckbox 235 | Left = 24 236 | Top = 37 237 | Width = 44 238 | Height = 20 239 | Caption = 'Top Left Delay' 240 | Color = 16744448 241 | DisabledColor = 5592405 242 | PressedColor = 6710886 243 | Checked = False 244 | OnClick = chkDelayTopLeftClick 245 | Font.Charset = DEFAULT_CHARSET 246 | Font.Color = clWhite 247 | Font.Height = -12 248 | Font.Name = 'Segoe UI' 249 | Font.Style = [] 250 | ParentColor = True 251 | Labeled = True 252 | LabelPosition = lpRight 253 | end 254 | object chkDelayTopRight: TXCheckbox 255 | Left = 213 256 | Top = 37 257 | Width = 44 258 | Height = 20 259 | Caption = 'Top Right delay' 260 | Color = 16744448 261 | DisabledColor = 5592405 262 | PressedColor = 6710886 263 | Checked = False 264 | OnClick = chkDelayTopRightClick 265 | Font.Charset = DEFAULT_CHARSET 266 | Font.Color = clWhite 267 | Font.Height = -12 268 | Font.Name = 'Segoe UI' 269 | Font.Style = [] 270 | ParentColor = True 271 | Labeled = True 272 | LabelPosition = lpRight 273 | end 274 | object chkFullScreen: TXCheckbox 275 | Left = 163 276 | Top = 116 277 | Width = 44 278 | Height = 20 279 | Caption = 'Do nothing on Full Screen' 280 | Color = 16744448 281 | DisabledColor = 5592405 282 | PressedColor = 6710886 283 | Checked = False 284 | OnClick = chkFullScreenClick 285 | Font.Charset = DEFAULT_CHARSET 286 | Font.Color = clWhite 287 | Font.Height = -12 288 | Font.Name = 'Segoe UI' 289 | Font.Style = [] 290 | ParentColor = True 291 | Labeled = True 292 | LabelPosition = lpRight 293 | end 294 | object chkShowCount: TXCheckbox 295 | Left = 16 296 | Top = 116 297 | Width = 44 298 | Height = 20 299 | Caption = 'Show Countdown' 300 | Color = 16744448 301 | DisabledColor = 5592405 302 | PressedColor = 6710886 303 | Checked = False 304 | Font.Charset = DEFAULT_CHARSET 305 | Font.Color = clWhite 306 | Font.Height = -12 307 | Font.Name = 'Segoe UI' 308 | Font.Style = [] 309 | ParentColor = True 310 | Labeled = True 311 | LabelPosition = lpRight 312 | end 313 | object cbValDelayGlobal: TComboBox 314 | Left = 240 315 | Top = 5 316 | Width = 40 317 | Height = 21 318 | Style = csDropDownList 319 | Color = clNone 320 | ItemHeight = 13 321 | TabOrder = 0 322 | Items.Strings = ( 323 | '0.25' 324 | '0.50' 325 | '0.75' 326 | '1.00' 327 | '1.25' 328 | '1.50') 329 | end 330 | object cbValDelayTopLeft: TComboBox 331 | Left = 172 332 | Top = 38 333 | Width = 40 334 | Height = 21 335 | Style = csDropDownList 336 | Color = clNone 337 | ItemHeight = 13 338 | TabOrder = 1 339 | Items.Strings = ( 340 | '0.25' 341 | '0.50' 342 | '0.75' 343 | '1.00' 344 | '1.25' 345 | '1.50') 346 | end 347 | object cbValDelayBotLeft: TComboBox 348 | Left = 172 349 | Top = 72 350 | Width = 40 351 | Height = 21 352 | Style = csDropDownList 353 | Color = clNone 354 | ItemHeight = 13 355 | TabOrder = 2 356 | Items.Strings = ( 357 | '0.25' 358 | '0.50' 359 | '0.75' 360 | '1.00' 361 | '1.25' 362 | '1.50') 363 | end 364 | object cbValDelayTopRight: TComboBox 365 | Left = 364 366 | Top = 38 367 | Width = 40 368 | Height = 21 369 | Style = csDropDownList 370 | Color = clNone 371 | ItemHeight = 13 372 | TabOrder = 3 373 | Items.Strings = ( 374 | '0.25' 375 | '0.50' 376 | '0.75' 377 | '1.00' 378 | '1.25' 379 | '1.50') 380 | end 381 | object cbValDelayBotRight: TComboBox 382 | Left = 364 383 | Top = 72 384 | Width = 40 385 | Height = 21 386 | Style = csDropDownList 387 | Color = clNone 388 | ItemHeight = 13 389 | TabOrder = 4 390 | Items.Strings = ( 391 | '0.25' 392 | '0.50' 393 | '0.75' 394 | '1.00' 395 | '1.25' 396 | '1.50') 397 | end 398 | end 399 | object Panel2: TPanel 400 | AlignWithMargins = True 401 | Left = 8 402 | Top = 226 403 | Width = 422 404 | Height = 153 405 | Margins.Left = 8 406 | Margins.Top = 0 407 | Margins.Right = 8 408 | Margins.Bottom = 48 409 | Align = alBottom 410 | BevelOuter = bvNone 411 | BorderStyle = bsSingle 412 | Caption = 'Panel2' 413 | Ctl3D = False 414 | ParentCtl3D = False 415 | ShowCaption = False 416 | TabOrder = 4 417 | object chkCustom: TXCheckbox 418 | Left = 16 419 | Top = 121 420 | Width = 44 421 | Height = 20 422 | Caption = 'Enable Custom Commands' 423 | Color = 16744448 424 | DisabledColor = 5592405 425 | PressedColor = 6710886 426 | Checked = False 427 | Font.Charset = DEFAULT_CHARSET 428 | Font.Color = clWhite 429 | Font.Height = -12 430 | Font.Name = 'Segoe UI' 431 | Font.Style = [] 432 | ParentColor = True 433 | Labeled = True 434 | LabelPosition = lpRight 435 | end 436 | object chkHidden: TXCheckbox 437 | Left = 251 438 | Top = 121 439 | Width = 44 440 | Height = 20 441 | Caption = 'Launch Hidden' 442 | Color = 16744448 443 | DisabledColor = 5592405 444 | PressedColor = 6710886 445 | Checked = False 446 | OnClick = chkHiddenClick 447 | Font.Charset = DEFAULT_CHARSET 448 | Font.Color = clWhite 449 | Font.Height = -12 450 | Font.Name = 'Segoe UI' 451 | Font.Style = [] 452 | ParentColor = True 453 | Labeled = True 454 | LabelPosition = lpRight 455 | end 456 | object Label1: TLabel 457 | Left = 16 458 | Top = 70 459 | Width = 104 460 | Height = 13 461 | Margins.Left = 2 462 | Margins.Top = 2 463 | Margins.Right = 2 464 | Margins.Bottom = 2 465 | Caption = 'Parameters (optional)' 466 | Color = clBackground 467 | ParentColor = False 468 | end 469 | object Label3: TLabel 470 | Left = 16 471 | Top = 26 472 | Width = 370 473 | Height = 13 474 | Margins.Left = 2 475 | Margins.Top = 2 476 | Margins.Right = 2 477 | Margins.Bottom = 2 478 | Caption = 479 | 'Write a custom command (executable path + parameters): e.g. note' + 480 | 'pad.exe' 481 | Color = 2960685 482 | ParentColor = False 483 | end 484 | object edCommand: TButtonedEdit 485 | Left = 16 486 | Top = 46 487 | Width = 368 488 | Height = 19 489 | Color = clNone 490 | Ctl3D = False 491 | ParentCtl3D = False 492 | TabOrder = 0 493 | TextHint = 494 | 'You can also trigger hotkeys by prepending !, eg. !_control+_alt' + 495 | '+tab' 496 | OnChange = edCommandChange 497 | end 498 | object edParams: TButtonedEdit 499 | Left = 16 500 | Top = 88 501 | Width = 368 502 | Height = 19 503 | Color = clNone 504 | Ctl3D = False 505 | ParentCtl3D = False 506 | TabOrder = 1 507 | TextHint = 508 | 'You can also trigger hotkeys by prepending !, eg. !_control+_alt' + 509 | '+tab' 510 | OnChange = edParamsChange 511 | end 512 | end 513 | end 514 | -------------------------------------------------------------------------------- /XCombobox.pas: -------------------------------------------------------------------------------- 1 | { 2 | XCheckbox, mimics the Windows 10's checkbox capable of 3 | adding over an aero glass form on Delphi 4 | 5 | Author: vhanla 6 | 7 | Changelog: 8 | TODO: 9 | Add touch support 10 | Add items support using maybe XPopupMenu 11 | - 16-08-05 12 | Change rendering text method for gdiplus to make it look better 13 | https://theartofdev.com/2014/03/02/blurryfuzzy-gdi-text-rendering-using-antialias-and-floating-point-y-coordinates/ 14 | http://stackoverflow.com/questions/11307509/drawing-text-on-glass-background-becomes-blurred-as-alpha-is-lowered 15 | 16 | - 15-10-14 17 | Looks like Windows' 18 | Twetaked to use it as a label when disabled, temporary solution :P 19 | Fixed OnClick property in order to programmatically assign a function 20 | to handle it, just removed the extra read an write events 21 | } 22 | unit XCombobox; 23 | 24 | interface 25 | 26 | uses 27 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 28 | StdCtrls, PNGimage, functions, GDIPApi, GDIPobj; 29 | 30 | type 31 | TXCombobox = class(TGraphicControl) 32 | private 33 | _caption: string; 34 | _disabledColor: TColor; 35 | _enabledColor: TColor; 36 | _pressedColor: TColor; 37 | _chkstate: Boolean; 38 | _mousehover: Boolean; 39 | _mousepressed: Boolean; 40 | _enabled: Boolean; 41 | 42 | MDown: TMouseEvent; 43 | MUp: TMouseEvent; 44 | MLeave: TNotifyEvent; 45 | BtnClick: TNotifyEvent; 46 | FOnclick: TNotifyEvent; 47 | _font: TFont; 48 | 49 | procedure SetDisabledColor(Value: TColor); 50 | procedure SetEnabledColor(Value: TColor); 51 | procedure SetEnabled(Value: Boolean); 52 | procedure SetPressedColor(Value: TColor); 53 | procedure SetCaption(Value: string); 54 | procedure SetCheckState(Value: Boolean); 55 | procedure SetFont(Value: TFont); 56 | 57 | protected 58 | procedure Paint; override; 59 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 60 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 61 | procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE; 62 | procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER; 63 | procedure Click; override; 64 | procedure SetParent(Value: TWinControl); override; 65 | public 66 | constructor Create(AOwner: TComponent); override; 67 | destructor Destroy; override; 68 | published 69 | property Caption: string read _caption write SetCaption; 70 | property Color: TColor read _enabledColor write SetEnabledColor; 71 | property DisabledColor: TColor read _disabledColor write SetDisabledColor; 72 | property PressedColor: TColor read _pressedColor write SetPressedColor; 73 | property Checked: Boolean read _chkstate write SetCheckState; 74 | 75 | property OnMouseDown: TMouseEvent read MDown write MDown; 76 | property OnMouseUp: TMouseEvent read MUp write MUp; 77 | property OnMouseLeave: TNotifyEvent read MLeave write MLeave; 78 | property ShowHint; 79 | property ParentShowHint; 80 | property OnMouseMove; 81 | // property Font; 82 | property Font: TFont read _font write SetFont; 83 | property Enabled: Boolean read _enabled write SetEnabled; 84 | property OnClick; //: TNotifyEvent read FOnClick write FOnClick; 85 | 86 | end; 87 | 88 | procedure Register; 89 | 90 | implementation 91 | 92 | procedure Register; 93 | begin 94 | RegisterComponents('codigobit', [TXCombobox]); 95 | end; 96 | 97 | { TXCombobox } 98 | 99 | procedure TXCombobox.Click; 100 | begin 101 | inherited; 102 | // ShowMessage(inttostr(Width)); 103 | // _chkstate := not _chkstate; 104 | //Paint; 105 | end; 106 | 107 | constructor TXCombobox.Create(AOwner: TComponent); 108 | begin 109 | inherited Create(AOwner); 110 | // Width := MulDiv(167, Screen.PixelsPerInch, 96); //win10 111 | Width := MulDiv(151, Screen.PixelsPerInch, 96); 112 | Height := MulDiv(31, Screen.PixelsPerInch, 96); 113 | _enabledcolor := clOlive; 114 | _disabledColor := clBlack; 115 | _enabled := True; // this will show as label if disabled 116 | _pressedColor := $666666; 117 | _mousehover := False; 118 | _mousepressed := False; 119 | Canvas.Brush.Color := clBlack; 120 | _font := TFont.Create; 121 | _font.Color := clWhite; 122 | _font.Size := 14; //12 win10 123 | FOnclick := nil; 124 | ShowHint := False; 125 | end; 126 | 127 | destructor TXCombobox.Destroy; 128 | begin 129 | _font.Free; 130 | inherited; 131 | end; 132 | 133 | procedure TXCombobox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, 134 | Y: Integer); 135 | begin 136 | inherited; 137 | _mousepressed := True; 138 | Paint; 139 | end; 140 | 141 | procedure TXCombobox.MouseEnter(var Message: TMessage); 142 | begin 143 | _mousehover := True; 144 | Paint; 145 | end; 146 | 147 | procedure TXCombobox.MouseLeave(var Message: TMessage); 148 | begin 149 | _mousehover := False; 150 | Paint; 151 | end; 152 | 153 | procedure TXCombobox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, 154 | Y: Integer); 155 | begin 156 | inherited; 157 | _mousepressed := False; 158 | Paint; 159 | end; 160 | 161 | procedure TXCombobox.Paint; 162 | 163 | function MakeGDIPColor(C: TColor; A: Integer = 255): Cardinal; 164 | var 165 | tmpRGB: TColorRef; 166 | begin 167 | tmpRGB := ColorToRGB(C); 168 | Result := ((DWORD(GetBValue(tmpRGB)) shl BlueShift) or 169 | (DWORD(GetGValue(tmpRGB)) shl GreenShift) or 170 | (DWORD(GetRValue(tmpRGB)) shl RedShift) or 171 | (DWORD(A) shl AlphaShift)); 172 | end; 173 | 174 | function hidpi(value: Integer): Integer; 175 | begin 176 | Result := MulDiv(value, Screen.PixelsPerInch, 96); 177 | end; 178 | 179 | var 180 | bmp: TBitmap; 181 | xfont: TGPFont; 182 | style: Integer; 183 | graph: TGPGraphics; 184 | pen: TGPPen; 185 | brush: TGPSolidBrush; 186 | stringFormat: TGPStringFormat; 187 | l, t, w, h, d, s, radio: Integer; 188 | txt: WideString; 189 | DPI: Integer; 190 | ScaleFactor: Single; 191 | path: TGPGraphicsPath; 192 | begin 193 | inherited; 194 | 195 | DPI := Screen.PixelsPerInch; 196 | ScaleFactor := 1; //DPI / 96; // Assuming 96 DPI as the baseline 197 | 198 | radio := 42; 199 | d := radio div 2; 200 | s := d div 2; // guide for lines width 201 | 202 | bmp := TBitmap.Create; 203 | try 204 | bmp.PixelFormat := pf32bit; 205 | bmp.SetSize(Width, Height); 206 | 207 | // Clear the canvas with appropriate color 208 | if TaskbarAccented then 209 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha(BlendColors(clBlack, GetAccentColor, 50), 200) 210 | else if SystemUsesLightTheme then 211 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha($DDDDDD, 200) 212 | else 213 | begin 214 | if isWindows11 then 215 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha(BlendColors($2d2d2d, clBlack,25), 200) 216 | else 217 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha($222222, 200); 218 | end; 219 | 220 | bmp.Canvas.FillRect(Rect(0, 0, Width, Height)); 221 | 222 | graph := TGPGraphics.Create(bmp.Canvas.Handle); 223 | try 224 | graph.SetSmoothingMode(SmoothingModeAntiAlias); 225 | 226 | l := 0; t := 0; w := Width - 1; h := Height - 1; 227 | style := FontStyleRegular; 228 | 229 | xfont := TGPFont.Create(_font.Name, hidpi(_font.Size), style, UnitPixel); 230 | try 231 | brush := TGPSolidBrush.Create(MakeGDIPColor(_disabledColor)); 232 | try 233 | if SystemUsesLightTheme then 234 | pen := TGPPen.Create(MakeGDIPColor(clBlack, 100), 2 * ScaleFactor) 235 | else 236 | pen := TGPPen.Create(MakeGDIPColor(_disabledColor, 100), 2 * ScaleFactor); 237 | 238 | try 239 | if _enabled then 240 | begin 241 | if _mousepressed then 242 | begin 243 | if isWindows11 then 244 | begin 245 | end 246 | else // win10 247 | begin 248 | brush.SetColor(MakeGDIPColor(_pressedColor)); 249 | graph.FillRectangle(brush, MakeRect(0, 0, Width - 1, Height - 1)); 250 | brush.SetColor(MakeGDIPColor(_disabledColor)); 251 | end; 252 | end 253 | else if _mousehover then 254 | begin 255 | if SystemUsesLightTheme then 256 | pen.SetColor(MakeGDIPColor($333333)) 257 | else 258 | pen.SetColor(MakeGDIPColor(_disabledColor)); 259 | end; 260 | 261 | //draw button 262 | d := HighDpi(8); //radio 263 | 264 | if isWindows11 then 265 | begin 266 | path := TGPGraphicsPath.Create(); 267 | try 268 | path.AddArc(l + 1, t + 1, d, d, 180, 90); 269 | path.AddArc(l + w - d - 1, t + 1, d, d, 270, 90); 270 | path.AddArc(l + w - d - 1, t + h - 1 - d, d, d, 0, 90); 271 | path.AddArc(l + 1, t + h - d - 1, d, d, 90, 90); 272 | path.CloseFigure; 273 | if _mousepressed then 274 | brush.SetColor(MakeGDIPColor($303030)) 275 | else 276 | begin 277 | if SystemUsesLightTheme then 278 | brush.SetColor(MakeGDIPColor($cccccc)) 279 | else 280 | brush.SetColor($FF353535); 281 | end; 282 | graph.FillPath(brush, path); 283 | finally 284 | path.Free; 285 | end; 286 | path := TGPGraphicsPath.Create(); 287 | try 288 | path.AddArc(l + 2, t + 2, d, d, 180, 90); 289 | path.AddArc(l + w - d - 2, t + 2, d, d, 270, 90); 290 | path.AddArc(l + w - d - 2, t + h - 2 - d, d, d, 0, 90); 291 | path.AddArc(l + 2, t + h - d - 2, d, d, 90, 90); 292 | path.CloseFigure; 293 | if _mousehover then 294 | begin 295 | if SystemUsesLightTheme then 296 | brush.SetColor($FFF5F5F5) 297 | else 298 | brush.SetColor($FF323232) 299 | end 300 | else 301 | if SystemUsesLightTheme then 302 | brush.SetColor($effbfbfb) 303 | else 304 | brush.SetColor($FF2D2D2D); 305 | 306 | if _mousepressed then 307 | begin 308 | if SystemUsesLightTheme then 309 | brush.SetColor($FFf5f5f5) 310 | else 311 | brush.SetColor($FF272727); 312 | end; 313 | 314 | graph.FillPath(brush, path); 315 | finally 316 | path.Free; 317 | end; 318 | 319 | end 320 | else //win10 321 | begin 322 | graph.DrawLine(pen, l, t, l + w, t); 323 | graph.DrawLine(pen, l, t, l, t + h); 324 | graph.DrawLine(pen, l, t + h, l + w, t + h); 325 | graph.DrawLine(pen, l + w, t, l + w, t + h); 326 | end; 327 | 328 | // Draw knob 329 | pen.SetWidth(1); 330 | if SystemUsesLightTheme then 331 | pen.SetColor($FF333333) 332 | else 333 | pen.SetColor(MakeGDIPColor(_disabledColor, 100)); 334 | graph.DrawLine(pen, l + w - hidpi(22), t + hidpi(13), l + w - hidpi(22) + 6, t + hidpi(13) + 6); 335 | graph.DrawLine(pen, l + w - hidpi(22) + 6 + 1, t + hidpi(13) + 6, l + w - hidpi(22) + 6 + 1 + 6, t + hidpi(13)); 336 | pen.SetWidth(2); 337 | end; 338 | 339 | // Draw the caption 340 | stringFormat := TGPStringFormat.Create; 341 | try 342 | stringFormat.SetAlignment(StringAlignmentNear); 343 | stringFormat.SetLineAlignment(StringAlignmentCenter); 344 | stringFormat.SetTrimming(StringTrimmingEllipsisCharacter); 345 | stringFormat.SetFormatFlags(StringFormatFlagsNoWrap); 346 | 347 | brush.SetColor(MakeGDIPColor($BBBBBB)); 348 | graph.SetTextRenderingHint(TextRenderingHintAntiAliasGridFit); 349 | txt := _caption; 350 | graph.DrawString(txt, Length(txt), xfont, MakePoint(15.0 * ScaleFactor, (Height / 2 - hidpi(_font.Size)) * ScaleFactor + hidpi(_font.size div 3)), nil, brush); 351 | 352 | graph.SetTextRenderingHint(TextRenderingHintSingleBitPerPixelGridFit); 353 | if SystemUsesLightTheme then 354 | brush.SetColor(MakeGDIPColor($333333)) 355 | else 356 | brush.SetColor(MakeGDIPColor($FFFFFF)); 357 | 358 | if SystemUsesLightTheme then 359 | graph.DrawString(txt, Length(txt), xfont, MakePoint(15.0 * ScaleFactor, (Height / 2 - _font.Size) * ScaleFactor), nil, brush); 360 | finally 361 | stringFormat.Free; 362 | end; 363 | finally 364 | pen.Free; 365 | end; 366 | finally 367 | brush.Free; 368 | end; 369 | finally 370 | xfont.Free; 371 | end; 372 | finally 373 | graph.Free; 374 | end; 375 | 376 | Canvas.Draw(0, 0, bmp); 377 | finally 378 | bmp.Free; 379 | end; 380 | end; 381 | 382 | 383 | procedure TXCombobox.SetCaption(Value: string); 384 | begin 385 | _caption := Value; 386 | Paint; 387 | end; 388 | 389 | procedure TXCombobox.SetCheckState(Value: Boolean); 390 | begin 391 | _chkstate := Value; 392 | Paint; 393 | end; 394 | 395 | procedure TXCombobox.SetDisabledColor(Value: TColor); 396 | begin 397 | _disabledColor := Value; 398 | Paint; 399 | end; 400 | 401 | procedure TXCombobox.SetEnabled(Value: Boolean); 402 | begin 403 | _enabled := Value; 404 | Paint; 405 | end; 406 | 407 | procedure TXCombobox.SetEnabledColor(Value: TColor); 408 | begin 409 | _enabledColor := Value; 410 | Paint; 411 | end; 412 | 413 | procedure TXCombobox.SetFont(Value: TFont); 414 | begin 415 | _font.Assign(Value); 416 | Invalidate; 417 | end; 418 | 419 | procedure TXCombobox.SetParent(Value: TWinControl); 420 | begin 421 | inherited; 422 | if Value <> nil then _caption := Name; 423 | 424 | end; 425 | 426 | procedure TXCombobox.SetPressedColor(Value: TColor); 427 | begin 428 | _pressedColor := Value; 429 | Paint; 430 | end; 431 | 432 | end. 433 | 434 | -------------------------------------------------------------------------------- /XCheckbox.pas: -------------------------------------------------------------------------------- 1 | { 2 | XCheckbox, mimics the Windows 10's checkbox capable of 3 | adding over an aero glass form on Delphi 4 | 5 | Author: vhanla 6 | 7 | Changelog: 8 | TODO: 9 | Add animation, and mouse drag 10 | Add touch support 11 | - 24-07-02 12 | Add TCustomLabel as optional companion 13 | (!weird that adding TLabel was detected by Kaspersky as not-a-virus:HEUR:AdWare.Win32.Generic) 14 | - 24-07-01 15 | Fix click event rushing to mouseup for bad checkstate setting 16 | - 24-06-11 17 | Fix HighDpi support to draw radius correctly 18 | Add Windows 11 style 19 | - 17-06-02 20 | Fixed vertical disabled line on HiDpi 125% or more 21 | Fixed knob ellipse relative to height ratio 22 | - 15-10-14 23 | Works as expected 24 | Added functions.pas to use custom alpha brush to draw, but it looks ugly,... butttt now is 25 | FIXED using GDIPlus mixing with custom brush to set transparency hack 26 | } 27 | unit XCheckbox; 28 | 29 | interface 30 | 31 | uses 32 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 33 | StdCtrls, PNGimage, functions, GDIPApi, GDIPobj, Types; 34 | 35 | type 36 | TLabelPosition = (lpLeft, lpRight); 37 | 38 | TXCheckBoxLabel = class(TCustomLabel) 39 | published 40 | property Caption; 41 | property Font; 42 | end; 43 | 44 | TXCheckbox = class(TGraphicControl) 45 | private 46 | FCaption : string; 47 | FDisabledColor: TColor; 48 | FEnabledColor: TColor; 49 | FPressedColor: TColor; 50 | FChecked: Boolean; 51 | FMouseHover: Boolean; 52 | FMousePressed: Boolean; 53 | 54 | FOnMouseDown: TMouseEvent; 55 | FOnMouseUp: TMouseEvent; 56 | FOnMouseLeave: TNotifyEvent; 57 | FOnClick: TNotifyEvent; 58 | 59 | FLabel: TXCheckBoxLabel; 60 | FLabeled: Boolean; 61 | FLabelPosition: TLabelPosition; 62 | FLabelSpacing: Integer; 63 | FParentColor: TColor; 64 | 65 | procedure SetDisabledColor(Value: TColor); 66 | procedure SetEnabledColor(Value: TColor); 67 | procedure SetPressedColor(Value: TColor); 68 | procedure SetCaption(Value: string); 69 | procedure SetChecked(Value: Boolean); 70 | 71 | procedure SetLabeled(Value: Boolean); 72 | procedure SetLabelPosition(Value: TLabelPosition); 73 | procedure SetLabelSpacing(Value: Integer); 74 | procedure UpdateLabelPosition; 75 | protected 76 | procedure Paint; override; 77 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; 78 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override; 79 | procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; 80 | procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; 81 | procedure Click; override; 82 | procedure SetParent(Value: TWinControl); override; 83 | procedure Resize; override; 84 | 85 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; 86 | procedure RepaintLabel; 87 | public 88 | constructor Create(AOwner: TComponent); override; 89 | destructor Destroy; override; 90 | published 91 | property Caption: string read FCaption write SetCaption; 92 | property Color: TColor read FEnabledColor write SetEnabledColor; 93 | property DisabledColor: TColor read FDisabledColor write SetDisabledColor; 94 | property PressedColor: TColor read FPressedColor write SetPressedColor; 95 | property Checked: Boolean read FChecked write SetChecked; 96 | 97 | property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; 98 | property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; 99 | property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; 100 | property OnClick: TNotifyEvent read FOnClick write FOnClick; 101 | property ShowHint; 102 | property ParentShowHint; 103 | property OnMouseMove; 104 | property Font; 105 | property Enabled; 106 | property ParentColor default False; 107 | 108 | property Labeled: Boolean read FLabeled write SetLabeled default False; 109 | property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition default lpLeft; 110 | property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3; 111 | end; 112 | 113 | procedure Register; 114 | 115 | implementation 116 | 117 | uses 118 | Math; 119 | 120 | procedure Register; 121 | begin 122 | RegisterComponents('codigobit', [TXCheckbox]); 123 | end; 124 | 125 | { Helper Functions } 126 | function DimColor(Color: TColor; DimLevel: Byte): TColor; 127 | var 128 | R, G, B: Byte; 129 | begin 130 | // Extract the red, green, and blue components from the TColor 131 | R := GetRValue(Color); 132 | G := GetGValue(Color); 133 | B := GetBValue(Color); 134 | 135 | // Reduce the brightness of each component by the DimLevel 136 | R := Max(0, R - DimLevel); 137 | G := Max(0, G - DimLevel); 138 | B := Max(0, B - DimLevel); 139 | 140 | // Combine the dimmed components back into a TColor 141 | Result := RGB(R, G, B); 142 | end; 143 | 144 | 145 | { TXCheckbox } 146 | 147 | procedure TXCheckbox.Click; 148 | begin 149 | if Assigned(FOnClick) then 150 | FOnClick(Self); 151 | 152 | end; 153 | 154 | constructor TXCheckbox.Create(AOwner: TComponent); 155 | begin 156 | inherited Create(AOwner); 157 | Width := HighDpi(44); 158 | Height := HighDpi(20); 159 | FEnabledColor := clOlive; 160 | FDisabledColor := clBlack; 161 | FPressedColor := $666666; 162 | FMouseHover := False; 163 | FMousePressed := False; 164 | Canvas.Brush.Color := clBlack; 165 | Font.Name := 'Segoe UI'; 166 | Font.Size := 10; 167 | Font.Style := []; 168 | ShowHint := False; 169 | ParentColor := False; 170 | 171 | FLabeled := False; 172 | FLabelPosition := lpLeft; 173 | FLabelSpacing := 3; 174 | end; 175 | 176 | destructor TXCheckbox.Destroy; 177 | begin 178 | if Assigned(FLabel) then 179 | FLabel.Free; 180 | 181 | inherited; 182 | end; 183 | 184 | procedure TXCheckbox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, 185 | Y: Integer); 186 | begin 187 | inherited; 188 | FMousePressed := True; 189 | if Assigned(FOnMouseDown) then 190 | FOnMouseDown(Self, Button, Shift, X, Y); 191 | Invalidate; 192 | end; 193 | 194 | procedure TXCheckbox.CMMouseEnter(var Message: TMessage); 195 | begin 196 | inherited; 197 | FMouseHover := True; 198 | Invalidate; 199 | end; 200 | 201 | procedure TXCheckbox.CMMouseLeave(var Message: TMessage); 202 | begin 203 | inherited; 204 | FMouseHover := False; 205 | FMousePressed := False; 206 | if Assigned(FOnMouseLeave) then 207 | FOnMouseLeave(Self); 208 | Invalidate; 209 | end; 210 | 211 | procedure TXCheckbox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, 212 | Y: Integer); 213 | var 214 | MousePos: TPoint; 215 | begin 216 | inherited; 217 | FMousePressed := False; 218 | 219 | if (PtInRect(ClientRect, Point(X, Y))) and (Button = mbLeft) then 220 | begin 221 | SetChecked(not FChecked); 222 | if Assigned(FLabel) then 223 | if Checked then 224 | FLabel.Font.Color := Font.Color 225 | else 226 | FLabel.Font.Color := FDisabledColor; 227 | Click; 228 | end; 229 | 230 | if Assigned(FOnMouseUp) then 231 | FOnMouseUp(Self, Button, Shift, X, Y); 232 | Invalidate; 233 | end; 234 | 235 | procedure TXCheckbox.Notification(AComponent: TComponent; 236 | Operation: TOperation); 237 | begin 238 | inherited; 239 | if (Operation = opRemove) and (AComponent = FLabel) then 240 | FLabel := nil; 241 | end; 242 | 243 | procedure TXCheckbox.Paint; 244 | function MakeGDIPColor(C: TColor; A: Integer = 255): Cardinal; 245 | var 246 | tmpRGB : TColorRef; 247 | begin 248 | tmpRGB := ColorToRGB(C); 249 | result := ((DWORD(GetBValue(tmpRGB)) shl BlueShift) or 250 | (DWORD(GetGValue(tmpRGB)) shl GreenShift) or 251 | (DWORD(GetRValue(tmpRGB)) shl RedShift) or 252 | (DWORD(A) shl AlphaShift)); 253 | end; 254 | 255 | var 256 | bmp: TBitmap; 257 | path: TGPGraphicsPath; 258 | graph: TGPGraphics; 259 | pen: TGPPen; 260 | brush: TGPSolidBrush; 261 | l,t,w,h,d,s,radio: integer; 262 | begin 263 | inherited; 264 | 265 | radio := HighDpi(42); 266 | d := radio div 2; 267 | s := d div 2; // guide for lines width 268 | 269 | bmp := TBitmap.Create; 270 | try 271 | bmp.PixelFormat := pf32bit; 272 | bmp.SetSize(Width, Height); 273 | // let's clear the canvas with the color that is used as translucent in our aero 274 | // it needs some tweaks though 275 | if TaskbarAccented then 276 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha(BlendColors(clBlack,GetAccentColor,50),200) 277 | else 278 | begin 279 | if SystemUsesLightTheme then 280 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha($dddddd,200) 281 | else 282 | begin 283 | if ParentColor then 284 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha(FParentColor,255) 285 | else 286 | begin 287 | if isWindows11 then 288 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha(BlendColors($2d2d2d, clBlack,25), 200) 289 | else 290 | bmp.Canvas.Brush.Handle := CreateSolidBrushWithAlpha($222222,200); 291 | end; 292 | end; 293 | end; 294 | bmp.Canvas.FillRect(Rect(0,0,Width,Height)); 295 | 296 | graph := TGPGraphics.Create(bmp.Canvas.Handle); 297 | try 298 | graph.SetSmoothingMode(SmoothingModeAntiAlias); 299 | 300 | l := 0; t := 0; w := Width-1; h := Height-1; 301 | path := TGPGraphicsPath.Create(); 302 | try 303 | path.AddArc(l,t,d,d,180,90); 304 | path.AddArc(l+w-d,t,d,d,270,90); 305 | path.AddArc(l+w-d,t+h-d,d,d,0,90); 306 | path.AddArc(l,t+h-d,d,d,90,90); 307 | path.CloseFigure; 308 | 309 | // let's draw 310 | brush := TGPSolidBrush.Create(MakeGDIPColor(FDisabledColor));//any color for now 311 | try 312 | if not Enabled then 313 | pen := TGPPen.Create(MakeGDIPColor(DimColor(FDisabledColor, 30))) 314 | else 315 | pen := TGPPen.Create(MakeGDIPColor(FDisabledColor),2); // any color for now 316 | try 317 | if FChecked then 318 | begin 319 | if FMouseHover then 320 | brush.SetColor(MakeGDIPColor(BlendColors(clWhite, FEnabledColor,20))) 321 | else 322 | brush.SetColor(MakeGDIPColor(FEnabledColor)); 323 | if FMousePressed then 324 | brush.SetColor(MakeGDIPColor(FPressedColor)); 325 | graph.FillPath(brush, path ); 326 | brush.SetColor(MakeGDIPColor(clWhite)); 327 | 328 | graph.FillEllipse(brush,MakeRect(Width-5-(h-10)-1,5,h-10,h-10));//white circle 329 | end 330 | else 331 | begin 332 | if FMousePressed then 333 | begin 334 | brush.SetColor(MakeGDIPColor(FPressedColor)); 335 | graph.FillPath(brush, path ); 336 | brush.SetColor(MakeGDIPColor(FDisabledColor)); 337 | end 338 | else 339 | begin 340 | if not Enabled then 341 | brush.SetColor(MakeGDIPColor(DimColor(FDisabledColor, 30))); 342 | 343 | 344 | graph.DrawArc(pen,l+1,t+1,d-2,d-2,180,90); 345 | graph.DrawLine(pen,l+s,t+1,l+w-s,t+1); 346 | graph.DrawArc(pen,l+w-d+1,t+1,d-2,d-2,270,90); 347 | graph.DrawLine(pen,l+w-1,t+s, l+w-1, t+h-s); 348 | graph.DrawArc(pen,l+w-d+1,t+h-d+1,d-2,d-2,0,90); 349 | graph.DrawArc(pen,l+1,t+h-d+1,d-2,d-2,90,90); 350 | graph.DrawLine(pen,l+s,t+h-1,l+w-s,t+h-1); 351 | graph.DrawLine(pen,l+1,t+s, l+1, t+h-s); 352 | end; 353 | 354 | graph.FillEllipse(brush,MakeRect(5,5,h-10,h-10)); 355 | end; 356 | finally 357 | pen.Free; 358 | end; 359 | finally 360 | brush.Free; 361 | end; 362 | finally 363 | path.Free; 364 | end; 365 | // 366 | if FCaption <> '' then 367 | begin 368 | end; 369 | 370 | finally 371 | graph.Free; 372 | end; 373 | canvas.Draw(0,0,bmp); 374 | finally 375 | bmp.Free; 376 | end; 377 | 378 | if not (FLabeled and Assigned(FLabel)) then 379 | begin 380 | end; 381 | end; 382 | 383 | procedure TXCheckbox.RepaintLabel; 384 | begin 385 | if Assigned(FLabel) then 386 | begin 387 | if Enabled then 388 | FLabel.Font.Color := Font.Color 389 | else 390 | FLabel.Font.Color := FDisabledColor; 391 | if not Checked then 392 | FLabel.Font.Color := FDisabledColor; 393 | 394 | FLabel.Repaint; 395 | 396 | end; 397 | end; 398 | 399 | procedure TXCheckbox.Resize; 400 | begin 401 | inherited; 402 | Invalidate; 403 | end; 404 | 405 | procedure TXCheckbox.SetCaption(Value: string); 406 | begin 407 | if FCaption <> Value then 408 | begin 409 | FCaption := Value; 410 | if Assigned(FLabel) then 411 | FLabel.Caption := Value; 412 | 413 | Invalidate; 414 | RepaintLabel; 415 | end; 416 | end; 417 | 418 | procedure TXCheckbox.SetChecked(Value: Boolean); 419 | begin 420 | if FChecked <> Value then 421 | begin 422 | FChecked := Value; 423 | Invalidate; 424 | RepaintLabel; 425 | end; 426 | end; 427 | 428 | procedure TXCheckbox.SetDisabledColor(Value: TColor); 429 | begin 430 | if FDisabledColor <> Value then 431 | begin 432 | FDisabledColor := Value; 433 | Invalidate; 434 | end; 435 | end; 436 | 437 | procedure TXCheckbox.SetEnabledColor(Value: TColor); 438 | begin 439 | if FEnabledColor <> Value then 440 | begin 441 | FEnabledColor := Value; 442 | Invalidate; 443 | RepaintLabel; 444 | end; 445 | end; 446 | 447 | procedure TXCheckbox.SetLabeled(Value: Boolean); 448 | begin 449 | if FLabeled <> Value then 450 | begin 451 | FLabeled := Value; 452 | if FLabeled then 453 | begin 454 | if not Assigned(FLabel) then 455 | begin 456 | FLabel := TXCheckBoxLabel.Create(Self); 457 | FLabel.Font := Font; 458 | if Checked then 459 | FLabel.Font.Color := Font.Color 460 | else 461 | FLabel.Font.Color := FDisabledColor; 462 | FLabel.Parent := Parent; 463 | FLabel.FreeNotification(Self); 464 | end; 465 | FLabel.Caption := FCaption; 466 | UpdateLabelPosition; 467 | end 468 | else if Assigned(FLabel) then 469 | begin 470 | FLabel.Free; 471 | FLabel := nil; 472 | end; 473 | end; 474 | end; 475 | 476 | procedure TXCheckbox.SetLabelPosition(Value: TLabelPosition); 477 | begin 478 | if FLabelPosition <> Value then 479 | begin 480 | FLabelPosition := Value; 481 | UpdateLabelPosition; 482 | end; 483 | 484 | end; 485 | 486 | procedure TXCheckbox.SetLabelSpacing(Value: Integer); 487 | begin 488 | if FLabelSpacing <> Value then 489 | begin 490 | FLabelSpacing := Value; 491 | UpdateLabelPosition; 492 | end; 493 | 494 | end; 495 | 496 | procedure TXCheckbox.SetParent(Value: TWinControl); 497 | var 498 | ParentControl: TWinControl; 499 | begin 500 | inherited; 501 | if (Value <> nil) and (FCaption = '') then 502 | FCaption := Name; 503 | if Assigned(FLabel) then 504 | FLabel.Parent := Value; 505 | RepaintLabel; 506 | 507 | // Let's get the parent color 508 | ParentControl := Value; 509 | while Assigned(ParentControl) do 510 | begin 511 | if ParentControl is TCustomForm then 512 | begin 513 | FParentColor := TCustomForm(ParentControl).Color; 514 | break; 515 | end; 516 | ParentControl := ParentControl.Parent; 517 | end; 518 | end; 519 | 520 | procedure TXCheckbox.SetPressedColor(Value: TColor); 521 | begin 522 | if FPressedColor <> Value then 523 | begin 524 | FPressedColor := Value; 525 | Invalidate; 526 | RepaintLabel; 527 | end; 528 | end; 529 | 530 | 531 | procedure TXCheckbox.UpdateLabelPosition; 532 | begin 533 | if Assigned(FLabel) then 534 | begin 535 | case FLabelPosition of 536 | lpLeft: 537 | begin 538 | FLabel.Left := Left - FLabel.Width - FLabelSpacing; 539 | FLabel.Top := Top + (Height - FLabel.Height) div 2; 540 | end; 541 | lpRight: 542 | begin 543 | FLabel.Left := Left + Width + FLabelSpacing; 544 | FLabel.Top := Top + (Height - FLabel.Height) div 2; 545 | end; 546 | end; 547 | RepaintLabel; 548 | end; 549 | end; 550 | 551 | 552 | end. 553 | 554 | -------------------------------------------------------------------------------- /frmAdvanced.pas: -------------------------------------------------------------------------------- 1 | unit frmAdvanced; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, 7 | Controls, Forms, Dialogs, StdCtrls, Spin, 8 | ExtCtrls, ShellApi, IniFiles, ComCtrls, Buttons, Menus, rkSmartTabs, XCheckbox, 9 | Tabs, attabs; 10 | 11 | const 12 | VERSION = '1.3'; 13 | 14 | type 15 | 16 | { TBitBtn = class(Buttons.TBitBtn) 17 | private 18 | procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM; 19 | procedure CNFocusChanged(var Msg: TMessage); message CM_FOCUSCHANGED; 20 | protected 21 | procedure DrawButton(const DrawItemStruct: TDrawItemStruct); virtual; 22 | end;} 23 | 24 | TfrmAdvSettings = class(TForm) 25 | Label2: TLabel; 26 | Label3: TLabel; 27 | Label4: TLabel; 28 | Label1: TLabel; 29 | Label5: TLabel; 30 | edCommand: TButtonedEdit; 31 | edParams: TButtonedEdit; 32 | cbValDelayGlobal: TComboBox; 33 | btnCancel: TButton; 34 | btnOK: TButton; 35 | chkDelayGlobal: TXCheckbox; 36 | ATTabs1: TATTabs; 37 | chkShowCount: TXCheckbox; 38 | chkFullScreen: TXCheckbox; 39 | chkDelayTopLeft: TXCheckbox; 40 | chkDelayBotLeft: TXCheckbox; 41 | chkDelayTopRight: TXCheckbox; 42 | chkDelayBotRight: TXCheckbox; 43 | chkCustom: TXCheckbox; 44 | chkHidden: TXCheckbox; 45 | Panel1: TPanel; 46 | Panel2: TPanel; 47 | cbValDelayTopLeft: TComboBox; 48 | cbValDelayBotLeft: TComboBox; 49 | cbValDelayTopRight: TComboBox; 50 | cbValDelayBotRight: TComboBox; 51 | procedure FormCreate(Sender: TObject); 52 | procedure Label4Click(Sender: TObject); 53 | procedure chkDelayGlobalClick(Sender: TObject); 54 | procedure Label5Click(Sender: TObject); 55 | procedure chkFullScreenClick(Sender: TObject); 56 | procedure FormShow(Sender: TObject); 57 | procedure edCommandChange(Sender: TObject); 58 | procedure edParamsChange(Sender: TObject); 59 | procedure chkHiddenClick(Sender: TObject); 60 | procedure FormDestroy(Sender: TObject); 61 | procedure rkSmartTabs1TabChange(Sender: TObject); 62 | procedure btnCancelClick(Sender: TObject); 63 | procedure btnOKClick(Sender: TObject); 64 | procedure ATTabs1TabClick(Sender: TObject); 65 | procedure chkDelayTopLeftClick(Sender: TObject); 66 | procedure chkDelayTopRightClick(Sender: TObject); 67 | procedure chkDelayBotLeftClick(Sender: TObject); 68 | procedure chkDelayBotRightClick(Sender: TObject); 69 | 70 | protected 71 | FBitmap: TBitmap; 72 | FBrush: HBRUSH; 73 | procedure WndProc(var Msg: TMessage); override; 74 | private 75 | { Private declarations } 76 | FCurTab: Integer; 77 | procedure Temp2Cmd; // dump changes to official 78 | procedure Cmd2Temp; // restore from temp to official cmd 79 | public 80 | { Public declarations } 81 | procedure SaveAdvancedIni; 82 | procedure ReadAdvancedIni; 83 | procedure ToggleEachCornersDelay(Enable: Boolean); 84 | end; 85 | 86 | var 87 | frmAdvSettings: TfrmAdvSettings; 88 | cmdcli: array [0..3] of string; 89 | cmdarg: array [0..3] of string; 90 | cmdhid: array [0..3] of boolean; 91 | tmpcmdcli: array [0..3] of string; 92 | tmpcmdarg: array [0..3] of string; 93 | tmpcmdhid: array [0..3] of boolean; 94 | 95 | 96 | implementation 97 | 98 | {$R *.dfm} 99 | 100 | uses frmSettings, main, functions, conditionshelper; 101 | 102 | function SetWindowTheme(hwnd: HWND; pszSubAppName: LPCWSTR; pszSubIdList: LPCWSTR): HRESULT; stdcall; 103 | external 'uxtheme.dll'; 104 | 105 | procedure TfrmAdvSettings.ATTabs1TabClick(Sender: TObject); 106 | begin 107 | FCurTab := ATTabs1.TabIndex; 108 | // caption := inttostr(curTab); 109 | edCommand.Text := tmpcmdcli[FCurTab]; 110 | edParams.Text := tmpcmdarg[FCurTab]; 111 | chkHidden.Checked := tmpcmdhid[FCurTab]; 112 | end; 113 | 114 | procedure TfrmAdvSettings.btnCancelClick(Sender: TObject); 115 | begin 116 | ReadAdvancedIni; 117 | close 118 | end; 119 | 120 | procedure TfrmAdvSettings.btnOKClick(Sender: TObject); 121 | begin 122 | SaveAdvancedIni; 123 | Close 124 | end; 125 | 126 | procedure TfrmAdvSettings.chkDelayBotLeftClick(Sender: TObject); 127 | begin 128 | cbValDelayBotLeft.Enabled := chkDelayBotLeft.Checked; 129 | end; 130 | 131 | procedure TfrmAdvSettings.chkDelayBotRightClick(Sender: TObject); 132 | begin 133 | cbValDelayBotRight.Enabled := chkDelayBotRight.Checked; 134 | end; 135 | 136 | procedure TfrmAdvSettings.chkDelayGlobalClick(Sender: TObject); 137 | begin 138 | if chkDelayGlobal.Checked then 139 | begin 140 | cbValDelayGlobal.Enabled := True; 141 | ToggleEachCornersDelay(False); 142 | end 143 | else 144 | begin 145 | cbValDelayGlobal.Enabled := False; 146 | ToggleEachCornersDelay(True); 147 | end; 148 | 149 | end; 150 | 151 | procedure TfrmAdvSettings.chkDelayTopLeftClick(Sender: TObject); 152 | begin 153 | cbValDelayTopLeft.Enabled := chkDelayTopLeft.Checked; 154 | end; 155 | 156 | procedure TfrmAdvSettings.chkDelayTopRightClick(Sender: TObject); 157 | begin 158 | cbValDelayTopRight.Enabled := chkDelayTopRight.Checked; 159 | end; 160 | 161 | procedure TfrmAdvSettings.chkFullScreenClick(Sender: TObject); 162 | begin 163 | frmMain.tmFullScreen.Checked := chkFullScreen.Checked; 164 | end; 165 | 166 | procedure TfrmAdvSettings.chkHiddenClick(Sender: TObject); 167 | begin 168 | if Sender is TXCheckBox then 169 | tmpcmdhid[FCurTab] := chkHidden.Checked; 170 | end; 171 | 172 | procedure TfrmAdvSettings.Cmd2Temp; 173 | var 174 | I : Integer; 175 | begin 176 | for I := 0 to 3 do 177 | begin 178 | tmpcmdcli[I] := cmdcli[I]; 179 | tmpcmdarg[I] := cmdarg[I]; 180 | tmpcmdhid[I] := cmdhid[I]; 181 | end; 182 | end; 183 | 184 | 185 | procedure TfrmAdvSettings.edCommandChange(Sender: TObject); 186 | begin 187 | if Sender is TButtonedEdit then 188 | tmpcmdcli[FCurTab] := edCommand.Text; 189 | end; 190 | 191 | procedure TfrmAdvSettings.edParamsChange(Sender: TObject); 192 | begin 193 | if Sender is TButtonedEdit then 194 | tmpcmdarg[FCurTab] := edParams.Text; 195 | end; 196 | 197 | 198 | procedure TfrmAdvSettings.FormCreate(Sender: TObject); 199 | begin 200 | 201 | FCurTab := 0; 202 | FBitmap := TBitmap.Create; 203 | FBitmap.SetSize(64,64); 204 | FBitmap.PixelFormat := pf24bit; 205 | FBitmap.Canvas.Brush.Style := bsSolid; 206 | FBitmap.Canvas.Brush.Color := $2d2d2d; 207 | FBitmap.Canvas.FillRect(ClientRect); 208 | // FBitmap.LoadFromFile('T:\Program Files (x86)\Caphyon\Advanced Installer 21.0.1\themes\surface\resources\variations\metropurple\background.bmp'); 209 | FBrush := 0; 210 | FBrush := CreatePatternBrush(FBitmap.Handle); 211 | // if not SystemUsesLightTheme then 212 | // begin 213 | // AllowDarkModeForWindow(Handle, True); 214 | // AllowDarkModeForApp(True); 215 | // SetPreferredAppMode(1); 216 | // DarkMode; 217 | // end; 218 | 219 | FormStyle := fsStayOnTop; 220 | BorderStyle := bsSingle; 221 | BorderIcons := [biSystemMenu, biMinimize]; 222 | Position := poScreenCenter; 223 | cbValDelayGlobal.Enabled := False; 224 | ReadAdvancedIni; 225 | UseImmersiveDarkMode(Handle, True); 226 | // EnableNCShadow(Handle); 227 | // setwindowtheme(Edit1.Handle, 'CFD', nil); 228 | // AllowDarkModeForWindow(Edit1.Handle, True); 229 | // sendmessagew(Edit1.Handle, WM_THEMECHANGED, 0, 0); 230 | 231 | setwindowtheme(cbValDelayGlobal.Handle, 'CFD', nil); 232 | AllowDarkModeForWindow(cbValDelayGlobal.Handle, True); 233 | sendmessagew(cbValDelayGlobal.Handle, WM_THEMECHANGED, 0, 0); 234 | 235 | setwindowtheme(cbValDelayTopLeft.Handle, 'CFD', nil); 236 | AllowDarkModeForWindow(cbValDelayTopLeft.Handle, True); 237 | sendmessagew(cbValDelayTopLeft.Handle, WM_THEMECHANGED, 0, 0); 238 | 239 | setwindowtheme(cbValDelayTopRight.Handle, 'CFD', nil); 240 | AllowDarkModeForWindow(cbValDelayTopRight.Handle, True); 241 | sendmessagew(cbValDelayTopRight.Handle, WM_THEMECHANGED, 0, 0); 242 | 243 | setwindowtheme(cbValDelayBotLeft.Handle, 'CFD', nil); 244 | AllowDarkModeForWindow(cbValDelayBotLeft.Handle, True); 245 | sendmessagew(cbValDelayBotLeft.Handle, WM_THEMECHANGED, 0, 0); 246 | 247 | setwindowtheme(cbValDelayBotRight.Handle, 'CFD', nil); 248 | AllowDarkModeForWindow(cbValDelayBotRight.Handle, True); 249 | sendmessagew(cbValDelayBotRight.Handle, WM_THEMECHANGED, 0, 0); 250 | 251 | 252 | // setwindowtheme(ComboBox2.Handle, 'CFD', nil); 253 | // AllowDarkModeForWindow(ComboBox2.Handle, True); 254 | // sendmessagew(ComboBox2.Handle, WM_THEMECHANGED, 0, 0); 255 | 256 | 257 | setwindowtheme(btnOK.Handle, 'Explorer', nil); 258 | AllowDarkModeForWindow(btnOK.Handle, True); 259 | sendmessagew(btnOK.Handle, WM_THEMECHANGED, 0, 0); 260 | 261 | setwindowtheme(btnCancel.Handle, 'Explorer', nil); 262 | AllowDarkModeForWindow(btnCancel.Handle, True); 263 | sendmessagew(btnCancel.Handle, WM_THEMECHANGED, 0, 0); 264 | 265 | 266 | end; 267 | 268 | procedure TfrmAdvSettings.FormDestroy(Sender: TObject); 269 | begin 270 | FBitmap.Free; 271 | end; 272 | 273 | procedure TfrmAdvSettings.FormShow(Sender: TObject); 274 | begin 275 | // if SystemUsesLightTheme then 276 | // begin 277 | // Color := clWhite; 278 | // AllowDarkModeForWindow(Handle, False); 279 | // AllowDarkModeForApp(False); 280 | // SetPreferredAppMode(0); 281 | // DarkMode; 282 | // UseImmersiveDarkMode(Handle, False); 283 | // end 284 | // else 285 | // begin 286 | // Color := $999999; 287 | // AllowDarkModeForWindow(Handle, True); 288 | // AllowDarkModeForApp(True); 289 | // SetPreferredAppMode(1); 290 | // DarkMode; 291 | // UseImmersiveDarkMode(Handle, True); 292 | // end; 293 | 294 | end; 295 | 296 | procedure TfrmAdvSettings.Label4Click(Sender: TObject); 297 | begin 298 | ShellExecute(Handle, 'OPEN', 'http://apps.codigobit.info/p/support.html','','',SW_SHOWNORMAL); 299 | end; 300 | 301 | procedure TfrmAdvSettings.Label5Click(Sender: TObject); 302 | var 303 | // jValue: TJSonValue; 304 | rversion: String; 305 | begin 306 | ShellExecute(0, 'OPEN', PChar('https://github.com/vhanla/winxcorners/releases'), nil, nil, SW_SHOWNORMAL); 307 | // ShowMessage(IntToStr(Windows.GetWindowTextLength(GetForegroundWindow))); 308 | { RESTClient1.BaseURL := 'https://updates.codigobit.net/app/winxcorners'; 309 | RESTRequest1.Execute; 310 | try 311 | jValue := RESTResponse1.JSONValue; 312 | if Assigned(jValue) then 313 | begin 314 | rversion := jValue.GetValue('latestversion', '1.2'); 315 | if rversion = VERSION then 316 | MessageDlg('You have the latest version.', mtInformation, [mbOK],0) 317 | else 318 | MessageDlg('', mtInformation, [mbOK],0); 319 | end 320 | else 321 | MessageDlg('Couldn''t retrieve info. Please visit official page.', mtError, [mbOK],0); 322 | except 323 | MessageDlg('Error', mtInformation, [mbOK],0); 324 | end;} 325 | end; 326 | 327 | procedure TfrmAdvSettings.ReadAdvancedIni; 328 | var 329 | ini: TIniFile; 330 | begin 331 | ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'settings.ini'); 332 | try 333 | chkDelayGlobal.Checked := ini.ReadBool('Advanced','GlobalDelay',False); 334 | cbValDelayGlobal.ItemIndex := ini.ReadInteger('Advanced','GlobalDelayVal', 3); 335 | 336 | chkDelayTopLeft.Checked := ini.ReadBool('Advanced','TopLeftDelay', False); 337 | cbValDelayTopLeft.ItemIndex := ini.ReadInteger('Advanced','TopLeftVal', 3); 338 | chkDelayTopRight.Checked := ini.ReadBool('Advanced','TopRightDelay', False); 339 | cbValDelayTopRight.ItemIndex := ini.ReadInteger('Advanced','TopRightDelayVal', 3); 340 | chkDelayBotLeft.Checked := ini.ReadBool('Advanced','BotLeftDelay', False); 341 | cbValDelayBotLeft.ItemIndex := ini.ReadInteger('Advanced','BotLeftDelayVal', 3); 342 | chkDelayBotRight.Checked := ini.ReadBool('Advanced','BotRightDelay', False); 343 | cbValDelayBotRight.ItemIndex := ini.ReadInteger('Advanced','BotRightDelayVal', 3); 344 | 345 | ToggleEachCornersDelay(not chkDelayGlobal.Checked); 346 | 347 | chkShowCount.Checked := ini.ReadBool('Advanced', 'ShowCountDown', False); 348 | 349 | chkCustom.Checked := ini.ReadBool('Advanced', 'CustomCommand', False); 350 | frmTrayPopup.XPopupMenu.Items[6].Visible := chkCustom.Checked; 351 | frmTrayPopup.XPopupMenu.Items[7].Visible := chkCustom.Checked; 352 | frmTrayPopup.XPopupMenu.Items[8].Visible := chkCustom.Checked; 353 | frmTrayPopup.XPopupMenu.Items[9].Visible := chkCustom.Checked; 354 | frmTrayPopup.UpdateXCombos; 355 | 356 | cmdcli[0] := ini.ReadString('Advanced', 'CustomCommandline', ''); 357 | cmdarg[0] := ini.ReadString('Advanced', 'CustomCommandparms', ''); 358 | cmdhid[0] := ini.ReadBool('Advanced', 'CustomCommandHidden', False); 359 | 360 | cmdcli[1] := ini.ReadString('Advanced', 'CustomCommandline2', ''); 361 | cmdarg[1] := ini.ReadString('Advanced', 'CustomCommandparms2', ''); 362 | cmdhid[1] := ini.ReadBool('Advanced', 'CustomCommandHidden2', False); 363 | 364 | cmdcli[2] := ini.ReadString('Advanced', 'CustomCommandline3', ''); 365 | cmdarg[2] := ini.ReadString('Advanced', 'CustomCommandparms3', ''); 366 | cmdhid[2] := ini.ReadBool('Advanced', 'CustomCommandHidden3', False); 367 | 368 | cmdcli[3] := ini.ReadString('Advanced', 'CustomCommandline4', ''); 369 | cmdarg[3] := ini.ReadString('Advanced', 'CustomCommandparms4', ''); 370 | cmdhid[3] := ini.ReadBool('Advanced', 'CustomCommandHidden4', False); 371 | 372 | // clone values 373 | cmd2temp; 374 | 375 | edCommand.Text := cmdcli[FCurTab]; 376 | edParams.Text := cmdarg[FCurTab]; 377 | chkHidden.Checked := cmdhid[FCurTab]; 378 | 379 | chkFullScreen.Checked := ini.ReadBool('Advanced', 'IgnoreFullScreen', True); 380 | frmMain.tmFullScreen.Checked := chkFullScreen.Checked; 381 | finally 382 | ini.Free; 383 | end; 384 | end; 385 | 386 | procedure TfrmAdvSettings.rkSmartTabs1TabChange(Sender: TObject); 387 | var 388 | curTab: Integer; 389 | begin 390 | // 391 | // curTab := rkSmartTabs1.ActiveTab; 392 | caption := inttostr(curTab); 393 | edCommand.Text := tmpcmdcli[curTab]; 394 | edParams.Text := tmpcmdarg[curTab]; 395 | chkHidden.Checked := tmpcmdhid[curTab]; 396 | end; 397 | 398 | procedure TfrmAdvSettings.SaveAdvancedIni; 399 | var 400 | ini: TIniFile; 401 | begin 402 | ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'settings.ini'); 403 | try 404 | ini.WriteBool('Advanced','GlobalDelay',chkDelayGlobal.Checked); 405 | ini.WriteInteger('Advanced','GlobalDelayVal', cbValDelayGlobal.ItemIndex); 406 | 407 | ini.WriteBool('Advanced','TopLeftDelay',chkDelayTopLeft.Checked); 408 | ini.WriteInteger('Advanced','TopLeftVal', cbValDelayTopLeft.ItemIndex); 409 | ini.WriteBool('Advanced','TopRightDelay',chkDelayTopRight.Checked); 410 | ini.WriteInteger('Advanced','TopRightDelayVal', cbValDelayTopRight.ItemIndex); 411 | ini.WriteBool('Advanced','BotLeftDelay',chkDelayBotLeft.Checked); 412 | ini.WriteInteger('Advanced','BotLeftDelayVal', cbValDelayBotLeft.ItemIndex); 413 | ini.WriteBool('Advanced','BotRightDelay',chkDelayBotRight.Checked); 414 | ini.WriteInteger('Advanced','BotRightDelayVal', cbValDelayBotRight.ItemIndex); 415 | 416 | ini.WriteBool('Advanced', 'ShowCountDown', chkShowCount.Checked); 417 | 418 | ini.WriteBool('Advanced', 'CustomCommand', chkCustom.Checked); 419 | frmTrayPopup.XPopupMenu.Items[6].Visible := chkCustom.Checked; 420 | frmTrayPopup.XPopupMenu.Items[7].Visible := chkCustom.Checked; 421 | frmTrayPopup.XPopupMenu.Items[8].Visible := chkCustom.Checked; 422 | frmTrayPopup.XPopupMenu.Items[9].Visible := chkCustom.Checked; 423 | frmTrayPopup.UpdateXCombos; 424 | 425 | temp2cmd; // accept all the changes to commands 426 | 427 | ini.WriteString('Advanced', 'CustomCommandline', cmdcli[0]); 428 | ini.WriteString('Advanced', 'CustomCommandparms', cmdarg[0]); 429 | ini.WriteBool('Advanced', 'CustomCommandHidden', cmdhid[0]); 430 | 431 | ini.WriteString('Advanced', 'CustomCommandline2', cmdcli[1]); 432 | ini.WriteString('Advanced', 'CustomCommandparms2', cmdarg[1]); 433 | ini.WriteBool('Advanced', 'CustomCommandHidden2', cmdhid[1]); 434 | 435 | ini.WriteString('Advanced', 'CustomCommandline3', cmdcli[2]); 436 | ini.WriteString('Advanced', 'CustomCommandparms3', cmdarg[2]); 437 | ini.WriteBool('Advanced', 'CustomCommandHidden3', cmdhid[2]); 438 | 439 | ini.WriteString('Advanced', 'CustomCommandline4', cmdcli[3]); 440 | ini.WriteString('Advanced', 'CustomCommandparms4', cmdarg[3]); 441 | ini.WriteBool('Advanced', 'CustomCommandHidden4', cmdhid[3]); 442 | 443 | 444 | ini.WriteBool('Advanced', 'IgnoreFullScreen', chkFullScreen.Checked); 445 | frmMain.tmFullScreen.Checked := chkFullScreen.Checked; 446 | finally 447 | ini.Free; 448 | end; 449 | end; 450 | 451 | 452 | 453 | procedure TfrmAdvSettings.Temp2Cmd; 454 | var 455 | I : Integer; 456 | begin 457 | for I := 0 to 3 do 458 | begin 459 | cmdcli[I] := tmpcmdcli[I]; 460 | cmdarg[I] := tmpcmdarg[I]; 461 | cmdhid[I] := tmpcmdhid[I]; 462 | end; 463 | end; 464 | 465 | procedure TfrmAdvSettings.ToggleEachCornersDelay(Enable: Boolean); 466 | begin 467 | if Enable then 468 | begin 469 | chkDelayTopLeft.Enabled := True; 470 | cbValDelayTopLeft.Enabled := chkDelayTopLeft.Checked; 471 | 472 | chkDelayTopRight.Enabled := True; 473 | cbValDelayTopRight.Enabled := chkDelayTopRight.Checked; 474 | 475 | chkDelayBotLeft.Enabled := True; 476 | cbValDelayBotLeft.Enabled := chkDelayBotLeft.Checked; 477 | 478 | chkDelayBotRight.Enabled := True; 479 | cbValDelayBotRight.Enabled := chkDelayBotRight.Checked; 480 | end 481 | else 482 | begin 483 | chkDelayTopLeft.Enabled := False; 484 | chkDelayTopLeft.Checked := False; 485 | cbValDelayTopLeft.Enabled := False; 486 | 487 | chkDelayTopRight.Enabled := False; 488 | chkDelayTopRight.Checked := False; 489 | cbValDelayTopRight.Enabled := False; 490 | 491 | chkDelayBotLeft.Enabled := False; 492 | chkDelayBotLeft.Checked := False; 493 | cbValDelayBotLeft.Enabled := False; 494 | 495 | chkDelayBotRight.Enabled := False; 496 | chkDelayBotRight.Checked := False; 497 | cbValDelayBotRight.Enabled := False; 498 | end; 499 | 500 | end; 501 | 502 | procedure TfrmAdvSettings.WndProc(var Msg: TMessage); 503 | begin 504 | inherited; 505 | 506 | case Msg.Msg of 507 | WM_CTLCOLOREDIT, WM_CTLCOLORSTATIC: 508 | begin 509 | if ((Msg.LParam = edCommand.Handle) or (Msg.LParam = edParams.Handle) ) and (FBrush <> 0) then 510 | begin 511 | SetBkMode(Msg.WParam, TRANSPARENT); 512 | Msg.Result := FBrush; 513 | end; 514 | end; 515 | end; 516 | end; 517 | 518 | {procedure TfrmAdvSettings.XCheckbox1Click(Sender: TObject); 519 | begin 520 | 521 | end; 522 | 523 | TBitBtn } 524 | 525 | {procedure TBitBtn.CNDrawItem(var Msg: TWMDrawItem); 526 | begin 527 | DrawButton(Msg.DrawItemStruct^); 528 | Msg.Result := Integer(True); 529 | end; 530 | 531 | procedure TBitBtn.CNFocusChanged(var Msg: TMessage); 532 | begin 533 | inherited; 534 | Invalidate; 535 | end; 536 | 537 | procedure TBitBtn.DrawButton(const DrawItemStruct: TDrawItemStruct); 538 | var 539 | Canvas: TCanvas; 540 | begin 541 | Canvas := TCanvas.Create; 542 | try 543 | Canvas.Handle := DrawItemStruct.hDC; 544 | 545 | Canvas.Brush.Style := bsSolid; 546 | Canvas.Brush.Color := $2d2d2d; 547 | Canvas.Rectangle(ClientRect); 548 | Canvas.Brush.Style := bsClear; 549 | Canvas.Font.Assign(Font); 550 | Canvas.TextRect(ClientRect, 12,10,Self.Caption);//, [tfVerticalCenter, tfCenter, tfSingleLine]); 551 | finally 552 | // ReleaseDC(Canvas.Handle); 553 | Canvas.Handle := 0; 554 | Canvas.Free; 555 | end; 556 | end;} 557 | 558 | 559 | 560 | end. 561 | 562 | -------------------------------------------------------------------------------- /thirparty/DwmApi.pas: -------------------------------------------------------------------------------- 1 | {*******************************************************} 2 | { } 3 | { Delphi Runtime Library } 4 | { } 5 | { File: dwmapi.h } 6 | { Copyright (c) Microsoft Corporation } 7 | { All Rights Reserved. } 8 | { } 9 | { Translator: Embarcadero Technologies, Inc. } 10 | { Copyright(c) 1995-2010 Embarcadero Technologies, Inc. } 11 | { } 12 | {*******************************************************} 13 | 14 | 15 | {*******************************************************} 16 | { Win32 API Desktop Window Manager Interface Unit } 17 | {*******************************************************} 18 | 19 | unit Dwmapi; 20 | 21 | {$WEAKPACKAGEUNIT} 22 | 23 | {$HPPEMIT ''} 24 | {$HPPEMIT '#include "dwmapi.h"'} 25 | {$HPPEMIT '#pragma link "dwmapi.lib"'} 26 | {$HPPEMIT ''} 27 | 28 | interface 29 | 30 | uses Windows, Uxtheme; 31 | 32 | const 33 | // Blur behind data structures 34 | DWM_BB_ENABLE = $00000001; // fEnable has been specified 35 | {$EXTERNALSYM DWM_BB_ENABLE} 36 | DWM_BB_BLURREGION = $00000002; // hRgnBlur has been specified 37 | {$EXTERNALSYM DWM_BB_BLURREGION} 38 | DWM_BB_TRANSITIONONMAXIMIZED = $00000004; // fTransitionOnMaximized has been specified 39 | {$EXTERNALSYM DWM_BB_TRANSITIONONMAXIMIZED} 40 | 41 | type 42 | PDWM_BLURBEHIND = ^DWM_BLURBEHIND; 43 | DWM_BLURBEHIND = record 44 | dwFlags: DWORD; 45 | fEnable: BOOL; 46 | hRgnBlur: HRGN; 47 | fTransitionOnMaximized: BOOL; 48 | end; 49 | _DWM_BLURBEHIND = DWM_BLURBEHIND; 50 | TDwmBlurBehind = DWM_BLURBEHIND; 51 | PDwmBlurBehind = ^TDwmBlurbehind; 52 | {$EXTERNALSYM DWM_BLURBEHIND} 53 | {$EXTERNALSYM PDWM_BLURBEHIND} 54 | 55 | // Window attributes 56 | DWMWINDOWATTRIBUTE = type Integer; 57 | {$EXTERNALSYM DWMWINDOWATTRIBUTE} 58 | const 59 | DWMWA_NCRENDERING_ENABLED = 1; // [get] Is non-client rendering enabled/disabled 60 | {$EXTERNALSYM DWMWA_NCRENDERING_ENABLED} 61 | DWMWA_NCRENDERING_POLICY = 2; // [set] Non-client rendering policy 62 | {$EXTERNALSYM DWMWA_NCRENDERING_POLICY} 63 | DWMWA_TRANSITIONS_FORCEDISABLED = 3; // [set] Potentially enable/forcibly disable transitions 64 | {$EXTERNALSYM DWMWA_TRANSITIONS_FORCEDISABLED} 65 | DWMWA_ALLOW_NCPAINT = 4; // [set] Allow contents rendered in the non-client area to be visible on the DWM-drawn frame. 66 | {$EXTERNALSYM DWMWA_ALLOW_NCPAINT} 67 | DWMWA_CAPTION_BUTTON_BOUNDS = 5; // [get] Bounds of the caption button area in window-relative space. 68 | {$EXTERNALSYM DWMWA_CAPTION_BUTTON_BOUNDS} 69 | DWMWA_NONCLIENT_RTL_LAYOUT = 6; // [set] Is non-client content RTL mirrored 70 | {$EXTERNALSYM DWMWA_NONCLIENT_RTL_LAYOUT} 71 | DWMWA_FORCE_ICONIC_REPRESENTATION = 7; // [set] Force this window to display iconic thumbnails. 72 | {$EXTERNALSYM DWMWA_FORCE_ICONIC_REPRESENTATION} 73 | DWMWA_FLIP3D_POLICY = 8; // [set] Designates how Flip3D will treat the window. 74 | {$EXTERNALSYM DWMWA_FLIP3D_POLICY} 75 | DWMWA_EXTENDED_FRAME_BOUNDS = 9; // [get] Gets the extended frame bounds rectangle in screen space 76 | {$EXTERNALSYM DWMWA_EXTENDED_FRAME_BOUNDS} 77 | DWMWA_HAS_ICONIC_BITMAP = 10; // [set] Indicates an available bitmap when there is no better thumbnail representation. 78 | {$EXTERNALSYM DWMWA_HAS_ICONIC_BITMAP} 79 | DWMWA_DISALLOW_PEEK = 11; // [set] Don't invoke Peek on the window. 80 | {$EXTERNALSYM DWMWA_DISALLOW_PEEK} 81 | DWMWA_EXCLUDED_FROM_PEEK = 12; // [set] LivePreview exclusion information 82 | {$EXTERNALSYM DWMWA_EXCLUDED_FROM_PEEK} 83 | DWMWA_LAST = 13; 84 | {$EXTERNALSYM DWMWA_LAST} 85 | 86 | // Non-client rendering policy attribute values 87 | {$EXTERNALSYM DWMNCRP_USEWINDOWSTYLE} 88 | DWMNCRP_USEWINDOWSTYLE = 0; // Enable/disable non-client rendering based on window style 89 | {$EXTERNALSYM DWMNCRP_DISABLED} 90 | DWMNCRP_DISABLED = 1; // Disabled non-client rendering; window style is ignored 91 | {$EXTERNALSYM DWMNCRP_ENABLED} 92 | DWMNCRP_ENABLED = 2; // Enabled non-client rendering; window style is ignored 93 | {$EXTERNALSYM DWMNCRP_LAST} 94 | DWMNCRP_LAST = 3; 95 | 96 | // Values designating how Flip3D treats a given window. 97 | 98 | {$EXTERNALSYM DWMFLIP3D_DEFAULT} 99 | DWMFLIP3D_DEFAULT = 0; // Hide or include the window in Flip3D based on window style and visibility. 100 | {$EXTERNALSYM DWMFLIP3D_EXCLUDEBELOW} 101 | DWMFLIP3D_EXCLUDEBELOW = 1; // Display the window under Flip3D and disabled. 102 | {$EXTERNALSYM DWMFLIP3D_EXCLUDEABOVE} 103 | DWMFLIP3D_EXCLUDEABOVE = 2; // Display the window above Flip3D and enabled. 104 | {$EXTERNALSYM DWMFLIP3D_LAST} 105 | DWMFLIP3D_LAST = 3; 106 | 107 | 108 | // Thumbnails 109 | type 110 | HTHUMBNAIL = THandle; 111 | {$EXTERNALSYM HTHUMBNAIL} 112 | PHTHUMBNAIL = ^HTHUMBNAIL; 113 | {$EXTERNALSYM PHTHUMBNAIL} 114 | 115 | const 116 | DWM_TNP_RECTDESTINATION = $00000001; 117 | {$EXTERNALSYM DWM_TNP_RECTDESTINATION} 118 | DWM_TNP_RECTSOURCE = $00000002; 119 | {$EXTERNALSYM DWM_TNP_RECTSOURCE} 120 | DWM_TNP_OPACITY = $00000004; 121 | {$EXTERNALSYM DWM_TNP_OPACITY} 122 | DWM_TNP_VISIBLE = $00000008; 123 | {$EXTERNALSYM DWM_TNP_VISIBLE} 124 | DWM_TNP_SOURCECLIENTAREAONLY = $00000010; 125 | {$EXTERNALSYM DWM_TNP_SOURCECLIENTAREAONLY} 126 | 127 | type 128 | PDWM_THUMBNAIL_PROPERTIES = ^DWM_THUMBNAIL_PROPERTIES; 129 | DWM_THUMBNAIL_PROPERTIES = record 130 | dwFlags: DWORD; 131 | rcDestination: TRect; 132 | rcSource: TRect; 133 | opacity: Byte; 134 | fVisible: BOOL; 135 | fSourceClientAreaOnly: BOOL; 136 | end; 137 | _DWM_THUMBNAIL_PROPERTIES = DWM_THUMBNAIL_PROPERTIES; 138 | TDwmThumbnailProperties = DWM_THUMBNAIL_PROPERTIES; 139 | PDwmThumbnailProperties = ^TDwmThumbnailProperties; 140 | {$EXTERNALSYM DWM_THUMBNAIL_PROPERTIES} 141 | {$EXTERNALSYM PDWM_THUMBNAIL_PROPERTIES} 142 | 143 | // Video enabling apis 144 | 145 | // DWM_FRAME_COUNT = ULONGLONG; 146 | // {$EXTERNALSYM DWM_FRAME_COUNT} 147 | // QPC_TIME = ULONGLONG; 148 | // {$EXTERNALSYM QPC_TIME} 149 | 150 | UNSIGNED_RATIO = record 151 | uiNumerator: Cardinal; 152 | uiDenominator: Cardinal; 153 | end; 154 | _UNSIGNED_RATIO = UNSIGNED_RATIO; 155 | TUnsignedRatio = UNSIGNED_RATIO; 156 | PUnsignedRatio = ^TUnsignedRatio; 157 | {$EXTERNALSYM UNSIGNED_RATIO} 158 | 159 | DWM_TIMING_INFO = record 160 | cbSize: Cardinal; 161 | 162 | // Data on DWM composition overall 163 | 164 | // Monitor refresh rate 165 | rateRefresh: TUnsignedRatio; 166 | 167 | // Actual period 168 | // qpcRefreshPeriod: QPC_TIME; 169 | 170 | // composition rate 171 | rateCompose: TUnsignedRatio; 172 | 173 | // QPC time at a VSync interupt 174 | // qpcVBlank: QPC_TIME; 175 | 176 | // DWM refresh count of the last vsync 177 | // DWM refresh count is a 64bit number where zero is 178 | // the first refresh the DWM woke up to process 179 | // cRefresh: DWM_FRAME_COUNT; 180 | 181 | // DX refresh count at the last Vsync Interupt 182 | // DX refresh count is a 32bit number with zero 183 | // being the first refresh after the card was initialized 184 | // DX increments a counter when ever a VSync ISR is processed 185 | // It is possible for DX to miss VSyncs 186 | // 187 | // There is not a fixed mapping between DX and DWM refresh counts 188 | // because the DX will rollover and may miss VSync interupts 189 | cDXRefresh: UINT; 190 | 191 | // QPC time at a compose time. 192 | // qpcCompose: QPC_TIME; 193 | 194 | // Frame number that was composed at qpcCompose 195 | // cFrame: DWM_FRAME_COUNT; 196 | 197 | // The present number DX uses to identify renderer frames 198 | cDXPresent: UINT; 199 | 200 | // Refresh count of the frame that was composed at qpcCompose 201 | // cRefreshFrame: DWM_FRAME_COUNT; 202 | 203 | 204 | // DWM frame number that was last submitted 205 | // cFrameSubmitted: DWM_FRAME_COUNT; 206 | 207 | // DX Present number that was last submitted 208 | cDXPresentSubmitted: UINT; 209 | 210 | // DWM frame number that was last confirmed presented 211 | // cFrameConfirmed: DWM_FRAME_COUNT; 212 | 213 | // DX Present number that was last confirmed presented 214 | cDXPresentConfirmed: UINT; 215 | 216 | // The target refresh count of the last 217 | // frame confirmed completed by the GPU 218 | // cRefreshConfirmed: DWM_FRAME_COUNT; 219 | 220 | // DX refresh count when the frame was confirmed presented 221 | cDXRefreshConfirmed: UINT; 222 | 223 | // Number of frames the DWM presented late 224 | // AKA Glitches 225 | // cFramesLate: DWM_FRAME_COUNT; 226 | 227 | // the number of composition frames that 228 | // have been issued but not confirmed completed 229 | cFramesOutstanding: UINT; 230 | 231 | 232 | // Following fields are only relavent when an HWND is specified 233 | // Display frame 234 | 235 | 236 | // Last frame displayed 237 | // cFrameDisplayed: DWM_FRAME_COUNT; 238 | 239 | // QPC time of the composition pass when the frame was displayed 240 | // qpcFrameDisplayed: QPC_TIME; 241 | 242 | // Count of the VSync when the frame should have become visible 243 | // cRefreshFrameDisplayed: DWM_FRAME_COUNT; 244 | 245 | // Complete frames: DX has notified the DWM that the frame is done rendering 246 | 247 | // ID of the the last frame marked complete (starts at 0) 248 | // cFrameComplete: DWM_FRAME_COUNT; 249 | 250 | // QPC time when the last frame was marked complete 251 | // qpcFrameComplete: QPC_TIME; 252 | 253 | // Pending frames: 254 | // The application has been submitted to DX but not completed by the GPU 255 | 256 | // ID of the the last frame marked pending (starts at 0) 257 | // cFramePending: DWM_FRAME_COUNT; 258 | 259 | // QPC time when the last frame was marked pending 260 | // qpcFramePending: QPC_TIME; 261 | 262 | // number of unique frames displayed 263 | // cFramesDisplayed: DWM_FRAME_COUNT; 264 | 265 | // number of new completed frames that have been received 266 | // cFramesComplete: DWM_FRAME_COUNT; 267 | 268 | // number of new frames submitted to DX but not yet complete 269 | // cFramesPending: DWM_FRAME_COUNT; 270 | 271 | // number of frames available but not displayed, used or dropped 272 | // cFramesAvailable: DWM_FRAME_COUNT; 273 | 274 | // number of rendered frames that were never 275 | // displayed because composition occured too late 276 | // cFramesDropped: DWM_FRAME_COUNT; 277 | 278 | // number of times an old frame was composed 279 | // when a new frame should have been used 280 | // but was not available 281 | // cFramesMissed: DWM_FRAME_COUNT; 282 | 283 | // the refresh at which the next frame is 284 | // scheduled to be displayed 285 | // cRefreshNextDisplayed: DWM_FRAME_COUNT; 286 | 287 | // the refresh at which the next DX present is 288 | // scheduled to be displayed 289 | // cRefreshNextPresented: DWM_FRAME_COUNT; 290 | 291 | // The total number of refreshes worth of content 292 | // for this HWND that have been displayed by the DWM 293 | // since DwmSetPresentParameters was called 294 | // cRefreshesDisplayed: DWM_FRAME_COUNT; 295 | 296 | // The total number of refreshes worth of content 297 | // that have been presented by the application 298 | // since DwmSetPresentParameters was called 299 | // cRefreshesPresented: DWM_FRAME_COUNT; 300 | 301 | 302 | // The actual refresh # when content for this 303 | // window started to be displayed 304 | // it may be different than that requested 305 | // DwmSetPresentParameters 306 | // cRefreshStarted: DWM_FRAME_COUNT; 307 | 308 | // Total number of pixels DX redirected 309 | // to the DWM. 310 | // If Queueing is used the full buffer 311 | // is transfered on each present. 312 | // If not queuing it is possible only 313 | // a dirty region is updated 314 | // cPixelsReceived: ULONGLONG; 315 | 316 | // Total number of pixels drawn. 317 | // Does not take into account if 318 | // if the window is only partial drawn 319 | // do to clipping or dirty rect management 320 | // cPixelsDrawn: ULONGLONG; 321 | 322 | // The number of buffers in the flipchain 323 | // that are empty. An application can 324 | // present that number of times and guarantee 325 | // it won't be blocked waiting for a buffer to 326 | // become empty to present to 327 | // cBuffersEmpty: DWM_FRAME_COUNT; 328 | 329 | end; 330 | _DWM_TIMING_INFO = DWM_TIMING_INFO; 331 | TDwmTimingInfo = DWM_TIMING_INFO; 332 | PDwmTimingInfo = ^TDwmTimingInfo; 333 | {$EXTERNALSYM DWM_TIMING_INFO} 334 | 335 | DWM_SOURCE_FRAME_SAMPLING = type Integer; 336 | {$EXTERNALSYM DWM_SOURCE_FRAME_SAMPLING} 337 | const 338 | // includes the first refresh of the output frame 339 | DWM_SOURCE_FRAME_SAMPLING_POINT = 0; 340 | {$EXTERNALSYM DWM_SOURCE_FRAME_SAMPLING_POINT} 341 | 342 | // use the source frame that includes the most 343 | // refreshes of out the output frame 344 | // in case of multiple source frames with the 345 | // same coverage the last will be used 346 | DWM_SOURCE_FRAME_SAMPLING_COVERAGE = 1; 347 | {$EXTERNALSYM DWM_SOURCE_FRAME_SAMPLING_COVERAGE} 348 | 349 | // Sentinel value 350 | DWM_SOURCE_FRAME_SAMPLING_LAST = 2; 351 | {$EXTERNALSYM DWM_SOURCE_FRAME_SAMPLING_LAST} 352 | 353 | const 354 | c_DwmMaxQueuedBuffers = 8; 355 | c_DwmMaxMonitors = 16; 356 | c_DwmMaxAdapters = 16; 357 | 358 | type 359 | DWM_PRESENT_PARAMETERS = record 360 | cbSize: Cardinal; 361 | fQueue: BOOL; 362 | // cRefreshStart: DWM_FRAME_COUNT; 363 | cBuffer: UINT; 364 | fUseSourceRate: BOOL; 365 | rateSource: TUnsignedRatio; 366 | cRefreshesPerFrame: UINT; 367 | eSampling: DWM_SOURCE_FRAME_SAMPLING; 368 | end; 369 | _DWM_PRESENT_PARAMETERS = DWM_PRESENT_PARAMETERS; 370 | TDwmPresentParameters = DWM_PRESENT_PARAMETERS; 371 | PDwmPresentParameters = ^TDwmPresentParameters; 372 | {$EXTERNALSYM DWM_PRESENT_PARAMETERS} 373 | 374 | 375 | 376 | const 377 | DWM_FRAME_DURATION_DEFAULT = -1; 378 | {$EXTERNALSYM DWM_FRAME_DURATION_DEFAULT} 379 | 380 | function DwmDefWindowProc(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; 381 | var plResult: LRESULT): BOOL; stdcall; 382 | {$EXTERNALSYM DwmDefWindowProc} 383 | 384 | function DwmEnableBlurBehindWindow(hWnd: HWND; 385 | var pBlurBehind: TDwmBlurbehind): HResult; stdcall; 386 | {$EXTERNALSYM DwmEnableBlurBehindWindow} 387 | 388 | const 389 | DWM_EC_DISABLECOMPOSITION = 0; 390 | {$EXTERNALSYM DWM_EC_DISABLECOMPOSITION} 391 | DWM_EC_ENABLECOMPOSITION = 1; 392 | {$EXTERNALSYM DWM_EC_ENABLECOMPOSITION} 393 | 394 | 395 | function DwmEnableComposition(uCompositionAction: UINT): HResult; stdcall; 396 | {$EXTERNALSYM DwmEnableComposition} 397 | 398 | function DwmEnableMMCSS(fEnableMMCSS: BOOL): HResult; stdcall; 399 | {$EXTERNALSYM DwmEnableMMCSS} 400 | 401 | function DwmExtendFrameIntoClientArea(hWnd: HWND; const pMarInset: TMargins): HResult; stdcall; 402 | {$EXTERNALSYM DwmExtendFrameIntoClientArea} 403 | 404 | function DwmGetColorizationColor(var pcrColorization: DWORD; 405 | var pfOpaqueBlend: BOOL): HResult; stdcall; 406 | {$EXTERNALSYM DwmGetColorizationColor} 407 | 408 | function DwmGetCompositionTimingInfo(hwnd: HWND; 409 | var pTimingInfo: TDwmTimingInfo): HResult; stdcall; 410 | {$EXTERNALSYM DwmGetCompositionTimingInfo} 411 | 412 | 413 | function DwmGetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; 414 | pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; 415 | {$EXTERNALSYM DwmGetWindowAttribute} 416 | 417 | {$EXTERNALSYM DwmIsCompositionEnabled} 418 | function DwmIsCompositionEnabled(var pfEnabled: BOOL): HResult; stdcall; 419 | 420 | function DwmModifyPreviousDxFrameDuration(hwnd: HWND; cRefreshes: Integer; 421 | fRelative: BOOL): HResult; stdcall; 422 | {$EXTERNALSYM DwmModifyPreviousDxFrameDuration} 423 | 424 | function DwmQueryThumbnailSourceSize(hThumbnail: HTHUMBNAIL; 425 | pSize: PSIZE): HResult; stdcall; 426 | {$EXTERNALSYM DwmQueryThumbnailSourceSize} 427 | 428 | function DwmRegisterThumbnail(hwndDestination: HWND; hwndSource: HWND; 429 | phThumbnailId: PHTHUMBNAIL): HResult; stdcall; 430 | {$EXTERNALSYM DwmRegisterThumbnail} 431 | 432 | function DwmSetDxFrameDuration(hwnd: HWND; cRefreshes: Integer): HResult; stdcall; 433 | {$EXTERNALSYM DwmSetDxFrameDuration} 434 | 435 | function DwmSetPresentParameters(hwnd: HWND; 436 | var pPresentParams: TDwmPresentParameters): HResult; stdcall; 437 | {$EXTERNALSYM DwmSetPresentParameters} 438 | 439 | function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; 440 | pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; 441 | {$EXTERNALSYM DwmSetWindowAttribute} 442 | 443 | function DwmUnregisterThumbnail(hThumbnailId: HTHUMBNAIL): HResult; stdcall; 444 | {$EXTERNALSYM DwmUnregisterThumbnail} 445 | 446 | function DwmUpdateThumbnailProperties(hThumbnailId: HTHUMBNAIL; 447 | var ptnProperties: TDwmThumbnailProperties): HResult; stdcall; 448 | {$EXTERNALSYM DwmUpdateThumbnailProperties} 449 | 450 | const 451 | DWM_SIT_DISPLAYFRAME = $00000001; // Display a window frame around the provided bitmap 452 | {$EXTERNALSYM DWM_SIT_DISPLAYFRAME} 453 | 454 | function DwmSetIconicThumbnail(hwnd: HWND; hbmp: HBITMAP; 455 | dwSITFlags: DWORD): HResult; stdcall; 456 | {$EXTERNALSYM DwmSetIconicThumbnail} 457 | 458 | function DwmSetIconicLivePreviewBitmap(hwnd: HWND; hbmp: HBITMAP; 459 | var pptClient: TPoint; dwSITFlags: DWORD): HResult; stdcall; 460 | {$EXTERNALSYM DwmSetIconicLivePreviewBitmap} 461 | 462 | function DwmInvalidateIconicBitmaps(hwnd: HWND): HResult; stdcall; 463 | {$EXTERNALSYM DwmInvalidateIconicBitmaps} 464 | 465 | function DwmAttachMilContent(hwnd: HWND): HResult; stdcall; 466 | {$EXTERNALSYM DwmAttachMilContent} 467 | 468 | function DwmDetachMilContent(hwnd: HWND): HResult; stdcall; 469 | {$EXTERNALSYM DwmDetachMilContent} 470 | 471 | function DwmFlush: HResult; stdcall; 472 | {$EXTERNALSYM DwmFlush} 473 | 474 | type 475 | MilMatrix3x2D = record 476 | S_11: Double; 477 | S_12: Double; 478 | S_21: Double; 479 | S_22: Double; 480 | DX: Double; 481 | DY: Double; 482 | end; 483 | _MilMatrix3x2D = MilMatrix3x2D; 484 | TMilMatrix3x2D = MilMatrix3x2D; 485 | PMilMatrix3x2D = ^TMilMatrix3x2D; 486 | {$EXTERNALSYM MilMatrix3x2D} 487 | 488 | // Compatibility for Vista dwm api. 489 | MIL_MATRIX3X2D = MilMatrix3x2D; 490 | {$EXTERNALSYM MIL_MATRIX3X2D} 491 | 492 | function DwmGetGraphicsStreamTransformHint(uIndex: UINT; 493 | var pTransform: TMilMatrix3x2D): HResult; 494 | {$EXTERNALSYM DwmGetGraphicsStreamTransformHint} 495 | 496 | function DwmGetGraphicsStreamClient(uIndex: UINT; 497 | var pClientUuid: TGUID): HResult; 498 | {$EXTERNALSYM DwmGetGraphicsStreamClient} 499 | 500 | function DwmGetTransportAttributes(var pfIsRemoting: BOOL; 501 | var pfIsConnected: BOOL; var pDwGeneration: DWORD): HResult; 502 | {$EXTERNALSYM DwmGetTransportAttributes} 503 | 504 | function DwmCompositionEnabled: Boolean; 505 | 506 | implementation 507 | 508 | uses 509 | SysUtils; 510 | 511 | const 512 | ModName = 'DWMAPI.DLL'; 513 | 514 | function DwmDefWindowProc; external ModName name 'DwmDefWindowProc'; 515 | function DwmEnableBlurBehindWindow; external ModName name 'DwmEnableBlurBehindWindow'; 516 | function DwmEnableComposition; external ModName name 'DwmEnableComposition'; 517 | function DwmEnableMMCSS; external ModName name 'DwmEnableMMCSS'; 518 | function DwmExtendFrameIntoClientArea; external ModName name 'DwmExtendFrameIntoClientArea'; 519 | function DwmGetColorizationColor; external ModName name 'DwmGetColorizationColor'; 520 | function DwmGetCompositionTimingInfo; external ModName name 'DwmGetCompositionTimingInfo'; 521 | function DwmGetWindowAttribute; external ModName name 'DwmGetWindowAttribute'; 522 | function DwmIsCompositionEnabled; external ModName name 'DwmIsCompositionEnabled'; 523 | function DwmModifyPreviousDxFrameDuration; external ModName name 'DwmModifyPreviousDxFrameDuration'; 524 | function DwmQueryThumbnailSourceSize; external ModName name 'DwmQueryThumbnailSourceSize'; 525 | function DwmRegisterThumbnail; external ModName name 'DwmRegisterThumbnail'; 526 | function DwmSetDxFrameDuration; external ModName name 'DwmSetDxFrameDuration'; 527 | function DwmSetPresentParameters; external ModName name 'DwmSetPresentParameters'; 528 | function DwmSetWindowAttribute; external ModName name 'DwmSetWindowAttribute'; 529 | function DwmUnregisterThumbnail; external ModName name 'DwmUnregisterThumbnail'; 530 | function DwmUpdateThumbnailProperties; external ModName name 'DwmUpdateThumbnailProperties'; 531 | function DwmSetIconicThumbnail; external ModName name 'DwmSetIconicThumbnail'; 532 | function DwmSetIconicLivePreviewBitmap; external ModName name 'DwmSetIconicLivePreviewBitmap'; 533 | function DwmInvalidateIconicBitmaps; external ModName name 'DwmInvalidateIconicBitmaps'; 534 | function DwmAttachMilContent; external ModName name 'DwmAttachMilContent'; 535 | function DwmDetachMilContent; external ModName name 'DwmDetachMilContent'; 536 | function DwmFlush; external ModName name 'DwmFlush'; 537 | function DwmGetGraphicsStreamTransformHint; external ModName name 'DwmGetGraphicsStreamTransformHint'; 538 | function DwmGetGraphicsStreamClient; external ModName name 'DwmGetGraphicsStreamClient'; 539 | function DwmGetTransportAttributes; external ModName name 'DwmGetTransportAttributes'; 540 | 541 | function DwmCompositionEnabled: Boolean; 542 | var 543 | LEnabled: BOOL; 544 | begin 545 | Result := (Win32MajorVersion >= 6) and (DwmIsCompositionEnabled(LEnabled) = S_OK) and LEnabled; 546 | end; 547 | 548 | end. 549 | -------------------------------------------------------------------------------- /thirparty/AnimateEasing.pas: -------------------------------------------------------------------------------- 1 | { 2 | AnimateEasing v1.0.1.0 3 | 4 | Developed by Norbert Mereg 5 | 6 | Description: 7 | This component is an easing animation value calculator. 8 | 9 | Features: 10 | - 28 different easing style (in, out, in-out) 11 | 12 | 13 | History: 14 | v1.0.1 2010.06.14 - Added comment to methods 15 | v1.0.0 2010.05.14 - First release. 16 | } 17 | unit AnimateEasing; 18 | 19 | interface 20 | 21 | uses 22 | SysUtils, DateUtils, Math, Classes, StdCtrls, ExtCtrls; 23 | 24 | type 25 | TEasingFunction = function(p: Extended; firstNum, diff: integer): Extended of object; 26 | TAnimateTickEvent = reference to procedure(Sender: TObject; Value: Extended); 27 | TANotifyEvent = reference to procedure(Sender: TObject); 28 | 29 | TResultArray = array of Extended; 30 | 31 | TEasingType = (etBackEaseIn, etbackEaseOut, etBackEaseInOut, 32 | etBounceEaseIn, etBounceEaseOut, 33 | etCircEaseIn, etCircEaseOut, etCircEaseInOut, 34 | etCubicEaseIn, etCubicEaseOut, etCubicEaseInOut, 35 | etElasticEaseIn, etElasticEaseOut, 36 | etExpoEaseIn, etExpoEaseOut, etExpoEaseInOut, 37 | etQuadEaseIn, etQuadEaseOut, etQuadEaseInOut, 38 | etQuartEaseIn, etQuartEaseOut, etQuartEaseInOut, 39 | etQuintEaseIn, etQuintEaseOut, etQuintEaseInOut, 40 | etSineEaseIn, etSineEaseOut, etSineEaseInOut); 41 | 42 | TAnimateEasing = class(TObject) 43 | private 44 | FStartPos: integer; 45 | FAnimLength: integer; 46 | FDifferent: integer; 47 | FStartTime: TDateTime; 48 | FEasingFunc: TEasingFunction; 49 | FTimer: TTimer; 50 | FDelayTimer: TTimer; 51 | FOnTick: TAnimateTickEvent; 52 | FOnFinish: TANotifyEvent; 53 | procedure SetOnTick(const Value: TAnimateTickEvent); 54 | procedure FTimerTimer(Sender: TObject); 55 | procedure FDelayTimerTimer(Sender: TObject); 56 | procedure SetOnFinish(const Value: TANotifyEvent); 57 | procedure FinishAnim; 58 | public 59 | constructor Create; 60 | destructor Destroy; override; 61 | 62 | (* 63 | This method uses a timer to call the OnTick event with the calculated value. 64 | 65 | StartPos: The animating start value. 66 | Different: Difference between start and end position. 67 | Animlength: Full length of animation (millisecond) 68 | Easing: The animation easing type 69 | OnTickEvent: The event handler 70 | CycleTime: The timer cycle time (default 10ms) 71 | StartDelay: A delay before start the animation 72 | OnFinishEvent: The event what fire when the animation finished 73 | *) 74 | 75 | procedure Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType); overload; 76 | procedure Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType; OnTickEvent: TAnimateTickEvent; OnFinishEvent: TANotifyEvent); overload; 77 | procedure Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType; CycleTime: integer); overload; 78 | procedure Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType; CycleTime, StartDelay: integer); overload; 79 | procedure Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType; CycleTime, StartDelay: integer; OnTickEvent: TAnimateTickEvent; OnFinishEvent: TANotifyEvent); overload; 80 | 81 | procedure StopAnimating; 82 | 83 | (* This method only generate the animation values to an array 84 | 85 | Different: Difference between start and end position. 86 | StepCount: Count of values 87 | Easing: The animation easing type *) 88 | 89 | class function GenerateValues(Different, StepCount: integer; Easing: TEasingType): TResultArray; 90 | 91 | (* This method calculate the current value 92 | 93 | p: The animation phase. Values between 0 and 1. 94 | firstNum: The start values of animation 95 | diff: Difference between start and end value of animation 96 | *) 97 | class function GetEasingFunc(Easing: TEasingType): TEasingFunction; static; 98 | class function backEaseIn(p: Extended; firstNum, diff: integer): Extended; 99 | class function backEaseOut(p: Extended; firstNum, diff: integer): Extended; 100 | class function backEaseInOut(p: Extended; firstNum, diff: integer): Extended; 101 | class function bounceEaseIn(p: Extended; firstNum, diff: integer): Extended; 102 | class function bounceEaseOut(p: Extended; firstNum, diff: integer): Extended; 103 | class function circEaseIn(p: Extended; firstNum, diff: integer): Extended; 104 | class function circEaseOut(p: Extended; firstNum, diff: integer): Extended; 105 | class function circEaseInOut(p: Extended; firstNum, diff: integer): Extended; 106 | class function cubicEaseIn(p: Extended; firstNum, diff: integer): Extended; 107 | class function cubicEaseInOut(p: Extended; firstNum, diff: integer): Extended; 108 | class function cubicEaseOut(p: Extended; firstNum, diff: integer): Extended; 109 | class function elasticEaseIn(p: Extended; firstNum, diff: integer): Extended; 110 | class function elasticEaseOut(p: Extended; firstNum, diff: integer): Extended; 111 | class function expoEaseIn(p: Extended; firstNum, diff: integer): Extended; 112 | class function expoEaseOut(p: Extended; firstNum, diff: integer): Extended; 113 | class function expoEaseInOut(p: Extended; firstNum, diff: integer): Extended; 114 | class function quadEaseIn(p: Extended; firstNum, diff: integer): Extended; 115 | class function quadEaseOut(p: Extended; firstNum, diff: integer): Extended; 116 | class function quadEaseInOut(p: Extended; firstNum, diff: integer): Extended; 117 | class function quartEaseIn(p: Extended; firstNum, diff: integer): Extended; 118 | class function quartEaseOut(p: Extended; firstNum, diff: integer): Extended; 119 | class function quartEaseInOut(p: Extended; firstNum, diff: integer): Extended; 120 | class function quintEaseIn(p: Extended; firstNum, diff: integer): Extended; 121 | class function quintEaseOut(p: Extended; firstNum, diff: integer): Extended; 122 | class function quintEaseInOut(p: Extended; firstNum, diff: integer): Extended; 123 | class function sineEaseIn(p: Extended; firstNum, diff: integer): Extended; 124 | class function sineEaseOut(p: Extended; firstNum, diff: integer): Extended; 125 | class function sineEaseInOut(p: Extended; firstNum, diff: integer): Extended; 126 | published 127 | property OnTick: TAnimateTickEvent read FOnTick write SetOnTick; 128 | property OnFinish: TANotifyEvent read FOnFinish write SetOnFinish; 129 | end; 130 | 131 | 132 | implementation 133 | 134 | procedure TAnimateEasing.Animating(StartPos, Different, AnimLength: integer; Easing: TEasingType); 135 | begin 136 | Animating(StartPos, Different, AnimLength, Easing, 10, -1, nil, nil); 137 | end; 138 | 139 | procedure TAnimateEasing.Animating(StartPos, Different, AnimLength: integer; 140 | Easing: TEasingType; OnTickEvent: TAnimateTickEvent; 141 | OnFinishEvent: TANotifyEvent); 142 | begin 143 | Animating(StartPos, Different, AnimLength, Easing, 10, -1, OnTickEvent, OnFinishEvent); 144 | end; 145 | 146 | procedure TAnimateEasing.Animating(StartPos, Different, AnimLength: integer; 147 | Easing: TEasingType; CycleTime: integer); 148 | begin 149 | Animating(StartPos, Different, AnimLength, Easing, CycleTime, -1, nil, nil); 150 | end; 151 | 152 | procedure TAnimateEasing.Animating(StartPos, Different, AnimLength: integer; 153 | Easing: TEasingType; CycleTime: integer; StartDelay: integer); 154 | begin 155 | Animating(StartPos, Different, AnimLength, Easing, CycleTime, StartDelay, nil, nil); 156 | end; 157 | 158 | procedure TAnimateEasing.Animating(StartPos, Different, AnimLength: integer; 159 | Easing: TEasingType; CycleTime, StartDelay: integer; 160 | OnTickEvent: TAnimateTickEvent; OnFinishEvent: TANotifyEvent); 161 | begin 162 | FEasingFunc := GetEasingFunc(Easing); 163 | FStartPos := StartPos; 164 | FStartTime := Now; 165 | FDifferent := Different; 166 | FAnimLength := AnimLength; 167 | if Assigned(OnTickEvent) then OnTick := OnTickEvent; 168 | if Assigned(OnFinishEvent) then OnFinish := OnFinishEvent; 169 | 170 | FTimer.Enabled := false; 171 | FTimer.Interval := CycleTime; 172 | 173 | if StartDelay = -1 then 174 | FTimer.Enabled := true 175 | else 176 | begin 177 | FDelayTimer.Interval := StartDelay; 178 | FDelayTimer.Enabled := true; 179 | end; 180 | end; 181 | 182 | class function TAnimateEasing.GenerateValues(Different, StepCount: integer; 183 | Easing: TEasingType): TResultArray; 184 | var 185 | I: Integer; 186 | Value: Extended; 187 | EasingFunc: TEasingFunction; 188 | begin 189 | if StepCount = 0 then Exit; 190 | 191 | EasingFunc := GetEasingFunc(Easing); 192 | SetLength(result, StepCount); 193 | for I := 0 to StepCount - 1 do 194 | begin 195 | Value := EasingFunc(I / StepCount, 0, Different); 196 | result[I] := Value; 197 | end; 198 | end; 199 | 200 | 201 | 202 | {$REGION 'Easing functions'} 203 | 204 | class function TAnimateEasing.GetEasingFunc(Easing: TEasingType): TEasingFunction; 205 | begin 206 | case Easing of 207 | etBackEaseIn: result := BackEaseIn; 208 | etbackEaseOut: result := backEaseOut; 209 | etBackEaseInOut: result := BackEaseInOut; 210 | etBounceEaseIn: result := BounceEaseIn; 211 | etBounceEaseOut: result := BounceEaseOut; 212 | etCircEaseIn: result := CircEaseIn; 213 | etCircEaseOut: result := CircEaseOut; 214 | etCircEaseInOut: result := CircEaseInOut; 215 | etCubicEaseIn: result := CubicEaseIn; 216 | etCubicEaseOut: result := CubicEaseOut; 217 | etCubicEaseInOut: result := CubicEaseInOut; 218 | etElasticEaseIn: result := ElasticEaseIn; 219 | etElasticEaseOut: result := ElasticEaseOut; 220 | etExpoEaseIn: result := ExpoEaseIn; 221 | etExpoEaseOut: result := ExpoEaseOut; 222 | etExpoEaseInOut: result := ExpoEaseInOut; 223 | etQuadEaseIn: result := QuadEaseIn; 224 | etQuadEaseOut: result := QuadEaseOut; 225 | etQuadEaseInOut: result := QuadEaseInOut; 226 | etQuartEaseIn: result := QuartEaseIn; 227 | etQuartEaseOut: result := QuartEaseOut; 228 | etQuartEaseInOut: result := QuartEaseInOut; 229 | etQuintEaseIn: result := QuintEaseIn; 230 | etQuintEaseOut: result := QuintEaseOut; 231 | etQuintEaseInOut: result := QuintEaseInOut; 232 | etSineEaseIn: result := SineEaseIn; 233 | etSineEaseOut: result := SineEaseOut; 234 | etSineEaseInOut: result := SineEaseInOut; 235 | else 236 | result := QuartEaseInOut; 237 | end; 238 | end; 239 | 240 | class function TAnimateEasing.backEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 241 | var 242 | c, s: Extended; 243 | begin 244 | c := diff; 245 | s := 1.70158; 246 | result := c*p*p*((s+1)*p - s) + firstNum; //return c*(p/=1)*p*((s+1)*p - s) + firstNum; 247 | end; 248 | 249 | class function TAnimateEasing.backEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 250 | var 251 | c, s: Extended; 252 | begin 253 | c := diff; 254 | s := 1.70158; 255 | p := p - 1; 256 | result := c*(p*p*((s+1)*p + s) + 1) + firstNum; //return c*((p=p/1-1)*p*((s+1)*p + s) + 1) + firstNum; 257 | end; 258 | 259 | class function TAnimateEasing.backEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 260 | var 261 | c, s: Extended; 262 | begin 263 | c := diff; 264 | s := 1.70158 * 1.525; 265 | p := p / 0.5; 266 | if (p < 1) then 267 | result := c/2*(p*p*((s + 1)*p - s)) + firstNum //return c/2*(p*p*(((s*=(1.525))+1)*p - s)) + firstNum; 268 | else 269 | begin 270 | p := p - 2; 271 | result := c/2*(p*p*((s + 1)*p + s) + 2) + firstNum; //return c/2*((p-=2)*p*(((s*=(1.525))+1)*p + s) + 2) + firstNum; 272 | end; 273 | end; 274 | 275 | class function TAnimateEasing.bounceEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 276 | var 277 | c, inv: Extended; 278 | begin 279 | c := diff; 280 | inv := bounceEaseOut(1 - p, 0, diff); 281 | result := c - inv + firstNum; 282 | end; 283 | 284 | class function TAnimateEasing.bounceEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 285 | var 286 | c: Extended; 287 | begin 288 | c := diff; 289 | if ( p < 1/2.75) then 290 | result := c*(7.5625*p*p) + firstNum 291 | else if (p < 2/2.75) then 292 | begin 293 | p := p - (1.5/2.75); 294 | result := c*(7.5625*p*p + 0.75) + firstNum; 295 | end 296 | else if (p < 2.5/2.75) then 297 | begin 298 | p := p - (2.25/2.75); 299 | result := c*(7.5625*p*p + 0.9375) + firstNum; 300 | end 301 | else 302 | begin 303 | p := p - (2.625/2.75); 304 | result := c*(7.5625*p*p + 0.984375) + firstNum; 305 | end; 306 | end; 307 | 308 | class function TAnimateEasing.circEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 309 | var 310 | c: Extended; 311 | begin 312 | c := diff; 313 | result := -c * (sqrt(1 - p*p) - 1 ) + firstNum; //return -c * (Math.sqrt(1 - (p/=1)*p) - 1) + firstNum; 314 | end; 315 | 316 | class function TAnimateEasing.circEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 317 | var 318 | c: Extended; 319 | begin 320 | c := diff; 321 | p := p - 1; 322 | result := c * sqrt(1 - p*p) + firstNum; //return c * Math.sqrt(1 - (p=p/1-1)*p) + firstNum; 323 | end; 324 | 325 | class function TAnimateEasing.circEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 326 | var 327 | c: Extended; 328 | begin 329 | c := diff; 330 | p := p / 0.5; 331 | if (p < 1) then 332 | result := -c/2 * (sqrt(1 - p*p) - 1) + firstNum //return -c/2 * (Math.sqrt(1 - p*p) - 1) + firstNum; 333 | else 334 | begin 335 | p := p - 2; 336 | result := c/2 * (sqrt(1 - p*p) + 1) + firstNum //return c/2 * (Math.sqrt(1 - (p-=2)*p) + 1) + firstNum; 337 | end; 338 | end; 339 | 340 | class function TAnimateEasing.cubicEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 341 | var 342 | c: Extended; 343 | begin 344 | c := diff; 345 | result := c * (p*p*p) + firstNum; //return c*(p/=1)*p*p + firstNum; 346 | end; 347 | 348 | class function TAnimateEasing.cubicEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 349 | var 350 | c: Extended; 351 | begin 352 | // c := diff; 353 | c := diff; 354 | p := p -1; 355 | result := c * (p*p*p + 1) + firstNum; //return c*(p/=1)*p*p + firstNum; 356 | end; 357 | 358 | class function TAnimateEasing.cubicEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 359 | var 360 | c: Extended; 361 | begin 362 | c := diff; 363 | p := p / 0.5; 364 | if (p < 1) then 365 | result := c/2*p*p*p + firstNum //return c/2*p*p*p + firstNum; 366 | else 367 | begin 368 | p := p - 2; 369 | result := c/2*(p*p*p + 2) + firstNum; //return c/2*((p-=2)*p*p + 2) + firstNum; 370 | end; 371 | end; 372 | 373 | class function TAnimateEasing.elasticEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 374 | var 375 | c, period, s, amplitude: Extended; 376 | begin 377 | c := diff; 378 | 379 | if p = 0 then Exit(firstNum); 380 | if p = 1 then Exit(c); 381 | 382 | period := 0.25; 383 | amplitude := c; 384 | 385 | if (amplitude < abs(c)) then 386 | begin 387 | amplitude := c; 388 | s := period / 4; 389 | end 390 | else 391 | begin 392 | s := period/(2*PI) * Math.ArcSin(c/amplitude); 393 | end; 394 | p := p - 1; 395 | result := -(amplitude*Math.Power(2, 10*p) * sin( (p*1-s)*(2*PI)/period)) + firstNum; 396 | end; 397 | 398 | class function TAnimateEasing.elasticEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 399 | var 400 | c, period, s, amplitude: Extended; 401 | begin 402 | c := diff; 403 | 404 | if diff = 0 then Exit(c); //Divide by zero protect 405 | if p = 0 then Exit(firstNum); 406 | if p = 1 then Exit(c); 407 | 408 | period := 0.25; 409 | amplitude := c; 410 | 411 | if (amplitude < abs(c)) then 412 | begin 413 | amplitude := c; 414 | s := period / 4; 415 | end 416 | else 417 | begin 418 | s := period/(2*PI) * Math.ArcSin(c/amplitude); 419 | end; 420 | result := -(amplitude*Math.Power(2, -10*p) * sin( (p*1-s)*(2*PI)/period)) + c + firstNum; 421 | end; 422 | 423 | class function TAnimateEasing.expoEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 424 | var 425 | c: Extended; 426 | begin 427 | c := diff; 428 | 429 | if (p = 0) then 430 | result := firstNum 431 | else 432 | begin 433 | p := p - 1; 434 | result := c * Math.Power(2, 10*p) + firstNum - c * 0.001; 435 | end; 436 | end; 437 | 438 | class function TAnimateEasing.expoEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 439 | var 440 | c: Extended; 441 | begin 442 | c := diff; 443 | 444 | if (p = 1) then 445 | result := c 446 | else 447 | begin 448 | result := diff * 1.001 * (-Math.Power(2, -10*p) + 1) + firstNum; 449 | end; 450 | end; 451 | 452 | class function TAnimateEasing.expoEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 453 | var 454 | c: Extended; 455 | begin 456 | c := diff; 457 | 458 | if (p = 0) then Exit(firstNum); 459 | if (p = 1) then Exit(c); 460 | 461 | p := p / 0.5; 462 | if p < 1 then 463 | result := c/2 * Math.Power(2, 10 * (p-1)) + firstNum - c * 0.0005 464 | else 465 | begin 466 | p := p - 1; 467 | result := c/2 * 1.0005 * (-Math.Power(2, -10 * p) + 2) + firstNum; 468 | end; 469 | end; 470 | 471 | class function TAnimateEasing.quadEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 472 | var 473 | c: Extended; 474 | begin 475 | c := diff; 476 | 477 | result := c * p*p + firstNum; 478 | end; 479 | 480 | class function TAnimateEasing.quadEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 481 | var 482 | c: Extended; 483 | begin 484 | c := diff; 485 | 486 | result := -c * p*(p-2) + firstNum; 487 | end; 488 | 489 | class function TAnimateEasing.quadEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 490 | var 491 | c: Extended; 492 | begin 493 | c := diff; 494 | 495 | p := p / 0.5; 496 | if p < 1 then 497 | result := c/2*p*p + firstNum 498 | else 499 | begin 500 | p := p - 1; 501 | result := -c/2 * (p*(p-2) - 1) + firstNum; 502 | end; 503 | end; 504 | 505 | class function TAnimateEasing.quartEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 506 | var 507 | c: Extended; 508 | begin 509 | c := diff; 510 | 511 | result := c * p*p*p*p + firstNum; 512 | end; 513 | 514 | class function TAnimateEasing.quartEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 515 | var 516 | c: Extended; 517 | begin 518 | c := diff; 519 | 520 | p := p - 1; 521 | result := -c * (p*p*p*p - 1) + firstNum; 522 | end; 523 | 524 | class function TAnimateEasing.quartEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 525 | var 526 | c: Extended; 527 | begin 528 | c := diff; 529 | 530 | p := p / 0.5; 531 | if p < 1 then 532 | result := c/2*p*p*p*p + firstNum 533 | else 534 | begin 535 | p := p - 2; 536 | result := -c/2 * (p*p*p*p - 2) + firstNum; 537 | end; 538 | end; 539 | 540 | class function TAnimateEasing.quintEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 541 | var 542 | c: Extended; 543 | begin 544 | c := diff; 545 | 546 | result := c * p*p*p*p*p + firstNum; 547 | end; 548 | 549 | class function TAnimateEasing.quintEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 550 | var 551 | c: Extended; 552 | begin 553 | c := diff; 554 | 555 | p := p - 1; 556 | result := c * (p*p*p*p*p + 1) + firstNum; 557 | end; 558 | 559 | class function TAnimateEasing.quintEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 560 | var 561 | c: Extended; 562 | begin 563 | c := diff; 564 | 565 | p := p / 0.5; 566 | if p < 1 then 567 | result := c/2*p*p*p*p*p + firstNum 568 | else 569 | begin 570 | p := p - 2; 571 | result := c/2 * (p*p*p*p*p + 2) + firstNum; 572 | end; 573 | end; 574 | 575 | class function TAnimateEasing.sineEaseIn(p: Extended; firstNum: integer; diff: integer): Extended; 576 | var 577 | c: Extended; 578 | begin 579 | c := diff; 580 | 581 | result := -c * cos(p*(PI/2)) + c + firstNum; 582 | end; 583 | 584 | class function TAnimateEasing.sineEaseOut(p: Extended; firstNum: integer; diff: integer): Extended; 585 | var 586 | c: Extended; 587 | begin 588 | c := diff; 589 | 590 | result := c * sin(p*(PI/2)) + firstNum; 591 | end; 592 | 593 | class function TAnimateEasing.sineEaseInOut(p: Extended; firstNum: integer; diff: integer): Extended; 594 | var 595 | c: Extended; 596 | begin 597 | c := diff; 598 | 599 | result := -c/2 * (cos(PI*p) - 1) + firstNum; 600 | end; 601 | {$ENDREGION} 602 | 603 | constructor TAnimateEasing.Create; 604 | begin 605 | FTimer := TTimer.Create(nil); 606 | FTimer.Enabled := false; 607 | FTimer.Interval := 10; 608 | FTimer.OnTimer := FTimerTimer; 609 | 610 | FDelayTimer := TTimer.Create(nil); 611 | FDelayTimer.Enabled := false; 612 | FDelayTimer.OnTimer := FDelayTimerTimer; 613 | end; 614 | 615 | destructor TAnimateEasing.Destroy; 616 | begin 617 | FTimer.Free; 618 | FDelayTimer.Free; 619 | 620 | inherited; 621 | end; 622 | 623 | 624 | procedure TAnimateEasing.FDelayTimerTimer(Sender: TObject); 625 | begin 626 | FDelayTimer.Enabled := false; 627 | FStartTime := Now; 628 | FTimer.Enabled := true; 629 | end; 630 | 631 | procedure TAnimateEasing.FTimerTimer(Sender: TObject); 632 | var 633 | Value: Extended; 634 | begin 635 | FTimer.Enabled := false; 636 | Value := FEasingFunc(MilliSecondsBetween(FStartTime, Now) / FAnimLength, FStartPos, FDifferent); 637 | if Assigned(OnTick) then 638 | OnTick(Self, Value); 639 | 640 | if dateUtils.MilliSecondsBetween(FStartTime, Now) < FAnimLength then 641 | begin 642 | FTimer.Enabled := true; 643 | end 644 | else 645 | begin 646 | FinishAnim; 647 | end; 648 | end; 649 | 650 | procedure TAnimateEasing.FinishAnim; 651 | begin 652 | if Assigned(OnFinish) then 653 | OnFinish(Self); 654 | end; 655 | 656 | procedure TAnimateEasing.StopAnimating; 657 | begin 658 | FTimer.Enabled := false; 659 | FDelayTimer.Enabled := false; 660 | FinishAnim; 661 | end; 662 | 663 | procedure TAnimateEasing.SetOnFinish(const Value: TANotifyEvent); 664 | begin 665 | FOnFinish := Value; 666 | end; 667 | 668 | procedure TAnimateEasing.SetOnTick(const Value: TAnimateTickEvent); 669 | begin 670 | FOnTick := Value; 671 | end; 672 | 673 | end. 674 | --------------------------------------------------------------------------------