├── .assets ├── demochats.mp4 └── snapshot01.png ├── .gitignore ├── AIChatbar.dpr ├── AIChatbar.dproj ├── AIChatbar.res ├── ICON.ico ├── LICENSE ├── ProjectDefines.inc ├── README.md ├── Splash.dfm ├── Splash.pas ├── SynSearchEdit.pas ├── VirtualDesktopAPI.pas ├── VirtualDesktopManager.pas ├── focusHelper.asm ├── frameEditSite.dfm ├── frameEditSite.pas ├── frmChatWebView.dfm ├── frmChatWebView.pas ├── frmLauncher.dfm ├── frmLauncher.pas ├── frmTaskGPT.dfm ├── frmTaskGPT.pas ├── functions.pas ├── functions.rawinput.pas ├── functions.windowfocus.pas ├── menu.dfm ├── menu.pas ├── settings.dfm ├── settings.pas ├── settingsHelper.pas ├── uBrowserCard.pas ├── uBrowserFrame.dfm ├── uBrowserFrame.pas ├── uChildForm.dfm ├── uChildForm.pas └── utils.pas /.assets/demochats.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/AIChatbar/968b1ac335ff07a07a9cc029c12cafa1e76d59aa/.assets/demochats.mp4 -------------------------------------------------------------------------------- /.assets/snapshot01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/AIChatbar/968b1ac335ff07a07a9cc029c12cafa1e76d59aa/.assets/snapshot01.png -------------------------------------------------------------------------------- /.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 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /AIChatbar.dpr: -------------------------------------------------------------------------------- 1 | program AIChatbar; 2 | 3 | 4 | 5 | {$R *.dres} 6 | 7 | uses 8 | madExcept, 9 | madLinkDisAsm, 10 | madListHardware, 11 | madListProcesses, 12 | madListModules, 13 | Vcl.Forms, 14 | Windows, 15 | menu in 'menu.pas' {frmMenu}, 16 | Splash in 'Splash.pas', 17 | settings in 'settings.pas' {frmSetting}, 18 | functions in 'functions.pas', 19 | Vcl.Themes, 20 | Vcl.Styles, 21 | frmChatWebView in 'frmChatWebView.pas' {mainBrowser}, 22 | uBrowserCard in 'uBrowserCard.pas', 23 | uBrowserFrame in 'uBrowserFrame.pas' {BrowserFrame: TFrame}, 24 | uChildForm in 'uChildForm.pas', 25 | settingsHelper in 'settingsHelper.pas', 26 | frameEditSite in 'frameEditSite.pas' {Frame1: TFrame}, 27 | frmTaskGPT in 'frmTaskGPT.pas' {taskForm}, 28 | functions.rawinput in 'functions.rawinput.pas', 29 | frmLauncher in 'frmLauncher.pas' {formLauncher}, 30 | HTML2MarkDown in 'HTML2MarkDown.pas', 31 | SynSearchEdit in 'SynSearchEdit.pas', 32 | functions.windowfocus in 'functions.windowfocus.pas'; 33 | 34 | {$R *.res} 35 | 36 | begin 37 | if FindWindow('AIChatbarWnd', nil) > 0 then 38 | Exit; 39 | 40 | Application.Initialize; 41 | Application.MainFormOnTaskBar := False; 42 | TStyleManager.TrySetStyle('Windows11 Modern Dark'); 43 | Application.Title := 'AIChat'; 44 | Application.CreateForm(TfrmMenu, frmMenu); 45 | Application.CreateForm(TfrmSetting, frmSetting); 46 | Application.CreateForm(TmainBrowser, mainBrowser); 47 | Application.CreateForm(TtaskForm, taskForm); 48 | Application.CreateForm(TformLauncher, formLauncher); 49 | Application.Run; 50 | 51 | end. 52 | -------------------------------------------------------------------------------- /AIChatbar.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/AIChatbar/968b1ac335ff07a07a9cc029c12cafa1e76d59aa/AIChatbar.res -------------------------------------------------------------------------------- /ICON.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/AIChatbar/968b1ac335ff07a07a9cc029c12cafa1e76d59aa/ICON.ico -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 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 | -------------------------------------------------------------------------------- /ProjectDefines.inc: -------------------------------------------------------------------------------- 1 | {.$DEFINE EXPERIMENTAL} 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AIChatbar 2 | Get your favorite AI Chat websites in the sidebar of your Windows OS similar to Windows Copilot but also adds ChatGPT, Bard, Hugging Chat, Bing Chat, etc. 3 | 4 | You can add as many AI Chat sites, but not limited only to those sites. 5 | 6 | You can invoke them by using your custom global hotkey, so it will be in fron of your finger tips at one hotkey, ready to ask/answer. 7 | 8 | For instance, by default it is set to `Win`+`F12` hotkey, hitting that hotkey if you have any AI Chat website open, it will be shown there. 9 | 10 | ![snapshot1](https://raw.githubusercontent.com/vhanla/AIChatSidebar/main/.assets/snapshot01.png) 11 | 12 | It uses Windows 10/11's WebView2 instances to load the AI Chat bot websites showing in the sidebar, giving a look a like to Windows Copilot. 13 | 14 | Features: 15 | 16 | - [x] Show/hide sidebar on mouse move to the side area of your monitor 17 | - [x] ChatGPT 18 | - [x] Bing Chat 19 | - [x] Copilot PWA 20 | - [x] Gemini (it has Microphone and TTS included) 21 | - [x] You Chat 22 | - [x] Perplexity Labs (LLaMA) 23 | - [x] Hugging Chat 24 | - [x] Bing Image Creator (OpenAI DallE) 25 | - [x] OpenAssistant 26 | - [x] BratGPT 🤖 27 | - [x] ChatPDF 28 | - [x] Adobe Firefly 29 | - [x] DeepSeek 30 | - [x] v0dev 31 | - [x] Meta AI 32 | - [x] QwenLM AI 33 | 34 | ![imagen](https://github.com/vhanla/AIChatbar/assets/1015823/09018c19-a8d3-4595-b58d-edb45a7e4e07) 35 | 36 | Add as many AI sites your main monitor screen height allows to show. 37 | 38 | ![imagen](https://github.com/vhanla/AIChatbar/assets/1015823/c7ed2dbb-cf45-4389-94dd-f41862f54d3d) 39 | 40 | Move and/or resize the AI Chat window, it also shows the current RAM usage by all the sites. 41 | ![imagen](https://github.com/vhanla/AIChatbar/assets/1015823/d044b21a-5521-420e-9598-eb6e153270e0) 42 | 43 | Fast launcher (custom hotkey) to **query AI services** (you can use your default web browser) 44 | ![imagen](https://github.com/user-attachments/assets/4cd92cdc-af37-4f2d-bc76-7e651bbab7c6) 45 | The following direct query AI services are available: 46 | - [x] ChatGPT 47 | - [x] ChatGPT (no history) 48 | - [x] Claude AI 49 | - [x] Perplexity 50 | - [x] Hugging Chat 51 | - [x] YouChat 52 | - [x] Brave Search (bonus as this has AI search results) 53 | 54 | How does it work? 55 | It just redirects your queries to those AI chat services passing your queries. 56 | 57 | How to use: 58 | - Set up a custom Global Hot Key 59 | - Invoke it, write your questions 60 | - Alt+Space is a local shortcut to select one of those services (hit enter) 61 | - Ctrl+Enter to search in the selected AI chat service. 62 | 63 | Video demonstration: 64 | 65 | https://github.com/vhanla/AIChatSidebar/assets/1015823/ff03e1a0-9870-4bbe-aaff-34d9c1df717b 66 | 67 | 68 | Todo: 69 | - [ ] Multimonitor support 70 | - [ ] Custom style sheets support 71 | - [ ] Custom userscripts support 72 | - [x] Custom websites to add 73 | - [x] Global Hotkey for keyboard users only with Command Palette like UI to invoke them 74 | - [ ] TTS (Text To Speech) 75 | - [ ] Native (non WebView2) client for OpenAI, LLaMA, unofficial APIs too. 76 | - [ ] UIAutomation to interact with the OS Applications. 77 | -------------------------------------------------------------------------------- /Splash.dfm: -------------------------------------------------------------------------------- 1 | object FormSplash: TFormSplash 2 | Left = 192 3 | Top = 124 4 | BorderStyle = bsNone 5 | Caption = 'FormSplash' 6 | ClientHeight = 442 7 | ClientWidth = 912 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | FormStyle = fsStayOnTop 15 | Position = poScreenCenter 16 | OnClick = FormClick 17 | OnClose = FormClose 18 | OnKeyPress = FormKeyPress 19 | TextHeight = 13 20 | object TimerSplash: TTimer 21 | Interval = 4096 22 | OnTimer = TimerSplashTimer 23 | Left = 208 24 | Top = 112 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /Splash.pas: -------------------------------------------------------------------------------- 1 | unit Splash; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls, GDIPAPI, GDIpOBJ, Activex; 8 | 9 | type 10 | TFormSplash = class(TForm) 11 | TimerSplash: TTimer; 12 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 13 | procedure TimerSplashTimer(Sender: TObject); 14 | procedure FormKeyPress(Sender: TObject; var Key: Char); 15 | procedure FormClick(Sender: TObject); 16 | 17 | private 18 | { Private declarations } 19 | protected 20 | procedure WMNCHitTest(var message: TWMNCHitTest); message WM_NCHITTEST; 21 | public 22 | { Public declarations } 23 | procedure Execute; 24 | end; 25 | 26 | var 27 | FormSplash: TFormSplash; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | procedure TFormSplash.FormClose(Sender: TObject; var Action: TCloseAction); 34 | begin 35 | TimerSplash.Destroy; 36 | Action := caFree; 37 | end; 38 | 39 | procedure TFormSplash.TimerSplashTimer(Sender: TObject); 40 | begin 41 | Close; 42 | end; 43 | 44 | procedure TFormSplash.FormKeyPress(Sender: TObject; var Key: Char); 45 | begin 46 | Close; 47 | end; 48 | 49 | procedure TFormSplash.WMNCHitTest(var message: TWMNCHitTest); 50 | begin 51 | Message.Result := HTCAPTION; 52 | end; 53 | 54 | procedure PremultiplyBitmap(Bitmap: TBitmap); 55 | var 56 | Row, Col: integer; 57 | p: PRGBQuad; 58 | PreMult: array [byte, byte] of byte; 59 | begin 60 | // precalculate all possible values of a*b 61 | for Row := 0 to 255 do 62 | for Col := Row to 255 do 63 | begin 64 | PreMult[Row, Col] := Row * Col div 255; 65 | if (Row <> Col) then 66 | PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a 67 | end; 68 | 69 | for Row := 0 to Bitmap.Height - 1 do 70 | begin 71 | Col := Bitmap.Width; 72 | p := Bitmap.ScanLine[Row]; 73 | while (Col > 0) do 74 | begin 75 | p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue]; 76 | p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen]; 77 | p.rgbRed := PreMult[p.rgbReserved, p.rgbRed]; 78 | inc(p); 79 | dec(Col); 80 | end; 81 | end; 82 | end; 83 | 84 | type 85 | TFixedStreamAdapter = class(TStreamAdapter) 86 | public 87 | function Stat(out statstg: TStatStg; grfStatFlag: DWORD): HResult; 88 | override; stdcall; 89 | end; 90 | 91 | function TFixedStreamAdapter.Stat(out statstg: TStatStg; 92 | grfStatFlag: DWORD): HResult; 93 | begin 94 | Result := inherited Stat(statstg, grfStatFlag); 95 | statstg.pwcsName := nil; 96 | end; 97 | 98 | procedure TFormSplash.Execute; 99 | var 100 | Ticks: DWORD; 101 | BlendFunction: TBlendFunction; 102 | BitmapPos: TPoint; 103 | BitmapSize: TSize; 104 | exStyle: DWORD; 105 | Bitmap: TBitmap; 106 | PNGBitmap: TGPBitmap; 107 | BitmapHandle: HBITMAP; 108 | Stream: TStream; 109 | StreamAdapter: IStream; 110 | begin 111 | // Enable window layering 112 | exStyle := GetWindowLongA(Handle, GWL_EXSTYLE); 113 | if (exStyle and WS_EX_LAYERED = 0) then 114 | SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED); 115 | 116 | Bitmap := TBitmap.Create; 117 | try 118 | // Load the PNG from a resource 119 | Stream := TResourceStream.Create(HInstance, 'SPLASH', RT_RCDATA); 120 | try 121 | // Wrap the VCL stream in a COM IStream 122 | StreamAdapter := TFixedStreamAdapter.Create(Stream); 123 | try 124 | // Create and load a GDI+ bitmap from the stream 125 | PNGBitmap := TGPBitmap.Create(StreamAdapter); 126 | try 127 | // Convert the PNG to a 32 bit bitmap 128 | PNGBitmap.GetHBITMAP(MakeColor(0, 0, 0, 0), BitmapHandle); 129 | // Wrap the bitmap in a VCL TBitmap 130 | Bitmap.Handle := BitmapHandle; 131 | finally 132 | PNGBitmap.Free; 133 | end; 134 | finally 135 | StreamAdapter := nil; 136 | end; 137 | finally 138 | Stream.Free; 139 | end; 140 | 141 | ASSERT(Bitmap.PixelFormat = pf32bit, 142 | 'Wrong bitmap format - must be 32 bits/pixel'); 143 | 144 | // Perform run-time premultiplication 145 | PremultiplyBitmap(Bitmap); 146 | 147 | // Resize form to fit bitmap 148 | ClientWidth := Bitmap.Width; 149 | ClientHeight := Bitmap.Height; 150 | 151 | // Position bitmap on form 152 | BitmapPos := Point(0, 0); 153 | BitmapSize.cx := Bitmap.Width; 154 | BitmapSize.cy := Bitmap.Height; 155 | 156 | // Setup alpha blending parameters 157 | BlendFunction.BlendOp := AC_SRC_OVER; 158 | BlendFunction.BlendFlags := 0; 159 | BlendFunction.SourceConstantAlpha := 0; // Start completely transparent 160 | BlendFunction.AlphaFormat := AC_SRC_ALPHA; 161 | 162 | Show; 163 | // ... and action! 164 | Ticks := 0; 165 | while (BlendFunction.SourceConstantAlpha < 255) do 166 | begin 167 | while (Ticks = GetTickCount) do 168 | Sleep(10); // Don't fade too fast 169 | Ticks := GetTickCount; 170 | inc(BlendFunction.SourceConstantAlpha, 171 | (255 - BlendFunction.SourceConstantAlpha) div 32 + 1); // Fade in 172 | UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle, 173 | @BitmapPos, 0, @BlendFunction, ULW_ALPHA); 174 | end; 175 | finally 176 | Bitmap.Free; 177 | end; 178 | // Start timer to hide form after a short while 179 | TimerSplash.Enabled := True; 180 | end; 181 | 182 | procedure TFormSplash.FormClick(Sender: TObject); 183 | begin 184 | Close; 185 | end; 186 | 187 | end. 188 | -------------------------------------------------------------------------------- /SynSearchEdit.pas: -------------------------------------------------------------------------------- 1 | unit SynSearchEdit; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ImageCollection, 8 | Vcl.VirtualImageList, 9 | SynEdit, Clipbrd; 10 | 11 | type 12 | TSearchBoxIndicator = (sbiText, sbiAudio); 13 | 14 | TSearchTrigger = (stNone, stEnter, stCtrlEnter); 15 | TNewLineTrigger = (nlEnter, nlShiftEnter); 16 | 17 | TSearchSynEdit = class(TSynEdit) 18 | strict private 19 | class var FButtonImageCollection: TImageCollection; 20 | class constructor Create; 21 | class procedure InitButtonImageCollection; static; 22 | class destructor Destroy; 23 | private 24 | FSearchIndicator: TSearchBoxIndicator; 25 | FButtonImages: TVirtualImageList; 26 | FButtonWidth: Integer; 27 | FButtonRect: TRect; 28 | FMouseOverButton: Boolean; 29 | FButtonDown: Boolean; 30 | FOnInvokeSearch: TNotifyEvent; 31 | FExpandedHeight: Integer; 32 | FCollapsedHeight: Integer; 33 | FIsExpanded: Boolean; 34 | FSearchTrigger: TSearchTrigger; 35 | FNewLineTrigger: TNewLineTrigger; 36 | FCanvas: TCanvas; 37 | 38 | procedure SetButtonWidth(Value: Integer); 39 | procedure SetExpandedHeight(Value: Integer); 40 | procedure SetNewLineTrigger(Value: TNewLineTrigger); 41 | procedure UpdateButtonPosition; 42 | procedure SetSearchTrigger(Value: TSearchTrigger); 43 | procedure ValidateSearchTrigger(Value: TSearchTrigger); 44 | 45 | procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED; 46 | procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 47 | procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT; 48 | procedure WMNCHitTest(var Msg: TMessage); message WM_NCHITTEST; 49 | procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE; 50 | procedure WMKillFocus(var Msg: TMessage); message WM_KILLFOCUS; 51 | procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN; 52 | procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP; 53 | procedure WMLButtonDblClk(var Msg: TMessage); message WM_LBUTTONDBLCLK; 54 | procedure WMRButtonDown(var Msg: TMessage); message WM_RBUTTONDOWN; 55 | procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; 56 | 57 | procedure DoTextChanged(Sender: TObject); // New 58 | procedure UpdateEditorState; // New 59 | 60 | protected 61 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 62 | procedure LoadImages; 63 | procedure RepaintButton; 64 | procedure DrawButton(Canvas: TCanvas); virtual; 65 | procedure MouseCancel; 66 | procedure InvokeSearch; dynamic; 67 | procedure Resize; override; 68 | procedure ExpandEditor; 69 | procedure CollapseEditor; 70 | function IsNewLineAllowed(Shift: TShiftState): Boolean; 71 | property Canvas: TCanvas read FCanvas; 72 | 73 | // procedure WMPaste(var Message: TWMPaste); message WM_PASTE; 74 | // procedure WndProc(var Message: TMessage); override; 75 | public 76 | class function GetClipboardHTMLContent: string; 77 | constructor Create(AOwner: TComponent); override; 78 | destructor Destroy; override; 79 | 80 | published 81 | property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 24; 82 | property ExpandedHeight: Integer read FExpandedHeight write SetExpandedHeight default 100; 83 | property SearchTrigger: TSearchTrigger read FSearchTrigger write SetSearchTrigger default stEnter; 84 | property NewLineTrigger: TNewLineTrigger read FNewLineTrigger write SetNewLineTrigger default nlEnter; 85 | property OnInvokeSearch: TNotifyEvent read FOnInvokeSearch write FOnInvokeSearch; 86 | 87 | // inherited properties 88 | property AccessibleName; 89 | property Align; 90 | property Anchors; 91 | property DoubleBuffered; 92 | property CaseSensitive default False; 93 | property Constraints; 94 | property Color; 95 | property ActiveLineColor; 96 | property Ctl3D; 97 | property Cursor; 98 | property ParentCtl3D; 99 | property Enabled; 100 | property Font; 101 | property Height; 102 | property Name; 103 | property ParentDoubleBuffered; 104 | property ParentColor default False; 105 | property ParentFont default False; 106 | property ParentShowHint; 107 | property PopupMenu; 108 | property ShowHint; 109 | property TabOrder; 110 | property TabStop default True; 111 | property TextHint; 112 | property Visible; 113 | property Width; 114 | // inherited events 115 | property OnClick; 116 | property OnDblClick; 117 | property OnDragDrop; 118 | property OnDragOver; 119 | property OnEndDock; 120 | property OnStartDock; 121 | property OnEndDrag; 122 | property OnEnter; 123 | property OnExit; 124 | property OnKeyDown; 125 | property OnKeyPress; 126 | property OnKeyUp; 127 | property OnMouseDown; 128 | property OnMouseMove; 129 | property OnMouseUp; 130 | property OnMouseWheel; 131 | property OnMouseWheelDown; 132 | property OnMouseWheelUp; 133 | property OnStartDrag; 134 | // TCustomSynEdit properties 135 | //++ CodeFolding 136 | property CodeFolding; 137 | property UseCodeFolding; 138 | //-- CodeFolding 139 | property BookMarkOptions; 140 | property BorderStyle; 141 | property ExtraLineSpacing; 142 | property DisplayFlowControl; 143 | property FontQuality default fqClearTypeNatural; 144 | property Gutter; 145 | property HideSelection; 146 | property Highlighter; 147 | property IndentGuides; 148 | property ImeMode; 149 | property ImeName; 150 | property InsertCaret; 151 | property InsertMode; 152 | property Keystrokes; 153 | property Lines; 154 | property MaxUndo; 155 | property Options; 156 | property OverwriteCaret; 157 | property ReadOnly; 158 | property RightEdge; 159 | property RightEdgeColor; 160 | property ScrollHintColor; 161 | property ScrollHintFormat; 162 | property ScrollBars; 163 | property ScrollbarAnnotations; 164 | property SearchEngine; 165 | property SelectedColor; 166 | property TabWidth; 167 | property VisibleSpecialChars; 168 | property WantReturns; 169 | property WantTabs; 170 | property WordWrap; 171 | property WordWrapGlyph; 172 | // TCustomSynEdit events 173 | property OnChange; 174 | property OnClearBookmark; 175 | property OnCommandProcessed; 176 | property OnContextHelp; 177 | property OnContextPopup; 178 | property OnDropFiles; 179 | property OnGutterClick; 180 | property OnGutterGetText; 181 | property OnMouseCursor; 182 | property OnPaint; 183 | property OnPlaceBookmark; 184 | property OnProcessCommand; 185 | property OnProcessUserCommand; 186 | property OnReplaceText; 187 | property OnShowHint; 188 | property OnScroll; 189 | property OnSpecialLineColors; 190 | property OnStatusChange; 191 | property OnPaintTransient; 192 | property OnTripleClick; 193 | property OnQuadrupleClick; 194 | property OnSearchNotFound; 195 | property OnZoom; 196 | //++ CodeFolding 197 | property OnScanForFoldRanges; 198 | //-- CodeFolding 199 | end; 200 | 201 | TSearchSynEditStyleHook = class(TEditStyleHook) 202 | strict private 203 | procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE; 204 | strict protected 205 | procedure PaintNC(Canvas: TCanvas); override; 206 | public 207 | constructor Create(AControl: TWinControl); override; 208 | end; 209 | implementation 210 | 211 | uses 212 | System.Types, 213 | System.Math, 214 | Vcl.ActnList, 215 | Vcl.Themes, 216 | Vcl.Consts, 217 | Vcl.ImgList, 218 | Vcl.GraphUtil, 219 | Winapi.CommCtrl, 220 | System.Generics.Collections; 221 | 222 | 223 | const 224 | DefaultButtonWidth = 24; 225 | DefaultExpandedHeight = 100; 226 | DefaultCollapsedHeight = 30; 227 | DefaultButtonImageSize = 16; 228 | 229 | { TSearchSynEdit } 230 | 231 | class constructor TSearchSynEdit.Create; 232 | begin 233 | TCustomStyleEngine.RegisterStyleHook(TSearchSynEdit, TSearchSynEditStyleHook); 234 | end; 235 | 236 | class procedure TSearchSynEdit.InitButtonImageCollection; 237 | procedure LoadItem(const AName: String); 238 | begin 239 | FButtonImageCollection.Add(AName, HInstance, AName, ['', '_20X']); 240 | end; 241 | begin 242 | if FButtonImageCollection <> nil then 243 | Exit; 244 | // FButtonImageCollection := TImageCollection.Create(nil); 245 | // // Add search icon image here 246 | // FButtonImageCollection.Add('SEARCH_ICON', HInstance, 'SEARCH_ICON'); 247 | FButtonImageCollection := TImageCollection.Create(nil); 248 | LoadItem('WINXCTRLS_SEARCHINDICATORS_TEXT'); 249 | LoadItem('WINXCTRLS_SEARCHINDICATORS_AUDIO'); 250 | end; 251 | 252 | class destructor TSearchSynEdit.Destroy; 253 | begin 254 | FreeAndNil(FButtonImageCollection); 255 | end; 256 | 257 | constructor TSearchSynEdit.Create(AOwner: TComponent); 258 | begin 259 | InitButtonImageCollection; 260 | inherited Create(AOwner); 261 | 262 | FCanvas := TControlCanvas.Create; 263 | TControlCanvas(FCanvas).Control := Self; 264 | 265 | FButtonImages := TVirtualImageList.Create(Self); 266 | LoadImages; 267 | 268 | FButtonWidth := DefaultButtonWidth; 269 | FExpandedHeight := DefaultExpandedHeight; 270 | FCollapsedHeight := DefaultCollapsedHeight; 271 | FIsExpanded := False; 272 | FSearchTrigger := stNone; 273 | FNewLineTrigger := nlEnter; 274 | 275 | // Configure SynEdit defaults 276 | WantReturns := False; 277 | ScrollBars := ssNone; 278 | Height := FCollapsedHeight; 279 | BorderStyle := bsSingle; 280 | Gutter.Visible := False; 281 | 282 | Font.Name := 'Segoe UI'; 283 | Font.Size := 13; 284 | // Hook into text changes 285 | OnChange := DoTextChanged; 286 | end; 287 | 288 | destructor TSearchSynEdit.Destroy; 289 | begin 290 | FCanvas.Free; 291 | FButtonImages.Free; 292 | inherited; 293 | end; 294 | 295 | procedure TSearchSynEdit.DoTextChanged(Sender: TObject); 296 | begin 297 | UpdateEditorState; 298 | // if Assigned(OnChange) then 299 | // OnChange(Self); 300 | Inherited; 301 | end; 302 | 303 | procedure TSearchSynEdit.DrawButton(Canvas: TCanvas); { TODO : original } 304 | var 305 | ElementDetails: TThemedElementDetails; 306 | ImageIndex: Integer; 307 | LColor: TColor; 308 | LStyle: TCustomStyleServices; 309 | IX, IY: Integer; 310 | begin 311 | if IsCustomStyleActive then 312 | begin 313 | LStyle := StyleServices(Self); 314 | Canvas.Brush.Color := LStyle.GetStyleColor(scEdit); 315 | Canvas.FillRect(FButtonRect); 316 | 317 | case FSearchIndicator of 318 | sbiText: 319 | begin 320 | if not Enabled then 321 | ElementDetails := LStyle.GetElementDetails(tsiTextDisabled) 322 | else if FButtonDown then 323 | ElementDetails := LStyle.GetElementDetails(tsiTextPressed) 324 | else if FMouseOverButton then 325 | ElementDetails := LStyle.GetElementDetails(tsiTextHot) 326 | else 327 | ElementDetails := LStyle.GetElementDetails(tsiTextNormal); 328 | 329 | LStyle.DrawElement(Canvas.Handle, ElementDetails, FButtonRect, nil, CurrentPPI); 330 | end; 331 | 332 | sbiAudio: 333 | begin 334 | if not Enabled then 335 | ElementDetails := LStyle.GetElementDetails(tsiAudioDisabled) 336 | else if FButtonDown then 337 | ElementDetails := LStyle.GetElementDetails(tsiAudioPressed) 338 | else if FMouseOverButton then 339 | ElementDetails := LStyle.GetElementDetails(tsiAudioHot) 340 | else 341 | ElementDetails := LStyle.GetElementDetails(tsiAudioNormal); 342 | 343 | LStyle.DrawElement(Canvas.Handle, ElementDetails, FButtonRect, nil, CurrentPPI); 344 | end; 345 | end; 346 | end 347 | else // No Styles 348 | begin 349 | if FButtonDown then 350 | LColor := clBtnShadow 351 | else if FMouseOverButton then 352 | LColor := clBtnFace 353 | else 354 | LColor := Self.Color; 355 | Canvas.Brush.Color := LColor; 356 | Canvas.FillRect(FButtonRect); 357 | 358 | if FSearchIndicator = sbiText then 359 | ImageIndex := 0 360 | else 361 | ImageIndex := 1; 362 | IX := FButtonRect.Left + (FButtonRect.Width - FButtonImages.Width) div 2; 363 | IY := FButtonRect.Top + (FButtonRect.Height - FButtonImages.Height) div 2; 364 | FButtonImages.Draw(Canvas, IX, IY, ImageIndex, Enabled); 365 | end; 366 | end; 367 | 368 | procedure TSearchSynEdit.LoadImages; 369 | begin 370 | FButtonImages.SetSize(DefaultButtonImageSize, DefaultButtonImageSize); 371 | FButtonImages.AutoFill := True; 372 | FButtonImages.ImageCollection := FButtonImageCollection; 373 | end; 374 | 375 | procedure TSearchSynEdit.MouseCancel;{ TODO : original } 376 | begin 377 | if GetCapture = Handle then 378 | ReleaseCapture; 379 | 380 | FButtonDown := False; 381 | RepaintButton; 382 | end; 383 | 384 | procedure TSearchSynEdit.KeyDown(var Key: Word; Shift: TShiftState); 385 | begin 386 | case Key of 387 | VK_RETURN: 388 | begin 389 | // Handle new line triggers 390 | if IsNewLineAllowed(Shift) then 391 | begin 392 | if not FIsExpanded then 393 | ExpandEditor; 394 | inherited KeyDown(Key, Shift); 395 | Key := 0; 396 | end 397 | // Handle search triggers 398 | else if ((FSearchTrigger = stEnter) and (Shift = [])) or 399 | ((FSearchTrigger = stCtrlEnter) and (ssCtrl in Shift)) then 400 | begin 401 | InvokeSearch; 402 | Key := 0; 403 | end; 404 | end; 405 | end; 406 | 407 | if Key <> 0 then 408 | inherited KeyDown(Key, Shift); 409 | end; 410 | 411 | procedure TSearchSynEdit.ExpandEditor; 412 | begin 413 | if not FIsExpanded then 414 | begin 415 | FIsExpanded := True; 416 | WantReturns := True; 417 | ScrollBars := ssBoth; 418 | Height := FExpandedHeight; 419 | UpdateButtonPosition; 420 | end; 421 | end; 422 | 423 | class function TSearchSynEdit.GetClipboardHTMLContent: string; 424 | var 425 | CF_HTML, CF_TEXT_HTML: Word; 426 | Data: THandle; 427 | Ptr: Pointer; 428 | Size: NativeUInt; 429 | HtmlData: string; 430 | Utf8: UTF8String; 431 | StartFragment, EndFragment: Integer; 432 | StartFragmentTag, EndFragmentTag: string; 433 | begin 434 | Result := ''; 435 | 436 | // Register Clipboard Formats 437 | CF_HTML := RegisterClipboardFormat('HTML Format'); 438 | CF_TEXT_HTML := RegisterClipboardFormat('text/html'); 439 | 440 | Clipboard.Open; 441 | try 442 | // Check for 'text/html' first (preferred, e.g., from Firefox) 443 | Data := Clipboard.GetAsHandle(CF_TEXT_HTML); 444 | if Data = 0 then 445 | begin 446 | // Fallback to 'HTML Format' (for Chromium browsers) 447 | Data := Clipboard.GetAsHandle(CF_HTML); 448 | if Data = 0 then 449 | Exit; // Neither format is available 450 | end; 451 | 452 | // Lock and extract data 453 | Ptr := GlobalLock(Data); 454 | try 455 | if Assigned(Ptr) then 456 | begin 457 | Size := GlobalSize(Data); 458 | if Size > 0 then 459 | begin 460 | // If we are using 'HTML Format' (Chromium-like), extract UTF-8 content 461 | if Data = Clipboard.GetAsHandle(CF_HTML) then 462 | begin 463 | SetString(Utf8, PAnsiChar(Ptr), Size - 1); // Extract UTF-8 content 464 | HtmlData := String(Utf8); // Convert to Delphi string 465 | StartFragmentTag := 'StartFragment:'; 466 | EndFragmentTag := 'EndFragment:'; 467 | 468 | // Look for StartFragment and EndFragment in the HTML data 469 | StartFragment := StrToIntDef(Copy(HtmlData, Pos(StartFragmentTag, HtmlData) + Length(StartFragmentTag), 10), -1); 470 | EndFragment := StrToIntDef(Copy(HtmlData, Pos(EndFragmentTag, HtmlData) + Length(EndFragmentTag), 10), -1); 471 | 472 | // Ensure valid fragment range and extract it 473 | if (StartFragment >= 0) and (EndFragment > StartFragment) then 474 | Result := Copy(HtmlData, StartFragment + 1, EndFragment - StartFragment) 475 | else 476 | Result := ''; // Return empty string if invalid markers 477 | end 478 | else 479 | begin 480 | // For 'text/html' format (e.g., Firefox), use it directly 481 | HtmlData := PChar(Ptr); // Directly assign for Firefox data (which is already a valid Delphi string) 482 | Result := HtmlData; // No need for extra processing 483 | end; 484 | end; 485 | end; 486 | finally 487 | GlobalUnlock(Data); 488 | end; 489 | finally 490 | Clipboard.Close; 491 | end; 492 | end; 493 | 494 | procedure TSearchSynEdit.CMEnabledChanged(var Msg: TMessage); 495 | begin 496 | inherited; 497 | RepaintButton; 498 | end; 499 | 500 | procedure TSearchSynEdit.CMMouseLeave(var Msg: TMessage); 501 | begin 502 | inherited; 503 | FMouseOverButton := False; 504 | end; 505 | 506 | procedure TSearchSynEdit.CollapseEditor; 507 | begin 508 | if FIsExpanded then 509 | begin 510 | FIsExpanded := False; 511 | WantReturns := False; 512 | ScrollBars := ssNone; 513 | Height := FCollapsedHeight; 514 | // Ensure text is visible in single line mode 515 | TopLine := 0; 516 | LeftChar := 1; 517 | // Self.Perform(EM_SCROLLCARET, 0, 0); 518 | UpdateButtonPosition; 519 | end; 520 | end; 521 | 522 | procedure TSearchSynEdit.UpdateButtonPosition; 523 | begin 524 | if FIsExpanded then 525 | FButtonRect := Rect(Width - FButtonWidth - 4, Height - FButtonWidth - 4, 526 | Width - 4, Height - 4) 527 | else 528 | FButtonRect := Rect(Width - FButtonWidth - 4, 2, 529 | Width - 4, Height - 2); 530 | 531 | RepaintButton; 532 | end; 533 | 534 | procedure TSearchSynEdit.UpdateEditorState; 535 | begin 536 | if Lines.Count = 1 then 537 | begin 538 | if FIsExpanded then 539 | CollapseEditor; 540 | end 541 | else 542 | begin 543 | if not FIsExpanded then 544 | ExpandEditor; 545 | end; 546 | end; 547 | 548 | procedure TSearchSynEdit.ValidateSearchTrigger(Value: TSearchTrigger); 549 | begin 550 | // If Enter is set for new lines, we can't use Enter for search 551 | if (FNewLineTrigger = nlEnter) and (Value = stEnter) then 552 | FSearchTrigger := stNone 553 | else 554 | FSearchTrigger := Value; 555 | end; 556 | 557 | procedure TSearchSynEdit.RepaintButton;{ TODO : original } 558 | begin 559 | if HandleAllocated then 560 | SendMessage(Handle, WM_NCPAINT, 0, 0); 561 | end; 562 | 563 | procedure TSearchSynEdit.WMKillFocus(var Msg: TMessage); { TODO : original } 564 | begin 565 | inherited; 566 | MouseCancel; 567 | end; 568 | 569 | procedure TSearchSynEdit.WMLButtonDblClk(var Msg: TMessage);{ TODO : original } 570 | begin 571 | if FMouseOverButton then 572 | WMLButtonDown(Msg) 573 | else 574 | inherited; 575 | end; 576 | 577 | procedure TSearchSynEdit.WMLButtonDown(var Msg: TMessage);{ TODO : original } 578 | begin 579 | if FMouseOverButton then 580 | begin 581 | if not Focused then 582 | SetFocus; 583 | FButtonDown := True; 584 | RepaintButton; 585 | SetCapture(Handle); 586 | Msg.Result := 0; 587 | end 588 | else 589 | begin 590 | inherited; 591 | if not Focused then 592 | MouseCancel; 593 | end; 594 | end; 595 | 596 | procedure TSearchSynEdit.WMLButtonUp(var Msg: TWMLButtonUp);{ TODO : original } 597 | var 598 | P: TPoint; 599 | R: TRect; 600 | begin 601 | MouseCancel; 602 | inherited; 603 | 604 | P := Msg.Pos; 605 | R := FButtonRect; 606 | if UseRightToLeftAlignment then 607 | begin 608 | R.Left := 0; 609 | P.X := R.Right + P.X; 610 | end; 611 | if PtInRect(R, P) then 612 | InvokeSearch; 613 | end; 614 | 615 | procedure TSearchSynEdit.WMNCCalcSize(var Msg: TWMNCCalcSize);{ TODO : original } 616 | begin 617 | if not UseRightToLeftAlignment then 618 | Dec(Msg.CalcSize_Params^.rgrc[0].Right, FButtonWidth) 619 | else 620 | Inc(Msg.CalcSize_Params^.rgrc[0].Left, FButtonWidth); 621 | inherited; 622 | end; 623 | 624 | procedure TSearchSynEdit.WMNCHitTest(var Msg: TMessage);{ TODO : original } 625 | begin 626 | inherited; 627 | 628 | if Msg.Result = Winapi.Windows.HTNOWHERE then 629 | begin 630 | FMouseOverButton := True; 631 | Msg.Result := HTCLIENT; 632 | end 633 | else 634 | FMouseOverButton := False; 635 | end; 636 | 637 | procedure TSearchSynEdit.WMNCPaint(var Msg: TWMNCPaint);{ TODO : original } 638 | var 639 | DC: HDC; 640 | begin 641 | inherited; 642 | 643 | DC := GetWindowDC(Handle); 644 | FCanvas.Handle := DC; 645 | try 646 | GetWindowRect(Handle, FButtonRect); 647 | OffsetRect(FButtonRect, -FButtonRect.Left, -FButtonRect.Top); 648 | 649 | InflateRect(FButtonRect, -2, -2); 650 | if not UseRightToLeftAlignment then 651 | FButtonRect.Left := FButtonRect.Right - FButtonWidth 652 | else 653 | FButtonRect.Right := FButtonRect.Left + FButtonWidth; 654 | IntersectClipRect(FCanvas.Handle, FButtonRect.Left, FButtonRect.Top, FButtonRect.Right, FButtonRect.Bottom); 655 | 656 | DrawButton(FCanvas); 657 | Msg.Result := 0; 658 | finally 659 | FCanvas.Handle := 0; 660 | ReleaseDC(Handle, DC); 661 | end; 662 | end; 663 | 664 | //procedure TSearchSynEdit.WMPaste(var Message: TWMPaste); 665 | //var 666 | // HtmlContent: string; 667 | //begin 668 | // HtmlContent := GetClipboardHTMLContent; 669 | // 670 | // if HtmlContent <> '' then 671 | // begin 672 | // Self.Text := HtmlContent; 673 | // end 674 | // else 675 | // inherited; 676 | //end; 677 | 678 | procedure TSearchSynEdit.WMRButtonDown(var Msg: TMessage);{ TODO : original } 679 | begin 680 | if FMouseOverButton then 681 | Msg.Result := 0 682 | else 683 | inherited; 684 | end; 685 | 686 | procedure TSearchSynEdit.WMSetCursor(var Msg: TWMSetCursor);{ TODO : original } 687 | begin 688 | if FMouseOverButton then 689 | Msg.HitTest := Winapi.Windows.HTNOWHERE; 690 | 691 | inherited; 692 | end; 693 | 694 | //procedure TSearchSynEdit.WndProc(var Message: TMessage); 695 | //var 696 | // HtmlContent: string; 697 | //begin 698 | // if Message.Msg = WM_PASTE then 699 | // begin 700 | // HtmlContent := GetClipboardHTMLContent; 701 | // 702 | // if HtmlContent <> '' then 703 | // begin 704 | // Self.Text := HtmlContent; 705 | // end 706 | // else 707 | // inherited; 708 | // end; 709 | // 710 | // inherited WndProc(Message); 711 | //end; 712 | 713 | procedure TSearchSynEdit.Resize; 714 | begin 715 | inherited; 716 | UpdateButtonPosition; 717 | end; 718 | 719 | procedure TSearchSynEdit.SetButtonWidth(Value: Integer); 720 | begin 721 | if FButtonWidth <> Value then 722 | begin 723 | FButtonWidth := Value; 724 | UpdateButtonPosition; 725 | end; 726 | end; 727 | 728 | procedure TSearchSynEdit.SetExpandedHeight(Value: Integer); 729 | begin 730 | if Value < DefaultCollapsedHeight then 731 | Value := DefaultCollapsedHeight; 732 | 733 | if FExpandedHeight <> Value then 734 | begin 735 | FExpandedHeight := Value; 736 | if FIsExpanded then 737 | begin 738 | Height := Value; 739 | UpdateButtonPosition; 740 | end; 741 | end; 742 | end; 743 | 744 | procedure TSearchSynEdit.SetNewLineTrigger(Value: TNewLineTrigger); 745 | begin 746 | if FNewLineTrigger <> Value then 747 | begin 748 | FNewLineTrigger := Value; 749 | // Automatically adjust SearchTrigger if it conflicts with NewLineTrigger 750 | ValidateSearchTrigger(FSearchTrigger); 751 | end; 752 | end; 753 | 754 | procedure TSearchSynEdit.SetSearchTrigger(Value: TSearchTrigger); 755 | begin 756 | if FSearchTrigger <> Value then 757 | ValidateSearchTrigger(Value); 758 | end; 759 | 760 | procedure TSearchSynEdit.InvokeSearch; 761 | begin 762 | if Assigned(FOnInvokeSearch) then 763 | FOnInvokeSearch(Self); 764 | end; 765 | 766 | function TSearchSynEdit.IsNewLineAllowed(Shift: TShiftState): Boolean; 767 | begin 768 | case FNewLineTrigger of 769 | nlEnter: Result := (Shift = []); 770 | nlShiftEnter: Result := (ssShift in Shift); 771 | end; 772 | end; 773 | 774 | { TSearchBoxStyleHook } 775 | 776 | constructor TSearchSynEditStyleHook.Create(AControl: TWinControl); 777 | begin 778 | inherited; 779 | 780 | end; 781 | 782 | procedure TSearchSynEditStyleHook.PaintNC(Canvas: TCanvas); 783 | var 784 | Details: TThemedElementDetails; 785 | ControlRect, EditRect, BtnRect: TRect; 786 | BtnWidth: Integer; 787 | LStyle: TCustomStyleServices; 788 | 789 | begin 790 | LStyle := StyleServices; 791 | if LStyle.Available then 792 | begin 793 | // Draw border of control 794 | if Control.Focused then 795 | Details := LStyle.GetElementDetails(teEditBorderNoScrollFocused) 796 | else if MouseInControl then 797 | Details := LStyle.GetElementDetails(teEditBorderNoScrollHot) 798 | else if Control.Enabled then 799 | Details := LStyle.GetElementDetails(teEditBorderNoScrollNormal) 800 | else 801 | Details := LStyle.GetElementDetails(teEditBorderNoScrollDisabled); 802 | 803 | ControlRect := Rect(0, 0, Control.Width, Control.Height); 804 | 805 | EditRect := ControlRect; 806 | InflateRect(EditRect, -2, -2); 807 | BtnWidth := TSearchSynEdit(Control).ButtonWidth; 808 | if not Control.UseRightToLeftAlignment then 809 | Dec(EditRect.Right, BtnWidth) 810 | else 811 | Inc(EditRect.Left, BtnWidth); 812 | 813 | // Exclude the editing area 814 | ExcludeClipRect(Canvas.Handle, EditRect.Left, EditRect.Top, EditRect.Right, EditRect.Bottom); 815 | 816 | LStyle.DrawElement(Canvas.Handle, Details, ControlRect); 817 | 818 | // Draw the button 819 | BtnRect := ControlRect; 820 | InflateRect(BtnRect, -2, -2); 821 | 822 | if not Control.UseRightToLeftAlignment then 823 | BtnRect.Left := BtnRect.Right - BtnWidth 824 | else 825 | BtnRect.Right := BtnRect.Left + BtnWidth; 826 | IntersectClipRect(Canvas.Handle, BtnRect.Left, BtnRect.Top, BtnRect.Right, BtnRect.Bottom); 827 | 828 | TSearchSynEdit(Control).FButtonRect := BtnRect; 829 | TSearchSynEdit(Control).DrawButton(Canvas); 830 | end; 831 | end; 832 | 833 | procedure TSearchSynEditStyleHook.WMNCCalcSize(var Msg: TWMNCCalcSize); 834 | var 835 | W: Integer; 836 | begin 837 | if (Control is TSearchSynEdit) then 838 | begin 839 | W := TSearchSynEdit(Control).ButtonWidth; 840 | 841 | if not Control.UseRightToLeftAlignment then 842 | Dec(Msg.CalcSize_Params^.rgrc[0].Right, W) 843 | else 844 | Inc(Msg.CalcSize_Params^.rgrc[0].Left, W); 845 | 846 | InflateRect(Msg.CalcSize_Params^.rgrc[0], -2, -2); 847 | Handled := True; 848 | end; 849 | end; 850 | 851 | end. -------------------------------------------------------------------------------- /VirtualDesktopAPI.pas: -------------------------------------------------------------------------------- 1 | // Translated by Alexey Andriukhin (dr. F.I.N.) http://www.delphisources.ru/forum/member.php?u=9721 2 | // Tested on Win10 x32 (build 14393), Delphi7 3 | // 4 | // Great thanks: 5 | // Caintic - https://github.com/Ciantic/VirtualDesktopAccessor 6 | // NikoTin - http://www.cyberforum.ru/blogs/105416/blog3671.html 7 | // Grabacr07 - https://github.com/Grabacr07/VirtualDesktop 8 | // jlubea - https://github.com/jlubea/VirtualDesktop 9 | { 10 | CHANGELOG: 11 | 2023-04-07 12 | - Fixed error that caused Windows explorer to restart by adding to W11 GetAllCurrentDesktops 13 | 2022-05-26: 14 | - Updated IVirtualDesktop to include hstring functions 15 | TODO : handle those hstring 16 | - CLSID_VirtualDesktopAPI_Unknown corrected name to CLSID_VirtualDesktopManagerInternal 17 | } 18 | 19 | unit VirtualDesktopAPI; 20 | 21 | interface 22 | 23 | uses 24 | Windows, UITypes, Winapi.Winrt {HSTRING}; 25 | 26 | const 27 | EMPTY_GUID: TGUID = '{00000000-0000-0000-0000-000000000000}'; 28 | 29 | const 30 | CLSID_ImmersiveShell: TGUID = '{C2F03A33-21F5-47FA-B4BB-156362A2F239}'; 31 | IID_ServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}'; 32 | // 33 | CLSID_ApplicationViewCollection: TGUID = '{1841C6D7-4F9D-42C0-AF41-8747538F10E5}'; // <--- CLSID same as IID? not shure, but it's works 34 | IID_ApplicationViewCollection: TGUID = '{1841C6D7-4F9D-42C0-AF41-8747538F10E5}'; 35 | IID_ApplicationViewCollectionW11: TGUID = '{1841C6D7-4F9D-42C0-AF41-8747538F10E5}'; 36 | // 37 | IID_ApplicationView: TGUID = '{9AC0B5C8-1484-4C5B-9533-4134A0F97CEA}'; 38 | IID_ApplicationViewW11: TGUID = '{372e1d3b-38d3-42e4-a15b-8ab2b178f513}'; 39 | // 40 | CLSID_VirtualDesktopManager: TGUID = '{AA509086-5CA9-4C25-8F95-589D3C07B48A}'; 41 | IID_VirtualDesktopManager: TGUID = '{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'; 42 | // 43 | // CLSID_VirtualDesktopAPI_Unknown: TGUID = '{C5E0CDCA-7B6E-41B2-9FC4-D93975CC467B}'; 44 | CLSID_VirtualDesktopManagerInternal: TGUID = '{C5E0CDCA-7B6E-41B2-9FC4-D93975CC467B}'; 45 | IID_VirtualDesktopManagerInternal_14393: TGUID = '{F31574D6-B682-4CDC-BD56-1827860ABEC6}'; // build 14393 or later 46 | IID_VirtualDesktopManagerInternal_10240: TGUID = '{AF8DA486-95BB-4460-B3B7-6E7A6B2962B5}'; // build 10240 or later 47 | IID_VirtualDesktopManagerInternal_10130: TGUID = '{EF9F1A6C-D3CC-4358-B712-F84B635BEBE7}'; // build 10130 or later 48 | IID_VirtualDesktopManagerInternal_22000: TGUID = '{B2F925B9-5A0F-4D2E-9F4D-2B1507593C10}'; // build 22000 or later 49 | IID_VirtualDesktopManagerInternal_22621: TGUID = '{A3175F2D-239C-4BD2-8AA0-EEBA8B0B138E}'; // build 22621 or later 50 | IID_VirtualDesktopManagerInternal_22631: TGUID = '{4970BA3D-FD4E-4647-BEA3-D89076EF4B9C}'; // build 22631 or later 51 | // 52 | IID_VirtualDesktop: TGUID = '{FF72FFDD-BE7E-43FC-9C03-AD81681E88E4}'; 53 | IID_VirtualDesktopW11: TGUID = '{536d3495-b208-4cc9-ae26-de8111275bf8}'; 54 | // 55 | CLSID_VirtualNotificationService: TGUID = '{A501FDEC-4A09-464C-AE4E-1B9C21B84918}'; 56 | IID_VirtualNotificationService: TGUID = '{0CD45E71-D927-4F15-8B0A-8FEF525337BF}'; 57 | // 58 | IID_VirtualDesktopNotification: TGUID = '{C179334C-4295-40D3-BEA1-C654D965605A}'; 59 | IID_VirtualDesktopNotificationW11: TGUID = '{cd403e52-deed-4c13-b437-b98380f2b1e8}'; 60 | 61 | // 62 | CLSID_VirtualDesktopPinnedApps: TGUID = '{B5A399E7-1C87-46B8-88E9-FC5747B171BD}'; 63 | IID_VirtualDesktopPinnedApps: TGUID = '{4CE81583-1E4C-4632-A621-07A53543148F}'; 64 | 65 | { ApplicationViewCompatibilityPolicy } 66 | AVCP_NONE = 0; 67 | AVCP_SMALL_SCREEN = 1; 68 | AVCP_TABLET_SMALL_SCREEN = 2; 69 | AVCP_VERY_SMALL_SCREEN = 3; 70 | AVCP_HIGH_SCALE_FACTOR = 4; 71 | 72 | type 73 | { IVirtualDesktopManager } 74 | 75 | IVirtualDesktopManager = interface(IUnknown) 76 | ['{A5CD92FF-29BE-454C-8D04-D82879FB3F1B}'] 77 | function IsWindowOnCurrentVirtualDesktop(Wnd: HWND; pIsTrue: PBOOL): HResult; stdcall; // ok {INFORMATION: this only works with the current process windows} 78 | function GetWindowDesktopId(Wnd: HWND; pDesktopID: PGUID): HResult; stdcall; // ok 79 | function MoveWindowToDesktop(Wnd: HWND; const DesktopID: TGUID): HResult; stdcall; // ok 80 | end; 81 | 82 | { IObjectArray } 83 | 84 | PIUnknown = ^IUnknown; 85 | 86 | PIObjectArray = ^IObjectArray; 87 | 88 | IObjectArray = interface 89 | function GetCount(pCount: PUINT): HRESULT; stdcall; // ok 90 | function GetAt(uiIndex: UINT; riid: PGUID; ppv: PIUnknown): HRESULT; stdcall; // ok 91 | end; 92 | 93 | { IApplicationView } 94 | 95 | PLONGLONG = ^LONGLONG; 96 | 97 | PHWND = ^HWND; 98 | 99 | PIApplicationView = ^IApplicationView; 100 | PIApplicationViewW11 = ^IApplicationViewW11; 101 | 102 | IApplicationView = interface(IUnknown) 103 | ['{9AC0B5C8-1484-4C5B-9533-4134A0F97CEA}'] 104 | function SetFocus: HRESULT; stdcall; // ok 105 | function SwitchTo: HRESULT; stdcall; // ok 106 | function notimpl1(): HRESULT; stdcall; //int TryInvokeBack(IntPtr /* IAsyncCallback* */ callback); 107 | function GetThumbnailWindow(pWnd: PHWND): HRESULT; stdcall; // ok 108 | function notimpl2(): HRESULT; stdcall; //int GetMonitor(out IntPtr /* IImmersiveMonitor */ immersiveMonitor); 109 | function notimpl3(): HRESULT; stdcall; //int GetVisibility(out int visibility); 110 | function notimpl4(): HRESULT; stdcall; //int SetCloak(ApplicationViewCloakType cloakType, int unknown); 111 | function notimpl5(): HRESULT; stdcall; //int GetPosition(ref Guid guid /* GUID for IApplicationViewPosition */, out IntPtr /* IApplicationViewPosition** */ position); 112 | function notimpl6(): HRESULT; stdcall; //int SetPosition(ref IntPtr /* IApplicationViewPosition* */ position); 113 | function InsertAfterWindow(Wnd: HWND): HRESULT; stdcall; // not tested 114 | function GetExtendedFramePosition(Rect: PRect): HRESULT; stdcall; // ok 115 | function GetAppUserModelId(Id: PLPWSTR): HRESULT; stdcall; // ok 116 | function SetAppUserModelId(Id: LPWSTR): HRESULT; stdcall; // not tested 117 | function IsEqualByAppUserModelId(Id: LPWSTR; isequal: BOOL): HRESULT; stdcall; // not tested 118 | function notimpl7(): HRESULT; stdcall; //int GetViewState(out uint state); 119 | function notimpl8(): HRESULT; stdcall; //int SetViewState(uint state); 120 | function notimpl9(): HRESULT; stdcall; //int GetNeediness(out int neediness); 121 | function GetLastActivationTimestamp(ptimestamp: PLONGLONG): HRESULT; stdcall; // <--- don't understand how convert to datetime (or it's works incorrectly) 122 | function SetLastActivationTimestamp(timestamp: LONGLONG): HRESULT; stdcall; // <--- don't understand how convert from datetime (or it's works incorrectly) 123 | function GetVirtualDesktopId(pguid: PGUID): HRESULT; stdcall; // ok 124 | function SetVirtualDesktopId(pguid: PGUID): HRESULT; stdcall; // ok 125 | function GetShowInSwitchers(pflag: PBOOL): HRESULT; stdcall; // ok 126 | function SetShowInSwitchers(flag: BOOL): HRESULT; stdcall; // not supported at build 14393 and lower 127 | function notimpl10(): HRESULT; stdcall; //int GetScaleFactor(out int factor); 128 | function CanReceiveInput(pcanReceiveInput: PBOOL): HRESULT; stdcall; // not tested 129 | function GetCompatibilityPolicyType(pflag: PUINT): HRESULT; stdcall; // It seems that works ok 130 | function SetCompatibilityPolicyType(flag: UINT): HRESULT; stdcall; // not tested 131 | function notimpl11(): HRESULT; stdcall; //int GetPositionPriority(out IntPtr /* IShellPositionerPriority** */ priority); 132 | function notimpl12(): HRESULT; stdcall; //int SetPositionPriority(IntPtr /* IShellPositionerPriority* */ priority); 133 | function notimpl13(): HRESULT; stdcall; //int GetSizeConstraints(IntPtr /* IImmersiveMonitor* */ monitor, out Size size1, out Size size2); 134 | function notimpl14(): HRESULT; stdcall; //int GetSizeConstraintsForDpi(uint uint1, out Size size1, out Size size2); 135 | function notimpl15(): HRESULT; stdcall; //int SetSizeConstraintsForDpi(ref uint uint1, ref Size size1, ref Size size2); 136 | function notimpl16(): HRESULT; stdcall; //int QuerySizeConstraintsFromApp(); // It leads to a crash 137 | function OnMinSizePreferencesUpdated(Wnd: HWND): HRESULT; stdcall; // not tested 138 | function notimpl17(): HRESULT; stdcall; //int ApplyOperation(IntPtr /* IApplicationViewOperation* */ operation); 139 | function IsTray(pisTray: PBOOL): HRESULT; stdcall; // allways return TRUE 140 | function IsInHighZOrderBand(pisInHighZOrderBand: PBOOL): HRESULT; stdcall; // It seems that works ok 141 | function IsSplashScreenPresented(pisSplashScreenPresented: PBOOL): HRESULT; stdcall; // allways return FALSE 142 | function Flash: HRESULT; stdcall; // ok 143 | function GetRootSwitchableOwner(rootSwitchableOwner: PIApplicationView): HRESULT; stdcall; // not tested 144 | function EnumerateOwnershipTree(ownershipTree: PIObjectArray): HRESULT; stdcall; // not tested 145 | function GetEnterpriseId(Id: PLPWSTR): HRESULT; stdcall; // build 10584 or later // allwaus return empty value 146 | function IsMirrored(pisMirrored: PBOOL): HRESULT; stdcall; // build 10584 or later // allways return FALSE 147 | end; 148 | 149 | IApplicationViewW11 = interface(IUnknown) 150 | ['{372e1d3b-38d3-42e4-a15b-8ab2b178f513}'] 151 | function SetFocus: HRESULT; stdcall; // ok 152 | function SwitchTo: HRESULT; stdcall; // ok 153 | function notimpl1(): HRESULT; stdcall; //int TryInvokeBack(IntPtr /* IAsyncCallback* */ callback); 154 | function GetThumbnailWindow(pWnd: PHWND): HRESULT; stdcall; // ok 155 | function notimpl2(): HRESULT; stdcall; //int GetMonitor(out IntPtr /* IImmersiveMonitor */ immersiveMonitor); 156 | function notimpl3(): HRESULT; stdcall; //int GetVisibility(out int visibility); 157 | function notimpl4(): HRESULT; stdcall; //int SetCloak(ApplicationViewCloakType cloakType, int unknown); 158 | function notimpl5(): HRESULT; stdcall; //int GetPosition(ref Guid guid /* GUID for IApplicationViewPosition */, out IntPtr /* IApplicationViewPosition** */ position); 159 | function notimpl6(): HRESULT; stdcall; //int SetPosition(ref IntPtr /* IApplicationViewPosition* */ position); 160 | function InsertAfterWindow(Wnd: HWND): HRESULT; stdcall; // not tested 161 | function GetExtendedFramePosition(Rect: PRect): HRESULT; stdcall; // ok 162 | function GetAppUserModelId(Id: PLPWSTR): HRESULT; stdcall; // ok 163 | function SetAppUserModelId(Id: LPWSTR): HRESULT; stdcall; // not tested 164 | function IsEqualByAppUserModelId(Id: LPWSTR; isequal: BOOL): HRESULT; stdcall; // not tested 165 | function notimpl7(): HRESULT; stdcall; //int GetViewState(out uint state); 166 | function notimpl8(): HRESULT; stdcall; //int SetViewState(uint state); 167 | function notimpl9(): HRESULT; stdcall; //int GetNeediness(out int neediness); 168 | function GetLastActivationTimestamp(ptimestamp: PLONGLONG): HRESULT; stdcall; // <--- don't understand how convert to datetime (or it's works incorrectly) 169 | function SetLastActivationTimestamp(timestamp: LONGLONG): HRESULT; stdcall; // <--- don't understand how convert from datetime (or it's works incorrectly) 170 | function GetVirtualDesktopId(pguid: PGUID): HRESULT; stdcall; // ok 171 | function SetVirtualDesktopId(pguid: PGUID): HRESULT; stdcall; // ok 172 | function GetShowInSwitchers(pflag: PBOOL): HRESULT; stdcall; // ok 173 | function SetShowInSwitchers(flag: BOOL): HRESULT; stdcall; // not supported at build 14393 and lower 174 | function notimpl10(): HRESULT; stdcall; //int GetScaleFactor(out int factor); 175 | function CanReceiveInput(pcanReceiveInput: PBOOL): HRESULT; stdcall; // not tested 176 | function GetCompatibilityPolicyType(pflag: PUINT): HRESULT; stdcall; // It seems that works ok 177 | function SetCompatibilityPolicyType(flag: UINT): HRESULT; stdcall; // not tested 178 | function notimpl11(): HRESULT; stdcall; //int GetPositionPriority(out IntPtr /* IShellPositionerPriority** */ priority); 179 | function notimpl12(): HRESULT; stdcall; //int SetPositionPriority(IntPtr /* IShellPositionerPriority* */ priority); 180 | function notimpl13(): HRESULT; stdcall; //int GetSizeConstraints(IntPtr /* IImmersiveMonitor* */ monitor, out Size size1, out Size size2); 181 | function notimpl14(): HRESULT; stdcall; //int GetSizeConstraintsForDpi(uint uint1, out Size size1, out Size size2); 182 | function notimpl15(): HRESULT; stdcall; //int SetSizeConstraintsForDpi(ref uint uint1, ref Size size1, ref Size size2); 183 | function notimpl16(): HRESULT; stdcall; //int QuerySizeConstraintsFromApp(); // It leads to a crash 184 | function OnMinSizePreferencesUpdated(Wnd: HWND): HRESULT; stdcall; // not tested 185 | function notimpl17(): HRESULT; stdcall; //int ApplyOperation(IntPtr /* IApplicationViewOperation* */ operation); 186 | function IsTray(pisTray: PBOOL): HRESULT; stdcall; // allways return TRUE 187 | function IsInHighZOrderBand(pisInHighZOrderBand: PBOOL): HRESULT; stdcall; // It seems that works ok 188 | function IsSplashScreenPresented(pisSplashScreenPresented: PBOOL): HRESULT; stdcall; // allways return FALSE 189 | function Flash: HRESULT; stdcall; // ok 190 | function GetRootSwitchableOwner(rootSwitchableOwner: PIApplicationViewW11): HRESULT; stdcall; // not tested 191 | function EnumerateOwnershipTree(ownershipTree: PIObjectArray): HRESULT; stdcall; // not tested 192 | function GetEnterpriseId(Id: PLPWSTR): HRESULT; stdcall; // build 10584 or later // allwaus return empty value 193 | function IsMirrored(pisMirrored: PBOOL): HRESULT; stdcall; // build 10584 or later // allways return FALSE 194 | end; 195 | 196 | { IApplicationViewCollection } 197 | 198 | IApplicationViewCollection = interface(IUnknown) 199 | ['{1841C6D7-4F9D-42C0-AF41-8747538F10E5}'] 200 | function GetViews(pViews: PIObjectArray): HRESULT; stdcall; // ok 201 | function GetViewsByZOrder(pViews: PIObjectArray): HRESULT; stdcall; // ok 202 | function GetViewsByAppUserModelId(Id: LPWSTR; pViews: PIObjectArray): HRESULT; stdcall; // not tested, but i think it works normaly 203 | function GetViewForHwnd(Wnd: HWND; pView: PIApplicationView): HRESULT; stdcall; // ok 204 | function notimpl1(): HRESULT; stdcall; //int GetViewForApplication(object application, out IApplicationView view); 205 | function GetViewForAppUserModelId(Id: LPWSTR; View: IApplicationView): HRESULT; stdcall; // not tested, but i think it works normaly 206 | function GetViewInFocus(pView: PIApplicationView): HRESULT; stdcall; // ok 207 | function RefreshCollection(): HRESULT; stdcall; // It seems that works ok 208 | function notimpl2(): HRESULT; stdcall; //int RegisterForApplicationViewChanges(object listener, out int cookie); 209 | function notimpl3(): HRESULT; stdcall; //int RegisterForApplicationViewPositionChanges(object listener, out int cookie); 210 | function notimpl4(): HRESULT; stdcall; //int UnregisterForApplicationViewChanges(int cookie); 211 | end; 212 | 213 | IApplicationViewCollectionW11 = interface(IUnknown) 214 | ['{1841C6D7-4F9D-42C0-AF41-8747538F10E5}'] 215 | function GetViews(pViews: PIObjectArray): HRESULT; stdcall; // ok 216 | function GetViewsByZOrder(pViews: PIObjectArray): HRESULT; stdcall; // ok 217 | function GetViewsByAppUserModelId(Id: LPWSTR; pViews: PIObjectArray): HRESULT; stdcall; // not tested, but i think it works normaly 218 | function GetViewForHwnd(Wnd: HWND; pView: PIApplicationViewW11): HRESULT; stdcall; // ok 219 | function notimpl1(): HRESULT; stdcall; //int GetViewForApplication(object application, out IApplicationView view); 220 | function GetViewForAppUserModelId(Id: LPWSTR; View: IApplicationViewW11): HRESULT; stdcall; // not tested, but i think it works normaly 221 | function GetViewInFocus(pView: PIApplicationViewW11): HRESULT; stdcall; // ok 222 | function RefreshCollection(): HRESULT; stdcall; // It seems that works ok 223 | function notimpl2(): HRESULT; stdcall; //int RegisterForApplicationViewChanges(object listener, out int cookie); 224 | function notimpl3(): HRESULT; stdcall; //int RegisterForApplicationViewPositionChanges(object listener, out int cookie); 225 | function notimpl4(): HRESULT; stdcall; //int UnregisterForApplicationViewChanges(int cookie); 226 | end; 227 | 228 | { IVirtualDesktop } 229 | 230 | PIVirtualDesktop = ^IVirtualDesktop; 231 | 232 | IVirtualDesktop = interface(IUnknown) 233 | ['{FF72FFDD-BE7E-43FC-9C03-AD81681E88E4}'] 234 | function IsViewVisible(View: IApplicationView; pfVisible: PBOOL): HRESULT; stdcall; // ok 235 | function GetId(Id: PGUID): HRESULT; stdcall; // ok 236 | end; 237 | 238 | { IVirtualDesktop Windows 11 } 239 | 240 | PIVirtualDesktopW11 = ^IVirtualDesktopW11; 241 | 242 | IVirtualDesktopW11 = interface(IUnknown) 243 | ['{536d3495-b208-4cc9-ae26-de8111275bf8}'] 244 | function IsViewVisible(View: IApplicationViewW11; pfVisible: PBOOL): HRESULT; stdcall; // ok 245 | function GetId(Id: PGUID): HRESULT; stdcall; // ok 246 | function Proc5(PProc5: PUINT): HRESULT; stdcall; 247 | function GetName(Hs: HSTRING): HRESULT; stdcall; 248 | function GetWallpaperPath(Hs: HSTRING): HRESULT; stdcall; 249 | end; 250 | 251 | { IVirtualDesktopManagerInternal } 252 | 253 | IVirtualDesktopManagerInternal = interface(IUnknown) 254 | // ['{F31574D6-B682-4CDC-BD56-1827860ABEC6}'] // build 14393 or later 255 | // ['{AF8DA486-95BB-4460-B3B7-6E7A6B2962B5}'] // build 10240 or later 256 | // ['{EF9F1A6C-D3CC-4358-B712-F84B635BEBE7}'] // build 10130 or later 257 | function GetCount(pCount: PUINT): HRESULT; stdcall; // ok 258 | function MoveViewToDesktop(View: IApplicationView; Desktop: IVirtualDesktop): HRESULT; stdcall; // ok 259 | function CanViewMoveDesktops(View: IApplicationView; pfCanViewMoveDesktops: PBOOL): HRESULT; stdcall; // build 10240 or later // not tested 260 | function GetCurrentDesktop(pVD: PIVirtualDesktop): HRESULT; stdcall; // ok 261 | function GetDesktops(pDesktops: PIObjectArray): HRESULT; stdcall; // ok 262 | function GetAdjacentDesktop(Desktop: IVirtualDesktop; AdjacentDesktop: UINT; pAdjacentDesktop: PIVirtualDesktop): HRESULT; stdcall; // ok 263 | function SwitchDesktop(Desktop: IVirtualDesktop): HRESULT; stdcall; // ok 264 | function CreateDesktopW(pNewDesctop: PIVirtualDesktop): HRESULT; stdcall; // ok 265 | function RemoveDesktop(Desktop: IVirtualDesktop; FallbackDesktop: IVirtualDesktop): HRESULT; stdcall; // ok 266 | function FindDesktop(pId: PGUID; Desktop: PIVirtualDesktop): HRESULT; stdcall; // build 10240 or later // ok 267 | end; 268 | 269 | IVirtualDesktopManagerInternalW11 = interface(IUnknown) 270 | // ['{B2F925B9-5A0F-4D2E-9F4D-2B1507593C10}'] // 22000 or later 271 | function GetCount(pCount: PUINT): HRESULT; stdcall; // ok 272 | function MoveViewToDesktop(View: IApplicationViewW11; Desktop: IVirtualDesktopW11): HRESULT; stdcall; // ok 273 | function CanViewMoveDesktops(View: IApplicationViewW11; pfCanViewMoveDesktops: PBOOL): HRESULT; stdcall; // build 10240 or later // not tested 274 | function GetCurrentDesktop(hWndOrMon: PUINT; pVD: PIVirtualDesktopW11): HRESULT; stdcall; // ok 275 | //do not know if this is for all 22000 or later, trying on 22H2 build 22621.1413, just added the next function, and it works now on it 276 | function GetAllCurrentDesktops(pDesktops: PIObjectArray): HRESULT; stdcall; 277 | function GetDesktops(hWndOrMon: PUINT; pDesktops: PIObjectArray): HRESULT; stdcall; // ok 278 | function GetAdjacentDesktop(Desktop: IVirtualDesktopW11; AdjacentDesktop: UINT; pAdjacentDesktop: PIVirtualDesktopW11): HRESULT; stdcall; // ok 279 | function SwitchDesktop(hWndOrMon: PUINT; Desktop: IVirtualDesktopW11): HRESULT; stdcall; // ok 280 | function CreateDesktopW(hWndOrMon: PUINT; pNewDesctop: PIVirtualDesktopW11): HRESULT; stdcall; // ok 281 | function MoveDesktop(Desktop: IVirtualDesktopW11; hWndOrMon: PUINT; nIndex: Integer): HRESULT; stdcall; 282 | // 283 | function RemoveDesktop(Desktop: IVirtualDesktopW11; FallbackDesktop: IVirtualDesktopW11): HRESULT; stdcall; // ok 284 | function FindDesktop(pId: PGUID; Desktop: PIVirtualDesktopW11): HRESULT; stdcall; // build 10240 or later // ok 285 | // 286 | function GetDesktopSwitchIncludeExcludeViews(Desktop: IVirtualDesktopW11; var o1: IObjectArray; var o2: IObjectArray): HRESULT; stdcall; 287 | function SetDesktopName(Desktop: IVirtualDesktopW11; name: HSTRING): HRESULT; stdcall; 288 | function SetDesktopWallpaper(Desktop: IVirtualDesktopW11; path: HSTRING): HRESULT; stdcall; 289 | function UpdateWallpaperPathForAllDesktops(path: HSTRING): HRESULT; stdcall; 290 | function CopyDesktopState(pView0: IApplicationViewW11; pView1: IApplicationViewW11): HRESULT; stdcall; 291 | function GetDesktopIsPerMonitor(pGetDesktopIsPerMonitor: PBOOL): HRESULT; stdcall; 292 | function SetDesktopIsPerMonitor(state: BOOL): HRESULT; stdcall; 293 | end; 294 | 295 | { IVirtualDesktopNotification } 296 | 297 | IVirtualDesktopNotification = interface(IUnknown) //10240 298 | ['{C179334C-4295-40D3-BEA1-C654D965605A}'] 299 | function VirtualDesktopCreated(Desktop: IVirtualDesktop): HRESULT; stdcall; // ok 300 | function VirtualDesktopDestroyBegin(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 301 | function VirtualDesktopDestroyFailed(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 302 | function VirtualDesktopDestroyed(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 303 | function ViewVirtualDesktopChanged(View: IApplicationView): HRESULT; stdcall; // ok 304 | function CurrentVirtualDesktopChanged(DesktopOld: IVirtualDesktop; DesktopNew: IVirtualDesktop): HRESULT; stdcall; // ok 305 | end; 306 | 307 | IVirtualDesktopNotification20231 = interface(IUnknown) //build 20231 308 | ['{C179334C-4295-40D3-BEA1-C654D965605A}'] 309 | function VirtualDesktopCreated(Desktop: IVirtualDesktop): HRESULT; stdcall; // ok 310 | function VirtualDesktopDestroyBegin(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 311 | function VirtualDesktopDestroyFailed(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 312 | function VirtualDesktopDestroyed(Desktop: IVirtualDesktop; DesktopFallback: IVirtualDesktop): HRESULT; stdcall; // ok 313 | function ViewVirtualDesktopChanged(View: IApplicationView): HRESULT; stdcall; // ok 314 | function CurrentVirtualDesktopChanged(DesktopOld: IVirtualDesktop; DesktopNew: IVirtualDesktop): HRESULT; stdcall; // ok 315 | end; 316 | 317 | IVirtualDesktopNotification21313 = interface(IUnknown) //build 21313 318 | ['{cd403e52-deed-4c13-b437-b98380f2b1e8}'] 319 | function VirtualDesktopCreated(p0: IObjectArray; Desktop: IVirtualDesktopW11): HRESULT; stdcall; // ok 320 | function VirtualDesktopDestroyBegin(p0: IObjectArray; Desktop: IVirtualDesktopW11; DesktopFallback: IVirtualDesktopW11): HRESULT; stdcall; // ok 321 | function VirtualDesktopDestroyFailed(p0: IObjectArray; Desktop: IVirtualDesktopW11; DesktopFallback: IVirtualDesktopW11): HRESULT; stdcall; // ok 322 | function VirtualDesktopDestroyed(p0: IObjectArray; Desktop: IVirtualDesktopW11; DesktopFallback: IVirtualDesktopW11): HRESULT; stdcall; // ok 323 | function Unknown1(Number: Integer): HRESULT; stdcall; 324 | function VirtualDesktopMoved(p0: IObjectArray; Desktop: IVirtualDesktopW11; nFromIndex: Integer; nToIndex: Integer): HRESULT; stdcall; 325 | function VirtualDesktopRenamed(Desktop: IVirtualDesktopW11; chName: HSTRING): HRESULT; stdcall; 326 | function ViewVirtualDesktopChanged(View: IApplicationViewW11): HRESULT; stdcall; // ok 327 | function CurrentVirtualDesktopChanged(p0: IObjectArray; DesktopOld: IVirtualDesktopW11; DesktopNew: IVirtualDesktopW11): HRESULT; stdcall; // ok 328 | function VirtualDesktopWallpaperChanged(Desktop: IVirtualDesktopW11; chPath: HSTRING): HRESULT; stdcall; 329 | end; 330 | 331 | 332 | { IVirtualNotificationService } 333 | 334 | IVirtualNotificationService = interface(IUnknown) 335 | ['{0CD45E71-D927-4F15-8B0A-8FEF525337BF}'] 336 | function Register(Notification: IVirtualDesktopNotification; pdwCookie: Pointer): HRESULT; stdcall; // ok 337 | function Unregister(dwCookie: DWORD): HRESULT; stdcall; // ok 338 | end; 339 | 340 | IVirtualNotificationServiceW11 = interface(IUnknown) 341 | ['{0CD45E71-D927-4F15-8B0A-8FEF525337BF}'] 342 | function Register(Notification: IVirtualDesktopNotification21313; pdwCookie: Pointer): HRESULT; stdcall; // ok 343 | function Unregister(dwCookie: DWORD): HRESULT; stdcall; // ok 344 | end; 345 | 346 | { IVirtualDesktopPinnedApps } 347 | 348 | IVirtualDesktopPinnedApps = interface(IUnknown) 349 | ['{4CE81583-1E4C-4632-A621-07A53543148F}'] 350 | function IsAppIdPinned(appId: LPWSTR; pfPinned: PBOOL): HRESULT; stdcall; // ok 351 | function PinAppID(appId: LPWSTR): HRESULT; stdcall; // ok 352 | function UnpinAppID(appId: LPWSTR): HRESULT; stdcall; // ok 353 | function IsViewPinned(View: IApplicationView; pfPinned: PBOOL): HRESULT; stdcall; // ok 354 | function PinView(View: IApplicationView): HRESULT; stdcall; // ok 355 | function UnpinView(View: IApplicationView): HRESULT; stdcall; // ok 356 | end; 357 | 358 | IVirtualDesktopPinnedAppsW11 = interface(IUnknown) 359 | ['{4CE81583-1E4C-4632-A621-07A53543148F}'] 360 | function IsAppIdPinned(appId: LPWSTR; pfPinned: PBOOL): HRESULT; stdcall; // ok 361 | function PinAppID(appId: LPWSTR): HRESULT; stdcall; // ok 362 | function UnpinAppID(appId: LPWSTR): HRESULT; stdcall; // ok 363 | function IsViewPinned(View: IApplicationViewW11; pfPinned: PBOOL): HRESULT; stdcall; // ok 364 | function PinView(View: IApplicationViewW11): HRESULT; stdcall; // ok 365 | function UnpinView(View: IApplicationViewW11): HRESULT; stdcall; // ok 366 | end; 367 | 368 | 369 | 370 | implementation 371 | 372 | end. 373 | 374 | -------------------------------------------------------------------------------- /focusHelper.asm: -------------------------------------------------------------------------------- 1 | format PE GUI 4.0 2 | entry start 3 | 4 | include 'win32a.inc' 5 | 6 | section '.code' code readable executable 7 | start: 8 | ; Allow any process to set the foreground window 9 | push -1 ; ASFW_ANY 10 | call [AllowSetForegroundWindow] 11 | 12 | ; Find the window by class name and window name 13 | push wndName ; Window name 'AI Launcher' 14 | push wndClassName ; Class name 'AIChatbarWnd' 15 | call [FindWindowA] 16 | test eax, eax ; Check if the window handle is valid 17 | jz exit ; Exit if no window found 18 | 19 | ; Call SwitchToThisWindow 20 | push 1 ; fUnknown parameter (TRUE) 21 | push eax ; hWnd (window handle) 22 | call [SwitchToThisWindow] 23 | 24 | exit: 25 | ; Exit the program 26 | push 0 27 | call [ExitProcess] 28 | 29 | section '.data' data readable writeable 30 | wndClassName db 'AIChatbarWnd', 0 31 | wndName db 'AI Launcher', 0 32 | 33 | section '.idata' import data readable writeable 34 | library kernel32, 'kernel32.dll', user32, 'user32.dll' 35 | 36 | import kernel32, ExitProcess, 'ExitProcess' 37 | import user32, FindWindowA, 'FindWindowA', AllowSetForegroundWindow, 'AllowSetForegroundWindow', SwitchToThisWindow, 'SwitchToThisWindow' 38 | -------------------------------------------------------------------------------- /frameEditSite.dfm: -------------------------------------------------------------------------------- 1 | object Frame1: TFrame1 2 | Left = 0 3 | Top = 0 4 | Width = 574 5 | Height = 440 6 | TabOrder = 0 7 | DesignSize = ( 8 | 574 9 | 440) 10 | object svgIcon: TSkSvg 11 | Left = 493 12 | Top = 16 13 | Width = 64 14 | Height = 64 15 | Anchors = [akTop, akRight] 16 | ExplicitLeft = 424 17 | end 18 | object lblName: TLabeledEdit 19 | Left = 16 20 | Top = 32 21 | Width = 185 22 | Height = 23 23 | EditLabel.Width = 35 24 | EditLabel.Height = 15 25 | EditLabel.Caption = 'Name:' 26 | TabOrder = 0 27 | Text = '' 28 | end 29 | object lblURL: TLabeledEdit 30 | Left = 16 31 | Top = 80 32 | Width = 297 33 | Height = 23 34 | EditLabel.Width = 24 35 | EditLabel.Height = 15 36 | EditLabel.Caption = 'URL:' 37 | TabOrder = 1 38 | Text = '' 39 | end 40 | object lblAltURL: TLabeledEdit 41 | Left = 16 42 | Top = 128 43 | Width = 297 44 | Height = 23 45 | EditLabel.Width = 161 46 | EditLabel.Height = 15 47 | EditLabel.Caption = 'Alternate URL: (if primary fails)' 48 | TabOrder = 2 49 | Text = '' 50 | end 51 | object btnSearchSVG: TButton 52 | Left = 493 53 | Top = 86 54 | Width = 64 55 | Height = 27 56 | Anchors = [akTop, akRight] 57 | Caption = '...' 58 | TabOrder = 3 59 | OnClick = btnSearchSVGClick 60 | end 61 | object ckUserScript: TCheckBox 62 | Left = 16 63 | Top = 205 64 | Width = 137 65 | Height = 17 66 | Caption = 'Enable UserScripts' 67 | TabOrder = 4 68 | end 69 | object ckUserStyle: TCheckBox 70 | Left = 324 71 | Top = 205 72 | Width = 137 73 | Height = 17 74 | Anchors = [akTop, akRight] 75 | Caption = 'Enable UserStyles' 76 | TabOrder = 5 77 | end 78 | object ckEnabled: TCheckBox 79 | Left = 16 80 | Top = 388 81 | Width = 137 82 | Height = 17 83 | Anchors = [akLeft, akBottom] 84 | Caption = 'Enabled' 85 | TabOrder = 6 86 | end 87 | object txtUserScript: TMemo 88 | Left = 16 89 | Top = 228 90 | Width = 233 91 | Height = 136 92 | TabOrder = 7 93 | end 94 | object txtUserStyle: TMemo 95 | Left = 324 96 | Top = 220 97 | Width = 233 98 | Height = 136 99 | Anchors = [akTop, akRight] 100 | TabOrder = 8 101 | end 102 | object btnCancel: TButton 103 | Left = 401 104 | Top = 412 105 | Width = 75 106 | Height = 25 107 | Anchors = [akRight, akBottom] 108 | Caption = '&Cancel' 109 | TabOrder = 9 110 | end 111 | object btnOK: TButton 112 | Left = 482 113 | Top = 412 114 | Width = 75 115 | Height = 25 116 | Anchors = [akRight, akBottom] 117 | Caption = 'OK' 118 | TabOrder = 10 119 | end 120 | object lblUA: TLabeledEdit 121 | Left = 16 122 | Top = 176 123 | Width = 297 124 | Height = 23 125 | EditLabel.Width = 103 126 | EditLabel.Height = 15 127 | EditLabel.Caption = 'Custom User Agent' 128 | TabOrder = 11 129 | Text = '' 130 | end 131 | object openSVG: TOpenDialog 132 | Left = 328 133 | Top = 48 134 | end 135 | end 136 | -------------------------------------------------------------------------------- /frameEditSite.pas: -------------------------------------------------------------------------------- 1 | unit frameEditSite; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 7 | Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, 8 | Vcl.ExtCtrls, Skia; 9 | 10 | type 11 | TFrame1 = class(TFrame) 12 | lblName: TLabeledEdit; 13 | lblURL: TLabeledEdit; 14 | lblAltURL: TLabeledEdit; 15 | svgIcon: TSkSvg; 16 | btnSearchSVG: TButton; 17 | ckUserScript: TCheckBox; 18 | ckUserStyle: TCheckBox; 19 | ckEnabled: TCheckBox; 20 | txtUserScript: TMemo; 21 | txtUserStyle: TMemo; 22 | btnCancel: TButton; 23 | btnOK: TButton; 24 | openSVG: TOpenDialog; 25 | lblUA: TLabeledEdit; 26 | procedure btnSearchSVGClick(Sender: TObject); 27 | private 28 | { Private declarations } 29 | public 30 | { Public declarations } 31 | end; 32 | 33 | implementation 34 | 35 | {$R *.dfm} 36 | 37 | procedure TFrame1.btnSearchSVGClick(Sender: TObject); 38 | begin 39 | openSVG.Filter := 'SVG Files|*.svg|All Files|*.*'; 40 | if openSVG.Execute then 41 | begin 42 | var txt := TStringList.Create; 43 | try 44 | txt.LoadFromFile(openSVG.FileName); 45 | svgIcon.Svg.Source := txt.Text; 46 | finally 47 | txt.Free; 48 | end; 49 | end; 50 | end; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /frmChatWebView.dfm: -------------------------------------------------------------------------------- 1 | object mainBrowser: TmainBrowser 2 | Left = 0 3 | Top = 0 4 | AlphaBlendValue = 248 5 | Caption = 'Chat' 6 | ClientHeight = 689 7 | ClientWidth = 493 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -12 12 | Font.Name = 'Segoe UI' 13 | Font.Style = [] 14 | StyleElements = [seFont] 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | OnPaint = FormPaint 18 | OnShow = FormShow 19 | DesignSize = ( 20 | 493 21 | 689) 22 | TextHeight = 15 23 | object CardPanel1: TCardPanel 24 | AlignWithMargins = True 25 | Left = 0 26 | Top = 0 27 | Width = 493 28 | Height = 689 29 | Margins.Left = 0 30 | Margins.Top = 0 31 | Margins.Right = 0 32 | Margins.Bottom = 0 33 | Align = alClient 34 | Caption = 'CardPanel1' 35 | TabOrder = 0 36 | ExplicitWidth = 509 37 | ExplicitHeight = 728 38 | end 39 | object Panel1: TPanel 40 | Left = 0 41 | Top = 0 42 | Width = 493 43 | Height = 20 44 | Anchors = [akLeft, akTop, akRight] 45 | BevelOuter = bvNone 46 | Caption = 'Panel1' 47 | TabOrder = 1 48 | OnMouseDown = Panel1MouseDown 49 | ExplicitWidth = 509 50 | DesignSize = ( 51 | 493 52 | 20) 53 | object lblPin: TLabel 54 | Left = 408 55 | Top = 8 56 | Width = 12 57 | Height = 15 58 | Cursor = crHandPoint 59 | Anchors = [akTop, akRight] 60 | Caption = #55357#56524 61 | Font.Charset = ANSI_CHARSET 62 | Font.Color = clWindowText 63 | Font.Height = -12 64 | Font.Name = 'Segoe UI' 65 | Font.Style = [] 66 | ParentFont = False 67 | OnClick = lblPinClick 68 | ExplicitLeft = 424 69 | end 70 | end 71 | object Timer1: TTimer 72 | Interval = 100 73 | OnTimer = Timer1Timer 74 | Left = 96 75 | Top = 296 76 | end 77 | object tmrRamUsage: TTimer 78 | OnTimer = tmrRamUsageTimer 79 | Left = 240 80 | Top = 352 81 | end 82 | end 83 | -------------------------------------------------------------------------------- /frmChatWebView.pas: -------------------------------------------------------------------------------- 1 | unit frmChatWebView; 2 | 3 | interface 4 | 5 | {.$I ProjectDefines.inc} 6 | 7 | uses 8 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 9 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.WinXPanels, 10 | Net.HttpClient, 11 | uWVLoader, uWVCoreWebView2Args, JvComponentBase, JvAppEvent, Vcl.StdCtrls {$IFDEF EXPERIMENTAL} {$I experimental.uses.inc} {$IFEND}; 12 | 13 | const 14 | WV_INITIALIZED = WM_APP + $100; 15 | DEFAULT_TAB_CAPTION = 'New tab'; 16 | 17 | type 18 | TmainBrowser = class(TForm) 19 | CardPanel1: TCardPanel; 20 | Panel1: TPanel; 21 | Timer1: TTimer; 22 | tmrRamUsage: TTimer; 23 | lblPin: TLabel; 24 | procedure FormShow(Sender: TObject); 25 | procedure FormCreate(Sender: TObject); 26 | procedure FormPaint(Sender: TObject); 27 | procedure FormDestroy(Sender: TObject); 28 | procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; 29 | Shift: TShiftState; X, Y: Integer); 30 | procedure Timer1Timer(Sender: TObject); 31 | procedure tmrRamUsageTimer(Sender: TObject); 32 | procedure lblPinClick(Sender: TObject); 33 | 34 | procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 35 | procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; 36 | private 37 | { Private declarations } 38 | FBingID: Cardinal; 39 | FBardID: Cardinal; 40 | FChatGPTID: Cardinal; 41 | FYouID: Cardinal; 42 | FClaudeID: Cardinal; 43 | {$IFDEF EXPERIMENTAL} 44 | {$I experimental.object.inc} 45 | {$IFEND} 46 | protected 47 | FLastCardID : cardinal; 48 | 49 | function GetNextCardID : cardinal; 50 | // procedure EnableButtonPnl; 51 | 52 | property NextCardID : cardinal read GetNextCardID; 53 | 54 | public 55 | { Public declarations } 56 | procedure WVInitializedMsg(var aMessage : TMessage); message WV_INITIALIZED; 57 | procedure WMMove(var aMessage : TWMMove); message WM_MOVE; 58 | procedure WMMoving(var aMessage : TMessage); message WM_MOVING; 59 | 60 | procedure CreateNewCard(const aArgs : TCoreWebView2NewWindowRequestedEventArgs); 61 | function CreateNewSite(const Id: Integer; const url, ua: string): Integer; 62 | 63 | procedure CtrlPEvent(Sender: TObject); 64 | function GetGPTCookies: TCookieManager; 65 | end; 66 | 67 | var 68 | mainBrowser: TmainBrowser; 69 | 70 | implementation 71 | 72 | {$R *.dfm} 73 | 74 | uses 75 | uBrowserCard, functions, menu, frmTaskGPT; 76 | 77 | { TForm1 } 78 | 79 | 80 | 81 | procedure TmainBrowser.CreateNewCard( 82 | const aArgs: TCoreWebView2NewWindowRequestedEventArgs); 83 | var 84 | TempNewCard : TBrowserCard; 85 | begin 86 | TempNewCard := TBrowserCard.Create(self, NextCardID, DEFAULT_TAB_CAPTION); 87 | // TempNewCard.CardPanel := CardPanel1; 88 | 89 | CardPanel1.ActiveCardIndex := pred(CardPanel1.CardCount); 90 | 91 | TempNewCard.CreateBrowser(aArgs); 92 | end; 93 | 94 | function TmainBrowser.CreateNewSite(const Id: Integer; const url, ua: string): Integer; 95 | var 96 | TempNewCard : TBrowserCard; 97 | CardID: Cardinal; 98 | begin 99 | Result := -1; 100 | 101 | CardID := Id; 102 | TempNewCard := TBrowserCard.Create(self, CardID, DEFAULT_TAB_CAPTION); 103 | TempNewCard.Parent := CardPanel1; 104 | TempNewCard.Tag := CardID; 105 | // CardPanel1.ActiveCardIndex := pred(CardPanel1.CardCount); 106 | // FClaudeID := CardPanel1.CardCount; 107 | Result := CardID; 108 | TempNewCard.CreateBrowser(url, ua); 109 | TempNewCard.CardCtrlPEvent := CtrlPEvent; 110 | 111 | //we need chatgpt for other cool things, just let the Card browser created knows it is chatgpt 112 | TempNewCard.IsChatGPT := url.Contains('https://chat.openai.com'); 113 | end; 114 | 115 | 116 | 117 | procedure TmainBrowser.CtrlPEvent(Sender: TObject); 118 | begin 119 | // inform the menu ActionList Ctrl+P handler 120 | frmMenu.actSwitchAIChatsExecute(Sender); 121 | end; 122 | 123 | procedure TmainBrowser.FormCreate(Sender: TObject); 124 | begin 125 | {$IFDEF EXPERIMENTAL} 126 | {$I experimental.create.inc} 127 | {$ELSE} 128 | // EnableBlur(Handle); 129 | {$IFEND} 130 | end; 131 | 132 | procedure TmainBrowser.FormDestroy(Sender: TObject); 133 | begin 134 | {$IFDEF EXPERIMENTAL} 135 | {$I experimental.destroy.inc} 136 | {$IFEND} 137 | end; 138 | 139 | procedure TmainBrowser.FormPaint(Sender: TObject); 140 | begin 141 | if TaskbarAccented then 142 | begin 143 | Canvas.Brush.Handle := CreateSolidBrushWithAlpha(BlendColors(GetAccentColor, clBlack,50), 200); 144 | end 145 | else 146 | begin 147 | if SystemUsesLightTheme then 148 | Canvas.Brush.Handle := CreateSolidBrushWithAlpha($dddddd, 200) 149 | else 150 | Canvas.Brush.Handle := CreateSolidBrushWithAlpha($000000, 200); 151 | end; 152 | Canvas.FillRect(Rect(0,0,Width,Height)); 153 | end; 154 | 155 | procedure TmainBrowser.FormShow(Sender: TObject); 156 | begin 157 | if GlobalWebView2Loader.InitializationError then 158 | showmessage(GlobalWebView2Loader.ErrorMessage) 159 | else 160 | if GlobalWebView2Loader.Initialized then 161 | begin 162 | // EnableButtonPnl; 163 | end; 164 | end; 165 | 166 | function TmainBrowser.GetGPTCookies: TCookieManager; 167 | var 168 | I: Integer; 169 | begin 170 | Result := nil; 171 | for I := 0 to CardPanel1.CardCount - 1 do 172 | begin 173 | if TBrowserCard(CardPanel1.Cards[I]).IsChatGPT then 174 | begin 175 | Result := TBrowserCard(CardPanel1.Cards[I]).Cookies; 176 | Break; 177 | end; 178 | end; 179 | end; 180 | 181 | function TmainBrowser.GetNextCardID: cardinal; 182 | begin 183 | if FLastCardID < 0 then 184 | FLastCardID := 0; 185 | 186 | Inc(FLastCardID); 187 | Result := FLastCardID; 188 | end; 189 | 190 | procedure TmainBrowser.lblPinClick(Sender: TObject); 191 | begin 192 | if lblPin.Caption = '📌' then 193 | begin 194 | //pin 195 | lblPin.Caption := '🔳'; 196 | mainBrowser.FormStyle := fsStayOnTop; 197 | end 198 | else 199 | begin 200 | //unpin 201 | lblPin.Caption := '📌'; 202 | mainBrowser.FormStyle := fsNormal; 203 | end; 204 | end; 205 | 206 | procedure TmainBrowser.Panel1MouseDown(Sender: TObject; Button: TMouseButton; 207 | Shift: TShiftState; X, Y: Integer); 208 | begin 209 | ReleaseCapture; 210 | Perform(WM_SYSCOMMAND, $F012, 0); 211 | end; 212 | 213 | procedure TmainBrowser.Timer1Timer(Sender: TObject); 214 | var 215 | pos: TPoint; 216 | begin 217 | try 218 | pos := Mouse.CursorPos; 219 | except 220 | end; 221 | 222 | if (pos.X > Left) and (pos.X < Left+Width) 223 | and (pos.Y > Top) and (pos.Y < Top+Panel1.Height) 224 | then 225 | begin 226 | Panel1.Visible := True; 227 | // CardPanel1.Margins.Top := 0; 228 | end 229 | else 230 | begin 231 | Panel1.Visible := False; 232 | // CardPanel1.Margins.Top := Panel1.Height; 233 | end; 234 | 235 | end; 236 | 237 | procedure TmainBrowser.tmrRamUsageTimer(Sender: TObject); 238 | const 239 | B = 1; 240 | KB = 1024 * B; 241 | MB = 1024 * KB; 242 | GB = 1024 * MB; 243 | var 244 | Bytes: Int64; 245 | begin 246 | Bytes := GetRAMUsage; 247 | 248 | // Get RAM usage of WebView2 instance and its child processes #TODO fix when removing 249 | if (CardPanel1.CardCount > 0) and Assigned(CardPanel1.ActiveCard) then 250 | Bytes := Bytes + TBrowserCard(CardPanel1.ActiveCard).MemoryUsage; 251 | 252 | if Bytes > GB then 253 | Panel1.Caption := FormatFloat('Memory Used: #.## GB', Bytes / GB) 254 | else if Bytes > MB then 255 | Panel1.Caption := FormatFloat('Memory Used: #.## MB', Bytes / MB) 256 | else if Bytes > KB then 257 | Panel1.Caption := FormatFloat('Memory Used: #.## KB', Bytes / KB) 258 | else 259 | Panel1.Caption := FormatFloat('Memory Used: #.## bytes', Bytes); 260 | end; 261 | 262 | procedure TmainBrowser.WMMove(var aMessage: TWMMove); 263 | var 264 | i : integer; 265 | begin 266 | inherited; 267 | 268 | i := 0; 269 | while (i < CardPanel1.CardCount) do 270 | begin 271 | TBrowserCard(CardPanel1.Cards[i]).NotifyParentWindowPositionChanged; 272 | // TBrowserTab(BrowserPageCtrl.Pages[i]).NotifyParentWindowPositionChanged; 273 | inc(i); 274 | end; 275 | end; 276 | 277 | procedure TmainBrowser.WMMoving(var aMessage: TMessage); 278 | var 279 | i : integer; 280 | begin 281 | inherited; 282 | 283 | i := 0; 284 | while (i < CardPanel1.CardCount) do 285 | begin 286 | TBrowserCard(CardPanel1.Cards[i]).NotifyParentWindowPositionChanged; 287 | inc(i); 288 | end; 289 | end; 290 | 291 | procedure TmainBrowser.WMNCCalcSize(var Message: TWMNCCalcSize); 292 | var 293 | LResizePadding: Integer; 294 | LTitleBarHeight: Integer; 295 | begin 296 | inherited; 297 | 298 | LResizePadding := GetSystemMetrics(SM_CYSIZEFRAME) + 299 | GetSystemMetrics(SM_CXPADDEDBORDER); 300 | 301 | if BorderStyle = bsNone then Exit; 302 | 303 | LTitleBarHeight := GetSystemMetrics(SM_CYCAPTION); 304 | 305 | if WindowState = TWindowState.wsNormal then 306 | Inc(LTitleBarHeight, LResizePadding); 307 | 308 | Dec(Message.CalcSize_Params.rgrc[0].Top, LTitleBarHeight + 1); 309 | 310 | end; 311 | 312 | procedure TmainBrowser.WMNCHitTest(var Message: TWMNCHitTest); 313 | var 314 | LResizePadding: Integer; 315 | LIsResizable: Boolean; 316 | begin 317 | inherited; 318 | LResizePadding := GetSystemMetrics(SM_CYSIZEFRAME) + 319 | GetSystemMetrics(SM_CXPADDEDBORDER); 320 | 321 | LIsResizable := (WindowState = TWindowState.wsNormal) and 322 | (BorderStyle in [bsSizeable, bsSizeToolWin]); 323 | 324 | if LIsResizable and (Message.YPos - BoundsRect.Top <= LResizePadding) then 325 | begin 326 | if Message.XPos - BoundsRect.Left <= 2 * LResizePadding then 327 | Message.Result := HTTOPLEFT 328 | else if BoundsRect.Right - Message.XPos <= 2 * LResizePadding then 329 | Message.Result := HTTOPRIGHT 330 | else 331 | Message.Result := HTTOP; 332 | end; 333 | // to block resizing cursors also resizing itself 334 | {with Message do 335 | begin 336 | if (Result = HTBOTTOM) 337 | or (Result = HTBOTTOMLEFT) 338 | or (Result = HTBOTTOMRIGHT) 339 | or (Result = HTLEFT) 340 | or (Result = HTRIGHT) 341 | or (Result = HTTOP) 342 | or (Result = HTTOPLEFT) 343 | or (Result = HTTOPRIGHT) 344 | then Result := HTBORDER; 345 | 346 | end;} 347 | end; 348 | 349 | procedure TmainBrowser.WVInitializedMsg(var aMessage: TMessage); 350 | begin 351 | // EnableButtonPnl; 352 | end; 353 | 354 | procedure GlobalWebView2Loader_OnEnvironmentCreated(Sender: TObject); 355 | begin 356 | if (mainBrowser <> nil) and mainBrowser.HandleAllocated then 357 | PostMessage(mainBrowser.Handle, WV_INITIALIZED, 0, 0); 358 | end; 359 | 360 | initialization 361 | GlobalWebView2Loader := TWVLoader.Create(nil); 362 | // GlobalWebView2Loader.ProxySettings.Server := '127.0.0.1:8888'; 363 | GlobalWebView2Loader.EnableGPU := True; 364 | GlobalWebView2Loader.EnableTrackingPrevention := False; 365 | GlobalWebView2Loader.UserDataFolder := ExtractFileDir(Application.ExeName) + '\CustomCache'; 366 | GlobalWebView2Loader.OnEnvironmentCreated := GlobalWebView2Loader_OnEnvironmentCreated; 367 | GlobalWebView2Loader.StartWebView2; 368 | 369 | end. 370 | -------------------------------------------------------------------------------- /frmLauncher.pas: -------------------------------------------------------------------------------- 1 | unit frmLauncher; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ACL.UI.Controls.Base, 8 | ACL.UI.Controls.BaseEditors, ACL.UI.Controls.TextEdit, 9 | ACL.UI.Controls.SearchBox, Vcl.StdCtrls, Vcl.WinXCtrls, System.Actions, 10 | Vcl.ActnList, HTMLUn2, HtmlView, DragDropContext, DropHandler, 11 | DropComboTarget, DragDropText, DragDrop, DropTarget, DragDropFile, Vcl.Menus, Vcl.Clipbrd, UWP.DarkMode, UWP.Form, SynSearchEdit, 12 | SynEdit, SynMarkdownViewer, SynEditHighlighter, SynHighlighterMulti, 13 | SynEditTypes, Vcl.AppEvnts, SynHighlighterHtml, SynHighlighterCpp, 14 | SynHighlighterPas, SynHighlighterJSON, SynHighlighterPython, 15 | SynHighlighterBat, SynHighlighterJScript, 16 | SynEditCodeFolding, SynHighlighterCS, Vcl.ComCtrls, ACL.UI.Controls.DropDown, 17 | ACL.UI.Controls.ComboBox, ACL.UI.Controls.ImageComboBox, System.ImageList, 18 | Vcl.ImgList, ACL.UI.ImageList, Vcl.VirtualImageList, Vcl.BaseImageCollection, 19 | Vcl.ImageCollection, JvExComCtrls, JvStatusBar, Vcl.ExtCtrls; 20 | 21 | type 22 | TSearchBox = class(Vcl.WinXCtrls.TSearchBox) 23 | private 24 | function GetClipboardHTMLContent: string; 25 | protected 26 | procedure WMPaste(var Message: TWMPaste); message WM_PASTE; 27 | end; 28 | 29 | type 30 | TformLauncher = class(TUWPForm) 31 | SearchBox1: TSearchBox; 32 | ActionList1: TActionList; 33 | actHideLauncher: TAction; 34 | HtmlViewer1: THtmlViewer; 35 | DataFormatAdapter1: TDataFormatAdapter; 36 | DropFileTarget1: TDropFileTarget; 37 | DropTextTarget1: TDropTextTarget; 38 | DropComboTarget1: TDropComboTarget; 39 | DropHandler1: TDropHandler; 40 | DropContextMenu1: TDropContextMenu; 41 | PopupMenu1: TPopupMenu; 42 | DummyMenu1: TMenuItem; 43 | SynJScriptSyn1: TSynJScriptSyn; 44 | SynBatSyn1: TSynBatSyn; 45 | SynPythonSyn1: TSynPythonSyn; 46 | SynJSONSyn1: TSynJSONSyn; 47 | SynPasSyn1: TSynPasSyn; 48 | SynCppSyn1: TSynCppSyn; 49 | SynMultiSyn1: TSynMultiSyn; 50 | ACLImageComboBox1: TACLImageComboBox; 51 | ImageCollection1: TImageCollection; 52 | VirtualImageList1: TVirtualImageList; 53 | chkDefaultBrowser: TCheckBox; 54 | JvStatusBar1: TJvStatusBar; 55 | Panel1: TPanel; 56 | actSearchPicker: TAction; 57 | procedure FormCreate(Sender: TObject); 58 | procedure actHideLauncherExecute(Sender: TObject); 59 | procedure FormShow(Sender: TObject); 60 | procedure FormDestroy(Sender: TObject); 61 | procedure FormResize(Sender: TObject); 62 | procedure actSearchPickerExecute(Sender: TObject); 63 | procedure ACLImageComboBox1Change(Sender: TObject); 64 | private 65 | { Private declarations } 66 | SearchEdit1: TSearchSynEdit; 67 | procedure PasteProcessed(Sender: TObject; var Key: Word; Shift: TShiftState); 68 | procedure CreateParams(var Params: TCreateParams); override; 69 | procedure Launch(Sender: TObject); 70 | public 71 | { Public declarations } 72 | end; 73 | 74 | var 75 | formLauncher: TformLauncher; 76 | // CF_HTML: WORD; 77 | 78 | implementation 79 | 80 | uses 81 | functions, pngimage, functions.windowfocus, ShellApi, uChildForm, System.NetEncoding, frmChatWebView; 82 | 83 | {$R *.dfm} 84 | 85 | procedure HandleClipboardImage; 86 | var 87 | CF_PNG, CF_DIBV5: UINT; 88 | Data: THandle; 89 | Ptr: Pointer; 90 | Size: NativeUInt; 91 | Png: TPngImage; 92 | Bitmap: TBitmap; 93 | begin 94 | CF_PNG := RegisterClipboardFormat('PNG'); 95 | CF_DIBV5 := RegisterClipboardFormat('CF_DIBV5'); // Ensure compatibility 96 | 97 | Clipboard.Open; 98 | try 99 | // Check for PNG format 100 | if Clipboard.HasFormat(CF_PNG) then 101 | begin 102 | Data := Clipboard.GetAsHandle(CF_PNG); 103 | if Data <> 0 then 104 | begin 105 | Ptr := GlobalLock(Data); 106 | try 107 | Size := GlobalSize(Data); 108 | if Size > 0 then 109 | begin 110 | Png := TPngImage.Create; 111 | try 112 | // Png.LoadFromStream(TMemoryStream.CreateFromBuffer(Ptr, Size)); 113 | // Do something with the PNG (e.g., save or display) 114 | Png.SaveToFile('clipboard_image.png'); 115 | ShowMessage('PNG image saved with transparency.'); 116 | finally 117 | Png.Free; 118 | end; 119 | end; 120 | finally 121 | GlobalUnlock(Data); 122 | end; 123 | end; 124 | end 125 | // Fallback to CF_DIBV5 126 | else if Clipboard.HasFormat(CF_DIBV5) then 127 | begin 128 | Data := Clipboard.GetAsHandle(CF_DIBV5); 129 | if Data <> 0 then 130 | begin 131 | Ptr := GlobalLock(Data); 132 | try 133 | // Convert DIBV5 to a Delphi TBitmap with transparency 134 | Bitmap := TBitmap.Create; 135 | try 136 | Bitmap.PixelFormat := pf32bit; 137 | Bitmap.Handle := CreateDIBitmap(GetDC(0), PBitmapInfoHeader(Ptr)^, CBM_INIT, Ptr, 138 | PBitmapInfo(Ptr)^, DIB_RGB_COLORS); 139 | Bitmap.SaveToFile('clipboard_image.bmp'); 140 | ShowMessage('Bitmap with alpha saved.'); 141 | finally 142 | Bitmap.Free; 143 | end; 144 | finally 145 | GlobalUnlock(Data); 146 | end; 147 | end; 148 | end 149 | else 150 | ShowMessage('No supported image format found on clipboard.'); 151 | finally 152 | Clipboard.Close; 153 | end; 154 | end; 155 | 156 | procedure TformLauncher.ACLImageComboBox1Change(Sender: TObject); 157 | begin 158 | if Assigned(SearchEdit1) then 159 | SearchEdit1.SetFocus; 160 | end; 161 | 162 | procedure TformLauncher.actHideLauncherExecute(Sender: TObject); 163 | begin 164 | 165 | Hide; 166 | end; 167 | 168 | procedure TformLauncher.actSearchPickerExecute(Sender: TObject); 169 | begin 170 | ACLImageComboBox1.SetFocus; 171 | SendMessage(ACLImageComboBox1.Handle, WM_KEYDOWN, VK_F4, 0); 172 | SendMessage(ACLImageComboBox1.Handle, WM_KEYUP, VK_F4, 0); 173 | end; 174 | 175 | procedure TformLauncher.CreateParams(var Params: TCreateParams); 176 | begin 177 | inherited CreateParams(Params); 178 | Params.WinClassName := 'AIChatbarWndL'; 179 | end; 180 | 181 | procedure TformLauncher.FormCreate(Sender: TObject); 182 | begin 183 | EnableNCShadow(Handle); 184 | SetDarkMode(Handle, True); 185 | 186 | // CF_HTML := RegisterClipboardFormat('HTML Format'); 187 | 188 | SearchEdit1 := TSearchSynEdit.Create(Self); 189 | SearchEdit1.Parent := formLauncher; 190 | SearchEdit1.Align := alTop; 191 | SearchEdit1.Color := $2c2c2c; 192 | SearchEdit1.Font.Color := $dcdcdc; 193 | SearchEdit1.AlignWithMargins := True; 194 | SearchEdit1.OnKeyDown := PasteProcessed; 195 | SearchEdit1.OnInvokeSearch := Launch; 196 | SearchEdit1.SearchTrigger := stCtrlEnter; 197 | SearchEdit1.ExpandedHeight := ClientHeight - SearchEdit1.Height; 198 | SearchEdit1.RightEdge := 0; 199 | SearchEdit1.Highlighter := SynMultiSyn1; 200 | SearchEdit1.TabOrder := 0; 201 | end; 202 | 203 | procedure TformLauncher.FormDestroy(Sender: TObject); 204 | begin 205 | SearchEdit1.Free; 206 | end; 207 | 208 | procedure TformLauncher.FormResize(Sender: TObject); 209 | begin 210 | if ClientHeight > SearchEdit1.Height then 211 | SearchEdit1.ExpandedHeight := ClientHeight - SearchEdit1.Height; 212 | end; 213 | 214 | procedure TformLauncher.FormShow(Sender: TObject); 215 | begin 216 | // AnimateWindow(Handle, 150, AW_ACTIVATE or AW_CENTER or AW_SLIDE); 217 | // SetForegroundWindow(Handle); 218 | TWindowFocusHelper.FocusWindow(Handle); 219 | end; 220 | 221 | function PassMultilineTextToURLParam(const MultilineText: string): string; 222 | begin 223 | Result := TNetEncoding.URL.Encode(MultilineText); 224 | end; 225 | 226 | procedure TformLauncher.Launch(Sender: TObject); 227 | var 228 | TempChildForm : TChildForm; 229 | queryStr: string; 230 | formattedText: string; 231 | navigateToURL: Boolean; 232 | begin 233 | if SearchEdit1.Lines.Count = 1 then 234 | begin 235 | if (Pos('http://',SearchEdit1.Text) = 1) or 236 | (Pos('https://', SearchEdit1.Text) = 1) then 237 | begin 238 | navigateToURL := True; 239 | queryStr := SearchEdit1.Text 240 | end 241 | else 242 | navigateToURL := False; 243 | end; 244 | 245 | if not navigateToURL then 246 | begin 247 | formattedText := PassMultilineTextToURLParam(SearchEdit1.Text); 248 | case ACLImageComboBox1.SelectedItem.Tag of 249 | 0: 250 | begin 251 | queryStr := 'https://chatgpt.com/?q='+formattedText+'&ref=ext&model=auto'; 252 | end; 253 | 1: 254 | begin 255 | queryStr := 'https://chatgpt.com/?q='+formattedText+'&ref=ext&model=auto&temporary-chat=true'; 256 | end; 257 | 2: 258 | begin 259 | queryStr := 'https://claude.ai/new?q='+formattedText; 260 | end; 261 | 3: 262 | begin 263 | queryStr := 'https://www.perplexity.ai/search?q='+formattedText; 264 | end; 265 | 4: 266 | begin 267 | queryStr := 'https://huggingface.co/chat?q='+formattedText; 268 | end; 269 | 5: 270 | begin 271 | queryStr := 'https://you.com/search?q='+formattedText+'&fromSearchBar=true&tbm=youchat'; 272 | end; 273 | 6: 274 | begin 275 | queryStr := 'https://search.brave.com/search?q='+formattedText; 276 | end; 277 | end; 278 | end; 279 | // if Assigned(mainBrowser) and (mainBrowser.CardPanel1.CardCount > 0) then 280 | if not chkDefaultBrowser.Checked then 281 | begin 282 | TempChildForm := TChildForm.Create(Self, queryStr); 283 | TempChildForm.Show; 284 | end 285 | else 286 | ShellExecute(0, 'OPEN', PChar(queryStr), nil, nil, SW_SHOW); 287 | Hide; 288 | end; 289 | 290 | procedure TformLauncher.PasteProcessed(Sender: TObject; var Key: Word; 291 | Shift: TShiftState); 292 | begin 293 | if (Key = 86) and (Shift = [ssCtrl, ssShift]) then 294 | begin 295 | SearchEdit1.SelText := TSearchSynedit.GetClipboardHTMLContent; 296 | Key := 0; 297 | end; 298 | end; 299 | 300 | function TSearchBox.GetClipboardHTMLContent: string; 301 | var 302 | CF_HTML: Word; 303 | Data: THandle; 304 | Ptr: Pointer; 305 | Size: NativeUInt; 306 | utf8: UTF8String; 307 | begin 308 | Result := ''; 309 | CF_HTML := RegisterClipboardFormat('HTML Format'); 310 | 311 | Clipboard.Open; 312 | try 313 | Data := Clipboard.GetAsHandle(CF_HTML); 314 | if Data = 0 then 315 | Exit; // No HTML data on the clipboard 316 | 317 | Ptr := GlobalLock(Data); 318 | try 319 | if Assigned(Ptr) then 320 | begin 321 | Size := GlobalSize(Data); 322 | if Size > 0 then 323 | begin 324 | SetString(utf8, PAnsiChar(Ptr), Size - 1); // Extract UTF-8 content 325 | Result := string(utf8); // Convert to a Delphi string 326 | end; 327 | end; 328 | finally 329 | GlobalUnlock(Data); 330 | end; 331 | finally 332 | Clipboard.Close; 333 | end; 334 | end; 335 | 336 | { TSearchBox2 } 337 | 338 | procedure TSearchBox.WMPaste(var Message: TWMPaste); 339 | var 340 | HtmlContent: string; 341 | begin 342 | HtmlContent := GetClipboardHTMLContent; 343 | 344 | if HtmlContent <> '' then 345 | begin 346 | formLauncher.HtmlViewer1.LoadFromString(HtmlContent); 347 | end 348 | else 349 | inherited; 350 | end; 351 | 352 | end. 353 | -------------------------------------------------------------------------------- /frmTaskGPT.dfm: -------------------------------------------------------------------------------- 1 | object taskForm: TtaskForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'TaskGPT - A ChatGPT System Assistant' 5 | ClientHeight = 310 6 | ClientWidth = 565 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | Padding.Left = 8 14 | Padding.Top = 8 15 | Padding.Right = 8 16 | Padding.Bottom = 8 17 | Position = poScreenCenter 18 | OnCreate = FormCreate 19 | OnDestroy = FormDestroy 20 | TextHeight = 15 21 | object Label1: TLabel 22 | Left = 8 23 | Top = 8 24 | Width = 549 25 | Height = 15 26 | Align = alTop 27 | Caption = 28 | 'TaskGPT is a ChatGPT based AI assitant that will launch applicat' + 29 | 'ions and do some scripting for you.' 30 | ExplicitWidth = 519 31 | end 32 | object SearchBox1: TSearchBox 33 | Left = 8 34 | Top = 279 35 | Width = 549 36 | Height = 23 37 | Align = alBottom 38 | TabOrder = 0 39 | TextHint = 'Write your desired action on your PC' 40 | end 41 | object grpTaskAnswer: TGroupBox 42 | AlignWithMargins = True 43 | Left = 8 44 | Top = 31 45 | Width = 549 46 | Height = 240 47 | Margins.Left = 0 48 | Margins.Top = 8 49 | Margins.Right = 0 50 | Margins.Bottom = 8 51 | Align = alClient 52 | Caption = 'ChatGPT Answer' 53 | TabOrder = 1 54 | DesignSize = ( 55 | 549 56 | 240) 57 | object Label2: TLabel 58 | Left = 16 59 | Top = 32 60 | Width = 63 61 | Height = 15 62 | Caption = 'Description:' 63 | end 64 | object Label3: TLabel 65 | Left = 16 66 | Top = 72 67 | Width = 38 68 | Height = 15 69 | Caption = 'Action:' 70 | end 71 | object Label4: TLabel 72 | Left = 16 73 | Top = 112 74 | Width = 65 75 | Height = 15 76 | Caption = 'Safety Level:' 77 | end 78 | object Label5: TLabel 79 | Left = 16 80 | Top = 200 81 | Width = 359 82 | Height = 15 83 | Caption = 84 | 'Autoexecute '#55357#56999' This might be undoable, be cautios of what you as' + 85 | 'k:' 86 | end 87 | object Button1: TButton 88 | Left = 452 89 | Top = 199 90 | Width = 75 91 | Height = 25 92 | Anchors = [akRight, akBottom] 93 | Caption = 'Execute' 94 | TabOrder = 0 95 | OnClick = Button1Click 96 | end 97 | object ToggleSwitch1: TToggleSwitch 98 | Left = 394 99 | Top = 200 100 | Width = 73 101 | Height = 20 102 | TabOrder = 1 103 | end 104 | end 105 | object ActionList1: TActionList 106 | Left = 280 107 | Top = 160 108 | object actHideTask: TAction 109 | Caption = 'actHideTask' 110 | ShortCut = 27 111 | OnExecute = actHideTaskExecute 112 | end 113 | end 114 | end 115 | -------------------------------------------------------------------------------- /frmTaskGPT.pas: -------------------------------------------------------------------------------- 1 | unit frmTaskGPT; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.WinXCtrls, 8 | System.Net.HttpClient, System.Actions, Vcl.ActnList; 9 | 10 | type 11 | TtaskForm = class(TForm) 12 | SearchBox1: TSearchBox; 13 | Label1: TLabel; 14 | grpTaskAnswer: TGroupBox; 15 | Label2: TLabel; 16 | Label3: TLabel; 17 | Label4: TLabel; 18 | Button1: TButton; 19 | ToggleSwitch1: TToggleSwitch; 20 | Label5: TLabel; 21 | ActionList1: TActionList; 22 | actHideTask: TAction; 23 | procedure Button1Click(Sender: TObject); 24 | procedure FormCreate(Sender: TObject); 25 | procedure FormDestroy(Sender: TObject); 26 | procedure actHideTaskExecute(Sender: TObject); 27 | private 28 | FBearer: string; 29 | FCookies: TCookieManager; 30 | FUserAgent: string; 31 | { Private declarations } 32 | public 33 | { Public declarations } 34 | function SwitchCustomInstructions: Boolean; 35 | function RestoreCustomInstructions: Boolean; 36 | function AskGPT(const query: string): Boolean; 37 | function GetAccessToken: string; 38 | 39 | property Bearer: string read FBearer write FBearer; 40 | property Cookies: TCookieManager read FCookies write FCookies; 41 | property UserAgent: string read FUserAgent write FUserAgent; 42 | end; 43 | 44 | var 45 | taskForm: TtaskForm; 46 | 47 | implementation 48 | 49 | {$R *.dfm} 50 | 51 | uses 52 | System.JSON, frmChatWebView; 53 | 54 | const 55 | //GET (to obtain current) or POST, and should return 200 with Authorization: Bearer 56 | // Content-Type: application/json UA and Cookies 57 | POST_FETCH_ENDPOINT = 'https://chat.openai.com/backend-api/user_system_messages'; 58 | 59 | ABOUT_MODEL_MESSAGE = 'You''re an expert Windows user, and your answers should be in json format in the ' + 60 | 'following manner: ' + 61 | '{ ' + 62 | '"task": "Open control panel", ' + 63 | '"commandLine": "control.exe", ' + 64 | '"description": "This command line opens de control panel", ' + 65 | '"evelationRequired": "false", ' + 66 | '"warningType": "safe", ' + 67 | '"warningDesc": "The current task is safe, doesn''t modify anything right away, on' + 68 | 'ly after executed depending of what the user does" ' + 69 | '} ' + 70 | 'Important: if task couldn''t be done, state that as "not possible, but give sugge' + 71 | 'stions", and use Windows'' default environment variables to get special folders, ' + 72 | 'you can use PowerShell inline scripts too. '; 73 | 74 | ABOUT_USER_MESSAGE = 'Give me answers only in json format, not other formatting allowed, never answer ' + 75 | 'in other format. '; 76 | //Answers like this 77 | { 78 | "object": "user_system_message_detail", 79 | "enabled": true, 80 | "about_user_message": "Give me answers only in json format, not other formatting allowed, never answer in other format.", 81 | "about_model_message": "You're an expert ..." 82 | } 83 | 84 | procedure TtaskForm.actHideTaskExecute(Sender: TObject); 85 | begin 86 | Hide; 87 | end; 88 | 89 | function TtaskForm.AskGPT(const query: string): Boolean; 90 | begin 91 | 92 | end; 93 | 94 | procedure TtaskForm.Button1Click(Sender: TObject); 95 | begin 96 | if SwitchCustomInstructions then 97 | try 98 | AskGPT(SearchBox1.Text) 99 | finally 100 | if not RestoreCustomInstructions then 101 | raise Exception.Create('Error restoring your custom instructions!'); 102 | end; 103 | end; 104 | 105 | procedure TtaskForm.FormCreate(Sender: TObject); 106 | begin 107 | FUserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/116.0.0.0 Safari/537.36 Edg/116.0.0.0'; 108 | FCookies := TCookieManager.Create; 109 | end; 110 | 111 | procedure TtaskForm.FormDestroy(Sender: TObject); 112 | begin 113 | FCookies.Destroy; 114 | end; 115 | 116 | function TtaskForm.GetAccessToken: string; 117 | var 118 | http: THTTPClient; 119 | resp: IHTTPResponse; 120 | data: TStringStream; 121 | begin 122 | Result := ''; 123 | http := THTTPClient.Create; 124 | data := TStringStream.Create; 125 | try 126 | http.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:109.0) Gecko/20100101 Firefox/117.0'; 127 | //http.CookieManager := frmChatWebView.mainBrowser.GetGPTCookies; 128 | http.ConnectionTimeout := 3000; // 3 seconds 129 | http.CustomHeaders['Accept'] := '*/*'; 130 | http.CustomHeaders['Accept-Encoding'] := 'gzip, deflate, br'; 131 | http.CustomHeaders['Cache-Control'] := 'no-cache'; 132 | http.CustomHeaders['Connection'] := 'keep-alive'; 133 | http.CustomHeaders['Host'] := 'chat.openai.com'; 134 | http.CustomHeaders['Pragma'] := 'no-cache'; 135 | http.CustomHeaders['Sec-Fetch-Dest'] := 'emtpy'; 136 | http.CustomHeaders['Sec-Fetch-Mode'] := 'cors'; 137 | http.CustomHeaders['Sec-Fetch-Site'] := 'same-origin'; 138 | 139 | resp := http.Get('https://chat.openai.com/api/auth/session', data); 140 | if resp.StatusCode = 200 then 141 | begin 142 | var json := TJSONObject.Create; 143 | try 144 | if json.Parse(data.Bytes, 0) > 0 then // valid json 145 | begin 146 | if json.FindValue('accessToken') <> nil then 147 | begin 148 | Result := json.Values['accessToken'].Value; 149 | end; 150 | end; 151 | 152 | finally 153 | json.Free; 154 | end; 155 | 156 | end 157 | else if resp.StatusCode = 403 then 158 | begin 159 | ShowMessage('You need to pass the Cloudflare protection. Please open the ChatGPT instance.'); 160 | end 161 | 162 | else 163 | raise Exception.Create(PChar('Error trying to get the access token, you should login first to ChatGPT:'#13#10#13#10 + data.ToString)); 164 | finally 165 | data.Free; 166 | http.Free; 167 | end; 168 | end; 169 | 170 | function TtaskForm.RestoreCustomInstructions: Boolean; 171 | begin 172 | 173 | end; 174 | 175 | function TtaskForm.SwitchCustomInstructions: Boolean; 176 | var 177 | http: THTTPClient; 178 | resp: IHTTPResponse; 179 | data: TStringStream; 180 | begin 181 | Result := False; 182 | http := THTTPClient.Create; 183 | data := TStringStream.Create; 184 | try 185 | http.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:109.0) Gecko/20100101 Firefox/117.0'; 186 | http.CookieManager := frmChatWebView.mainBrowser.GetGPTCookies; 187 | http.ConnectionTimeout := 3000; // 3 seconds 188 | http.CustomHeaders['Authorization'] := 'Bearer'+FBearer; 189 | 190 | resp := http.Get('https://chat.openai.com/backend-api/user_system_messages', data); 191 | if resp.StatusCode = 200 then 192 | begin 193 | var json := TJSONObject.Create; 194 | try 195 | if json.Parse(data.Bytes, 0) > 0 then // valid json 196 | begin 197 | if json.FindValue('about_user_message') <> nil then 198 | begin 199 | ShowMessage(json.Values['about_user_message'].Value); 200 | end; 201 | end; 202 | 203 | finally 204 | json.Free; 205 | end; 206 | 207 | end 208 | else if resp.StatusCode = 403 then 209 | begin 210 | ShowMessage('You need to pass the Cloudflare protection. Please open the ChatGPT instance.'); 211 | end 212 | 213 | else 214 | raise Exception.Create(PChar('Error trying to get the access token, you should login first to ChatGPT:'#13#10#13#10 + data.ToString)); 215 | finally 216 | data.Free; 217 | http.Free; 218 | end; 219 | end; 220 | 221 | end. 222 | -------------------------------------------------------------------------------- /functions.pas: -------------------------------------------------------------------------------- 1 | unit functions; 2 | 3 | interface 4 | 5 | uses ComObj, TlHelp32, SysUtils, Windows, Registry, Forms, Winapi.DwmApi, Vcl.Graphics, PsAPI; 6 | 7 | procedure ShowDesktop; 8 | procedure DisableTaskMgr(bTF: Boolean); 9 | procedure HideWindows7MenuBar; 10 | function KillTask(FileName: String): integer; 11 | 12 | procedure DisableKeys; 13 | procedure EnableKeys; 14 | function IdleTime: DWord; 15 | function LastWork: DWord; 16 | function IsFullScreenAppRunning: Boolean; 17 | 18 | procedure PerformAltTab; 19 | procedure PerformCtrlAltTab; 20 | procedure PerformF11; 21 | procedure TaskBarSwitcher; 22 | procedure AutomaticSize; 23 | procedure DefaultSize; 24 | 25 | function AppIsResponding(const app: HWND): Boolean; 26 | 27 | // multimonito functions 28 | function GetLeftMost: integer; 29 | function GetRightMost: integer; 30 | function GetBottomMost: integer; 31 | 32 | function isAcrylicSupported:boolean; 33 | function isWindows11: boolean; 34 | procedure EnableBlur(Wnd: HWND; Enable: Boolean = True); 35 | procedure EnableNCShadow(Wnd: HWND); 36 | function TaskbarAccented:Boolean; 37 | function GetAccentColor:TColor; 38 | function SystemUsesLightTheme:boolean; 39 | function BlendColors(Col1, Col2: TColor; A: Byte): TColor; 40 | function CreateSolidBrushWithAlpha(Color: TColor; Alpha: Byte = $FF): HBRUSH; 41 | function GetRAMUsage: Int64; 42 | 43 | function IsAutostartEnabled(const AppName: string): Boolean; 44 | procedure SetAutostartEnabled(const AppName: string; Enable: Boolean); 45 | 46 | implementation 47 | 48 | const 49 | RegKey_Run = 'Software\Microsoft\Windows\CurrentVersion\Run'; 50 | 51 | 52 | type 53 | AccentPolicy = packed record 54 | AccentState: Integer; 55 | AccentFlags: Integer; 56 | GradientColor: Integer; 57 | AnimationId: Integer; 58 | end; 59 | 60 | TWinCompAttrData = packed record 61 | attribute: THandle; 62 | pData: Pointer; 63 | dataSize: ULONG; 64 | end; 65 | 66 | var 67 | KeyBoardHook: HHOOK; 68 | AltTabItems: integer; 69 | 70 | function SetWindowCompositionAttribute(Wnd: HWND; const AttrData: TWinCompAttrData): BOOL; stdcall; 71 | external user32 Name 'SetWindowCompositionAttribute'; 72 | function RtlGetVersion(var RTL_OSVERSIONINFOEXW): LONG; stdcall; 73 | external 'ntdll.dll' Name 'RtlGetVersion'; 74 | 75 | procedure ShowDesktop; 76 | var 77 | shelll: OleVariant; 78 | begin 79 | shelll := CreateOleObject('Shell.Application'); 80 | 81 | shelll.MinimizeAll; 82 | 83 | end; 84 | 85 | procedure PerformAltTab; 86 | var 87 | shelll: OleVariant; 88 | begin 89 | // shelll:=CreateOleObject('Shell.Application'); 90 | shelll := CreateOleObject('WScript.Shell'); 91 | shelll.SendKeys('%+{TAB}'); 92 | // shelll.MinimizeAll; 93 | // shelll.WindowSwitcher; 94 | end; 95 | 96 | procedure PerformCtrlAltTab; 97 | var 98 | shelll: OleVariant; 99 | begin 100 | // shelll:=CreateOleObject('Shell.Application'); 101 | shelll := CreateOleObject('WScript.Shell'); 102 | shelll.SendKeys('^(%{TAB})'); 103 | // shelll.MinimizeAll; 104 | // shelll.WindowSwitcher; 105 | end; 106 | 107 | procedure PerformF11; 108 | var 109 | shelll: OleVariant; 110 | begin 111 | shelll := CreateOleObject('WScript.Shell'); 112 | shelll.SendKeys('{F11}'); 113 | end; 114 | 115 | procedure HideWindows7MenuBar; 116 | begin 117 | 118 | end; 119 | 120 | // works with registry use with care 121 | // http://www.delphifaq.com/faq/delphi_windows_API/f346.shtml 122 | // usage: true to disable and false to enable 123 | procedure DisableTaskMgr(bTF: Boolean); 124 | var 125 | reg: TRegistry; 126 | begin 127 | reg := TRegistry.Create; 128 | try 129 | reg.RootKey := HKEY_CURRENT_USER; 130 | reg.OpenKey 131 | ('Software\Microsoft\Windows\CurrentVersion\Policies\System', True); 132 | if bTF = True then 133 | begin 134 | reg.WriteString('DisableTaskMgr', '1'); 135 | end 136 | else if bTF = False then 137 | begin 138 | // reg.DeleteValue('DisableTaskMgr'); 139 | reg.WriteString('DisableTaskMgr', '0'); 140 | end; 141 | finally 142 | reg.CloseKey; 143 | reg.Free; 144 | end; 145 | end; 146 | 147 | function KillTask(FileName: String): integer; 148 | var 149 | ContinueLoop: Boolean; 150 | FSnapshotHandle: THandle; 151 | FProcessEntry32: TProcessEntry32; 152 | const 153 | PROCESS_TERMINATE = $0001; 154 | begin 155 | FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 156 | FProcessEntry32.dwSize := Sizeof(FProcessEntry32); 157 | ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); 158 | while integer(ContinueLoop) <> 0 do 159 | begin 160 | if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) 161 | = UpperCase(FileName)) or (UpperCase(FProcessEntry32.szExeFile) 162 | = UpperCase(FileName))) then 163 | 164 | Result := integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), 165 | 166 | FProcessEntry32.th32ProcessID), 0)); 167 | ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); 168 | end; 169 | CloseHandle(FSnapshotHandle); 170 | end; 171 | 172 | function LowLevelKeyboardProc(nCode: integer; wParam: wParam; lParam: lParam) 173 | : LRESULT; stdcall; 174 | type 175 | PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT; 176 | 177 | TKBDLLHOOKSTRUCT = record 178 | vkCode: cardinal; 179 | scanCode: cardinal; 180 | flags: cardinal; 181 | time: cardinal; 182 | dwExtraInfo: cardinal; 183 | end; 184 | 185 | PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct; 186 | TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT; 187 | const 188 | LLKHF_ALTDOWN = $20; 189 | var 190 | hs: PKeyboardLowLevelHookStruct; 191 | ctrlDown: Boolean; 192 | begin 193 | 194 | if nCode = HC_ACTION then 195 | begin 196 | 197 | hs := PKeyboardLowLevelHookStruct(lParam); 198 | ctrlDown := GetAsyncKeyState(VK_CONTROL) and $8000 <> 0; 199 | if (hs^.vkCode = VK_ESCAPE) and ctrlDown then 200 | Exit(1); 201 | if (hs^.vkCode = VK_TAB) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then 202 | Exit(1); 203 | if (hs^.vkCode = VK_TAB) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) and ctrlDown 204 | then 205 | Exit(1); 206 | if (hs^.vkCode = VK_ESCAPE) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then 207 | Exit(1); 208 | if (hs^.vkCode = VK_LWIN) or (hs^.vkCode = VK_RWIN) then 209 | Exit(1); 210 | 211 | end; 212 | 213 | Result := CallNextHookEx(0, nCode, wParam, lParam); 214 | 215 | end; 216 | 217 | procedure DisableKeys; 218 | const 219 | WH_KEYBOARD_LL = 13; 220 | begin 221 | KeyBoardHook := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, 0, 0); 222 | end; 223 | 224 | procedure EnableKeys; 225 | const 226 | WH_KEYBOARD_LL = 13; 227 | begin 228 | UnhookWindowsHookEx(KeyBoardHook); 229 | end; 230 | 231 | // http://www.delphitips.net/2007/11/11/how-to-detect-system-idle-time/ 232 | function IdleTime: DWord; 233 | var 234 | LastInput: TLastInputInfo; 235 | begin 236 | LastInput.cbSize := Sizeof(TLastInputInfo); 237 | GetLastInputInfo(LastInput); 238 | Result := (GetTickCount - LastInput.dwTime) DIV 1000; 239 | end; 240 | 241 | function LastWork: DWord; 242 | var 243 | LInput: TLastInputInfo; 244 | iTicksNow, iResult: DWord; 245 | begin 246 | LInput.cbSize := Sizeof(TLastInputInfo); 247 | GetLastInputInfo(LInput); 248 | iTicksNow := GetTickCount; 249 | 250 | // The result of GetTickCount will wrap around to zero if 251 | // Windows is run continuously for 49.7 days. 252 | 253 | if LInput.dwTime <= iTicksNow then 254 | iResult := iTicksNow - LInput.dwTime 255 | else 256 | iResult := (high(DWord) - LInput.dwTime) + iTicksNow; 257 | 258 | Result := iResult; 259 | end; 260 | 261 | function IsFullScreenAppRunning: Boolean; 262 | var 263 | rc: trect; 264 | hw: HWND; 265 | begin 266 | hw := GetForegroundWindow; 267 | GetWindowRect(hw, rc); 268 | if (rc.Right - rc.Left = GetSystemMetrics(SM_CXFULLSCREEN)) and 269 | (rc.Bottom - rc.Top = GetSystemMetrics(SM_CYFULLSCREEN)) then 270 | Result := True 271 | else 272 | Result := False; 273 | end; 274 | 275 | function AltTabCount(gHandle: HWND; lowparam: pointer): Boolean stdcall; 276 | var 277 | caption: array [0 .. 256] of char; 278 | dwStyle, dwexStyle: longint; 279 | begin 280 | dwStyle := GetWindowLongPtr(gHandle, GWL_STYLE); 281 | dwexStyle := GetWindowLongPtr(gHandle, GWL_EXSTYLE); 282 | if (dwStyle and WS_VISIBLE = WS_VISIBLE) and 283 | (GetWindowText(gHandle, caption, Sizeof(caption) - 1) <> 0) and 284 | (GetParent(gHandle) = 0) and (gHandle <> application.Handle) { exclude me } 285 | then 286 | begin 287 | if ((dwexStyle and WS_EX_APPWINDOW = WS_EX_APPWINDOW) and 288 | (GetWindow(gHandle, GW_OWNER) = gHandle)) or 289 | ((dwexStyle and WS_EX_TOOLWINDOW = 0) and 290 | (GetWindow(gHandle, GW_OWNER) = 0)) 291 | // * Escondido cuando se quiere mostrar todos las ventanas 292 | then 293 | Inc(AltTabItems); 294 | end; 295 | Result := True; 296 | end; 297 | 298 | // ** Set the Alt Tab Switcher Thumbnail Size **// 299 | procedure AutomaticSize; 300 | var 301 | reg: TRegistry; 302 | begin 303 | reg := TRegistry.Create; 304 | try 305 | reg.RootKey := HKEY_CURRENT_USER; 306 | reg.CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\AltTab'); 307 | if reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\AltTab', 308 | True) then 309 | begin 310 | AltTabItems := 0; 311 | EnumWindows(@AltTabCount, 0); 312 | // Screen.Width div AltTabItems - 24 313 | if AltTabItems > 6 then 314 | AltTabItems := 6; 315 | 316 | reg.WriteInteger('MinThumbSizePcent', 100); 317 | reg.WriteInteger('MaxThumbSizePx', 318 | Screen.Width div (AltTabItems + 1) - 24); 319 | reg.CloseKey; 320 | end; 321 | finally 322 | reg.Free; 323 | end; 324 | 325 | end; 326 | 327 | // ** Set the Alt Tab Switcher Thumbnail Size to default **// 328 | procedure DefaultSize; 329 | var 330 | reg: TRegistry; 331 | begin 332 | reg := TRegistry.Create; 333 | try 334 | reg.RootKey := HKEY_CURRENT_USER; 335 | reg.CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\AltTab'); 336 | if reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\AltTab', 337 | False) then 338 | begin 339 | reg.DeleteValue('MinThumbSizePcent'); 340 | reg.DeleteValue('MaxThumbSizePx'); 341 | reg.CloseKey; 342 | end; 343 | finally 344 | reg.Free; 345 | end; 346 | 347 | end; 348 | 349 | procedure TaskBarSwitcher; 350 | begin 351 | keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0); 352 | Sleep(10); 353 | keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0); 354 | Sleep(10); 355 | keybd_event(VK_TAB, MapVirtualKey(VK_TAB, 0), 0, 0); 356 | Sleep(10); 357 | keybd_event(VK_TAB, MapVirtualKey(VK_TAB, 0), KEYEVENTF_KEYUP, 0); 358 | Sleep(100); 359 | keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0); 360 | Sleep(100); 361 | keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0); 362 | // PerformCtrlAltTab; 363 | Sleep(100); 364 | end; 365 | 366 | // http://delphiptt.blogspot.com/2009/05/how-detect-if-application-has-stopped.html 367 | function AppIsResponding(const app: HWND): Boolean; 368 | const 369 | WM_NULL = $0000; 370 | var 371 | lngReturnValue: longint; 372 | DWResult: DWord; 373 | begin 374 | lngReturnValue := SendMessageTimeout(app, WM_NULL, 0, 0, SMTO_ABORTIFHUNG and 375 | SMTO_BLOCK, 1000, @DWResult); 376 | if lngReturnValue > 0 then 377 | Result := True 378 | else 379 | Result := False; 380 | end; 381 | 382 | // leftmost if multimonitor 383 | function GetLeftMost: integer; 384 | var 385 | leftmost: integer; 386 | I: integer; 387 | begin 388 | for I := 0 to Screen.MonitorCount - 1 do 389 | begin 390 | if I = 0 then 391 | leftmost := Screen.Monitors[I].Left 392 | else if Screen.Monitors[I].Left < leftmost then 393 | leftmost := Screen.Monitors[I].Left; 394 | end; 395 | Result := leftmost; 396 | end; 397 | 398 | function GetRightMost: integer; 399 | var 400 | rightmost: integer; 401 | I: integer; 402 | begin 403 | for I := 0 to Screen.MonitorCount - 1 do 404 | begin 405 | if I = 0 then 406 | rightmost := Screen.Monitors[I].Left + Screen.Monitors[I].Width 407 | else if Screen.Monitors[I].Left + Screen.Monitors[I].Width > rightmost then 408 | rightmost := Screen.Monitors[I].Left + Screen.Monitors[I].Width; 409 | end; 410 | Result := rightmost; 411 | end; 412 | 413 | function GetBottomMost: integer; 414 | var 415 | bottommost: integer; 416 | I: integer; 417 | begin 418 | for I := 0 to Screen.MonitorCount - 1 do 419 | begin 420 | if I = 0 then 421 | bottommost := Screen.Monitors[I].Height 422 | else if Screen.Monitors[I].Height > bottommost then 423 | bottommost := Screen.Monitors[I].Height; 424 | end; 425 | Result := bottommost; 426 | end; 427 | 428 | // Check Windows 10 RS4 version which onwards supports Acrylic Glass 429 | function isAcrylicSupported:boolean; 430 | var 431 | Reg: TRegistry; 432 | begin 433 | Result := False; 434 | 435 | Reg := TRegistry.Create; 436 | try 437 | Reg.RootKey := HKEY_LOCAL_MACHINE; 438 | if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion') then 439 | begin 440 | if Reg.ValueExists('CurrentVersion') then 441 | if (Reg.ReadString('CurrentVersion') = '6.3') 442 | and (StrToInt(Reg.ReadString('CurrentBuildNumber')) >= 17134) then 443 | Result := True; 444 | end; 445 | finally 446 | Reg.Free; 447 | end; 448 | end; 449 | 450 | function isWindows11:Boolean; 451 | var 452 | winver: RTL_OSVERSIONINFOEXW; 453 | begin 454 | Result := False; 455 | if ((RtlGetVersion(winver) = 0) and (winver.dwMajorVersion>=10) and (winver.dwBuildNumber > 22000)) then 456 | Result := True; 457 | end; 458 | 459 | procedure EnableBlur(Wnd: HWND; Enable: Boolean = True); 460 | const 461 | WCA_ACCENT_POLICY = 19; 462 | ACCENT_NORMAL = 0; 463 | ACCENT_ENABLE_GRADIENT = 1; 464 | ACCENT_ENABLE_TRANSPARENTGRADIENT = 2; 465 | ACCENT_ENABLE_BLURBEHIND = 3; 466 | ACCENT_ENABLE_ACRYLICBLURBEHIND = 4; 467 | DRAW_LEFT_BORDER = $20; 468 | DRAW_TOP_BORDER = $40; 469 | DRAW_RIGHT_BORDER = $80; 470 | DRAW_BOTTOM_BORDER = $100; 471 | DWMWCP_DEFAULT = 0; // Let the system decide whether or not to round window corners 472 | DWMWCP_DONOTROUND = 1; // Never round window corners 473 | DWMWCP_ROUND = 2; // Round the corners if appropriate 474 | DWMWCP_ROUNDSMALL = 3; // Round the corners if appropriate, with a small radius 475 | DWMWA_WINDOW_CORNER_PREFERENCE = 33; // [set] WINDOW_CORNER_PREFERENCE, Controls the policy that rounds top-level window corners 476 | var 477 | data: TWinCompAttrData; 478 | accent: AccentPolicy; 479 | begin 480 | if Enable then 481 | begin 482 | if isAcrylicSupported then 483 | accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND 484 | else 485 | accent.AccentState := ACCENT_ENABLE_BLURBEHIND 486 | end 487 | else 488 | accent.AccentState := ACCENT_NORMAL; 489 | accent.AccentFlags := DRAW_LEFT_BORDER or DRAW_TOP_BORDER or DRAW_RIGHT_BORDER or DRAW_BOTTOM_BORDER; 490 | 491 | data.attribute := WCA_ACCENT_POLICY; 492 | data.dataSize := SizeOf(accent); 493 | data.pData := @accent; 494 | SetWindowCompositionAttribute(Wnd, data); 495 | 496 | if isWindows11 then 497 | begin 498 | var DWM_WINDOW_CORNER_PREFERENCE: Cardinal; 499 | DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL; 500 | DwmSetWindowAttribute(Wnd, DWMWA_WINDOW_CORNER_PREFERENCE, @DWM_WINDOW_CORNER_PREFERENCE, sizeof(DWM_WINDOW_CORNER_PREFERENCE)); 501 | 502 | end; 503 | end; 504 | 505 | procedure EnableNCShadow(Wnd: HWND); 506 | const 507 | DWMWCP_DEFAULT = 0; // Let the system decide whether or not to round window corners 508 | DWMWCP_DONOTROUND = 1; // Never round window corners 509 | DWMWCP_ROUND = 2; // Round the corners if appropriate 510 | DWMWCP_ROUNDSMALL = 3; // Round the corners if appropriate, with a small radius 511 | DWMWA_WINDOW_CORNER_PREFERENCE = 33; // [set] WINDOW_CORNER_PREFERENCE, Controls the policy that rounds top-level window corners 512 | begin 513 | 514 | if isWindows11 then 515 | begin 516 | var DWM_WINDOW_CORNER_PREFERENCE: Cardinal; 517 | DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL; 518 | DwmSetWindowAttribute(Wnd, DWMWA_WINDOW_CORNER_PREFERENCE, @DWM_WINDOW_CORNER_PREFERENCE, sizeof(DWM_WINDOW_CORNER_PREFERENCE)); 519 | end; 520 | end; 521 | 522 | function TaskbarAccented:Boolean; 523 | var 524 | reg: TRegistry; 525 | begin 526 | Result := False; 527 | reg := TRegistry.Create; 528 | try 529 | reg.RootKey := HKEY_CURRENT_USER; 530 | reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize'); 531 | try 532 | if reg.ValueExists('ColorPrevalence') then 533 | if reg.ReadInteger('ColorPrevalence') = 1 then 534 | Result := True; 535 | except 536 | Result := False; 537 | end; 538 | reg.CloseKey; 539 | 540 | finally 541 | reg.Free; 542 | end; 543 | end; 544 | 545 | function GetAccentColor:TColor; 546 | var 547 | col: Cardinal; 548 | opaque: LongBool; 549 | newColor: TColor; 550 | a,r,g,b: byte; 551 | begin 552 | DwmGetColorizationColor(col, opaque); 553 | a := Byte(col shr 24); 554 | r := Byte(col shr 16); 555 | g := Byte(col shr 8); 556 | b := Byte(col); 557 | 558 | 559 | newcolor := RGB( 560 | round(r*(a/255)+255-a), 561 | round(g*(a/255)+255-a), 562 | round(b*(a/255)+255-a) 563 | ); 564 | 565 | Result := newcolor; 566 | end; 567 | 568 | 569 | // Checks whether registry value which registers system's light mode is on 570 | function SystemUsesLightTheme:boolean; 571 | var 572 | Reg: TRegistry; 573 | begin 574 | Result := False; 575 | 576 | Reg := TRegistry.Create; 577 | try 578 | Reg.RootKey := HKEY_CURRENT_USER; 579 | if Reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Themes\Personalize') then 580 | begin 581 | if Reg.ValueExists('SystemUsesLightTheme') then 582 | if (Reg.ReadInteger('SystemUsesLightTheme') = 1) then 583 | Result := True; 584 | end; 585 | finally 586 | Reg.Free; 587 | end; 588 | end; 589 | 590 | {Credits to Roy M Klever http://rmklever.com/?p=116} 591 | function BlendColors(Col1, Col2: TColor; A: Byte): TColor; 592 | var 593 | c1,c2: LongInt; 594 | r,g,b,v1,v2: byte; 595 | begin 596 | A := Round(2.55 * A); 597 | c1 := ColorToRGB(Col1); 598 | c2 := ColorToRGB(Col2); 599 | v1 := Byte(c1); 600 | v2 := Byte(c2); 601 | r := A * (v1 - v2) shr 8 + v2; 602 | v1 := Byte(c1 shr 8); 603 | v2 := Byte(c2 shr 8); 604 | g := A * (v1 - v2) shr 8 + v2; 605 | v1 := Byte(c1 shr 16); 606 | v2 := Byte(c2 shr 16); 607 | b := A * (v1 - v2) shr 8 + v2; 608 | Result := (b shl 16) + (g shl 8) + r; 609 | end; 610 | 611 | // Functions to create alpha channel aware brushes to paint on canvas 612 | // from Delphi Haven https://delphihaven.wordpress.com/2010/09/06/custom-drawing-on-glass-2/ 613 | function CreatePreMultipliedRGBQuad(Color: TColor; Alpha: Byte = $FF): TRGBQuad; 614 | begin 615 | Color := ColorToRGB(Color); 616 | Result.rgbBlue := MulDiv(GetBValue(Color), Alpha, $FF); 617 | Result.rgbGreen := MulDiv(GetGValue(Color), Alpha, $FF); 618 | Result.rgbRed := MulDiv(GetRValue(Color), Alpha, $FF); 619 | Result.rgbReserved := Alpha; 620 | end; 621 | function CreateSolidBrushWithAlpha(Color: TColor; Alpha: Byte = $FF): HBRUSH; 622 | var 623 | Info: TBitmapInfo; 624 | begin 625 | FillChar(Info, SizeOf(Info), 0); 626 | with Info.bmiHeader do 627 | begin 628 | biSize := SizeOf(Info.bmiHeader); 629 | biWidth := 1; 630 | biHeight := 1; 631 | biPlanes := 1; 632 | biBitCount := 32; 633 | biCompression := BI_RGB; 634 | end; 635 | Info.bmiColors[0] := CreatePreMultipliedRGBQuad(Color, Alpha); 636 | Result := CreateDIBPatternBrushPt(@Info, 0); 637 | end; 638 | 639 | 640 | function GetRAMUsage: Int64; 641 | var 642 | pmc: PROCESS_MEMORY_COUNTERS; 643 | begin 644 | Result := 0; 645 | if GetProcessMemoryInfo(GetCurrentProcess, @pmc, SizeOf(pmc)) then 646 | Result := pmc.WorkingSetSize; 647 | end; 648 | 649 | 650 | function IsAutostartEnabled(const AppName: string): Boolean; 651 | var 652 | Reg: TRegistry; 653 | begin 654 | Reg := TRegistry.Create; 655 | try 656 | Reg.RootKey := HKEY_CURRENT_USER; 657 | Result := Reg.OpenKeyReadOnly(RegKey_Run) and Reg.ValueExists(AppName); 658 | finally 659 | Reg.Free; 660 | end; 661 | end; 662 | 663 | procedure SetAutostartEnabled(const AppName: string; Enable: Boolean); 664 | var 665 | Reg: TRegistry; 666 | begin 667 | Reg := TRegistry.Create; 668 | try 669 | Reg.RootKey := HKEY_CURRENT_USER; 670 | if Enable then 671 | begin 672 | if Reg.OpenKey(RegKey_Run, True) then 673 | Reg.WriteString(AppName, ParamStr(0)); 674 | end 675 | else 676 | begin 677 | if Reg.OpenKey(RegKey_Run, False) then 678 | Reg.DeleteValue(AppName); 679 | end; 680 | finally 681 | Reg.Free; 682 | end; 683 | end; 684 | 685 | end. 686 | -------------------------------------------------------------------------------- /functions.rawinput.pas: -------------------------------------------------------------------------------- 1 | unit functions.rawinput; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Classes, TlHelp32, PsAPI, SysUtils, Registry, Graphics, DWMApi, PNGImage, 7 | OleAcc, Variants, DirectDraw, ActiveX, ShellAPI, Math, ShlObj; 8 | 9 | // RAW INPUT 10 | const 11 | RIM_TYPEHID = 2; 12 | RIM_TYPEKEYBOARD = 1; 13 | RIM_TYPEMOUSE = 0; 14 | 15 | RID_INPUT = $10000003; 16 | HID_USAGE_PAGE_GENERIC = $01; 17 | HID_USAGE_GENERIC_MOUSE = $02; 18 | 19 | RIDEV_INPUTSINK = $00000100; 20 | type 21 | HRAWINPUT = THandle; 22 | 23 | tagRAWINPUTDEVICE = record 24 | usUsagePage: Word; 25 | usUsage: Word; 26 | dwFlags: DWORD; 27 | hwndTarget: HWND; 28 | end; 29 | RAWINPUTDEVICE = tagRAWINPUTDEVICE; 30 | 31 | PRAWINPUTDEVICE = ^RAWINPUTDEVICE; 32 | 33 | tagRAWINPUTHEADER = record 34 | dwType: DWORD; 35 | dwSize: DWORD; 36 | hDevice: THandle; 37 | wParam: WPARAM; 38 | end; 39 | RAWINPUTHEADER = tagRAWINPUTHEADER; 40 | 41 | tagRAWKEYBOARD = record 42 | MakeCode: Word; 43 | Flags: Word; 44 | Reserved: Word; 45 | VKey: Word; 46 | Message: UINT; 47 | ExtraInformation: ULONG; 48 | end; 49 | RAWKEYBOARD = tagRAWKEYBOARD; 50 | 51 | tagRAWMOUSE = record 52 | usFlags: Word; 53 | case Integer of 54 | 0: (ulButtons: ULONG); 55 | 1: (usButtonFlags: Word; 56 | usButtonsData: Word; 57 | ulRawButtons: ULONG; 58 | lLastX: Longint; 59 | lLastY: Longint; 60 | ulExtraInformation: ULONG); 61 | end; 62 | RAWMOUSE = tagRAWMOUSE; 63 | 64 | tagRAWHID = record 65 | dwSizeHid: DWORD; 66 | dwCount: DWORD; 67 | bRawData: Byte; 68 | end; 69 | 70 | RAWHID = tagRAWHID; 71 | 72 | tagRAWINPUT = record 73 | header: RAWINPUTHEADER; 74 | case Integer of 75 | RIM_TYPEMOUSE: (mouse: RAWMOUSE); 76 | RIM_TYPEKEYBOARD:(keyboard: RAWKEYBOARD); 77 | RIM_TYPEHID: (hid: RAWHID); 78 | end; 79 | 80 | RAWINPUT = tagRAWINPUT; 81 | 82 | function RegisterRawInputDevices(pRawInputDevices: PRAWINPUTDEVICE; 83 | uiNumDevices: UINT; cbSize: UINT): BOOL; stdcall; external 'user32.dll'; 84 | function GetRawInputData(hRawInput: HRAWINPUT; uiCommand: UINT; pData: Pointer; var pcbSize: UINT; cbSizeHeader: UINT): UINT; stdcall; 85 | external 'user32.dll'; 86 | implementation 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /functions.windowfocus.pas: -------------------------------------------------------------------------------- 1 | unit functions.windowfocus; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, Forms, MultiMon, SysUtils, ShellApi; 7 | 8 | type 9 | TWindowFocusHelper = class 10 | private 11 | class procedure ForceForegroundWindow(hwnd: HWND); 12 | class function IsWindowFullscreen(hwnd: HWND): Boolean; 13 | public 14 | class procedure FocusWindow(FormHandle: HWND); 15 | end; 16 | 17 | implementation 18 | 19 | procedure SwitchToThisWindow(hWnd: HWND; fUnknown: BOOL); external 'user32.dll'; 20 | 21 | class procedure TWindowFocusHelper.ForceForegroundWindow(hwnd: HWND); 22 | var 23 | HForegroundThread, HAppThread: DWORD; 24 | HActiveWindow: THandle; 25 | FClientId: DWORD; 26 | begin 27 | TForm(hwnd).Show; 28 | HActiveWindow := GetForegroundWindow(); 29 | if HActiveWindow <> hwnd then 30 | begin 31 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 32 | AllowSetForegroundWindow(FClientId); 33 | HAppThread := GetCurrentThreadId; 34 | 35 | if not SetForegroundWindow(hwnd) then 36 | SwitchToThisWindow(GetDesktopWindow, True); 37 | 38 | // magic part to switch correctly to our window 39 | if HForegroundThread <> HAppThread then 40 | begin 41 | AttachThreadInput(HForegroundThread, HAppThread, True); 42 | BringWindowToTop(hwnd); 43 | Windows.SetFocus(hwnd); 44 | AttachThreadInput(HForegroundThread, HAppThread, False); 45 | end; 46 | 47 | var rct: TRect; 48 | Windows.GetWindowRect(HActiveWindow, rct); 49 | SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, {SWP_ASYNCWINDOWPOS or }SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); 50 | 51 | var helperPath := ExtractFilePath(ParamStr(0))+'focusHelper.exe'; 52 | if FileExists(helperPath) then 53 | ShellExecute(0, 'OPEN', PChar(ExtractFilePath(ParamStr(0))+'focusHelper.exe'), nil, nil, SW_SHOW); 54 | end; 55 | 56 | end; 57 | 58 | class function TWindowFocusHelper.IsWindowFullscreen(hwnd: HWND): Boolean; 59 | var 60 | WinRect: TRect; 61 | Monitor: HMonitor; 62 | MonInfo: TMonitorInfo; 63 | begin 64 | GetWindowRect(hwnd, WinRect); 65 | Monitor := MonitorFromWindow(hwnd, MONITOR_DEFAULTTOPRIMARY); 66 | MonInfo.cbSize := SizeOf(MonInfo); 67 | GetMonitorInfo(Monitor, @MonInfo); 68 | 69 | Result := (WinRect.Left = MonInfo.rcMonitor.Left) and 70 | (WinRect.Top = MonInfo.rcMonitor.Top) and 71 | (WinRect.Right = MonInfo.rcMonitor.Right) and 72 | (WinRect.Bottom = MonInfo.rcMonitor.Bottom); 73 | end; 74 | 75 | class procedure TWindowFocusHelper.FocusWindow(FormHandle: HWND); 76 | begin 77 | // Handle minimized state 78 | if IsIconic(FormHandle) then 79 | ShowWindow(FormHandle, SW_RESTORE); 80 | 81 | // Don't steal focus from fullscreen applications 82 | if not IsWindowFullscreen(GetForegroundWindow) then 83 | begin 84 | // Try standard approach first 85 | if not SetForegroundWindow(FormHandle) then 86 | // If that fails, use the forced approach 87 | ForceForegroundWindow(FormHandle); 88 | end; 89 | 90 | // Ensure window is visible and on top 91 | ShowWindow(FormHandle, SW_SHOW); 92 | BringWindowToTop(FormHandle); 93 | 94 | // Send activation message 95 | SendMessage(FormHandle, WM_ACTIVATE, WA_ACTIVE, 0); 96 | end; 97 | 98 | end. 99 | -------------------------------------------------------------------------------- /menu.dfm: -------------------------------------------------------------------------------- 1 | object frmMenu: TfrmMenu 2 | Left = 258 3 | Top = 171 4 | CustomHint = BalloonHint1 5 | BorderStyle = bsNone 6 | Caption = 'AIChatBar' 7 | ClientHeight = 597 8 | ClientWidth = 762 9 | Color = clSilver 10 | DoubleBuffered = True 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -11 14 | Font.Name = 'Tahoma' 15 | Font.Style = [] 16 | KeyPreview = True 17 | PopupMenu = pm1 18 | StyleElements = [seFont] 19 | OnClick = FormClick 20 | OnClose = FormClose 21 | OnCreate = FormCreate 22 | OnDestroy = FormDestroy 23 | OnMouseDown = FormMouseDown 24 | OnPaint = FormPaint 25 | OnShow = FormShow 26 | TextHeight = 13 27 | object imgMenu: TSkSvg 28 | Left = 16 29 | Top = 180 30 | Width = 48 31 | Height = 48 32 | CustomHint = BalloonHint1 33 | Visible = False 34 | OnClick = imgMenuClick 35 | Svg.Source = 36 | ''#13#10''#13#10#13#10'' 141 | end 142 | object tmrMenu: TTimer 143 | Enabled = False 144 | Interval = 250 145 | OnTimer = tmrMenuTimer 146 | Left = 568 147 | Top = 72 148 | end 149 | object pm1: TPopupMenu 150 | OnClose = pm1Close 151 | OnPopup = pm1Popup 152 | Left = 248 153 | Top = 24 154 | object About1: TMenuItem 155 | Caption = 'About...' 156 | OnClick = About1Click 157 | end 158 | object Settings1: TMenuItem 159 | Caption = '&Settings' 160 | OnClick = Settings1Click 161 | end 162 | object askGPT1: TMenuItem 163 | Caption = 'TaskGPT '#55358#56598 164 | OnClick = askGPT1Click 165 | end 166 | object N2: TMenuItem 167 | Caption = '-' 168 | end 169 | object Exit1: TMenuItem 170 | Caption = 'E&xit' 171 | OnClick = Exit1Click 172 | end 173 | end 174 | object tmrHideMenu: TTimer 175 | Enabled = False 176 | Interval = 25 177 | OnTimer = tmrHideMenuTimer 178 | Left = 592 179 | Top = 152 180 | end 181 | object tmrShowMenu: TTimer 182 | Enabled = False 183 | Interval = 25 184 | OnTimer = tmrShowMenuTimer 185 | Left = 592 186 | Top = 224 187 | end 188 | object ImageList1: TImageList 189 | Left = 304 190 | Top = 400 191 | end 192 | object pmCard: TPopupMenu 193 | OnClose = pmCardClose 194 | OnPopup = pmCardPopup 195 | Left = 256 196 | Top = 112 197 | object pmCardCloseSite: TMenuItem 198 | Caption = 'Close' 199 | Enabled = False 200 | OnClick = pmCardCloseSiteClick 201 | end 202 | object AlternatURL1: TMenuItem 203 | Caption = 'Alternat URL' 204 | Visible = False 205 | OnClick = AlternatURL1Click 206 | end 207 | end 208 | object TrayIcon1: TTrayIcon 209 | PopupMenu = pm1 210 | Visible = True 211 | Left = 296 212 | Top = 304 213 | end 214 | object JvApplicationHotKey1: TJvApplicationHotKey 215 | HotKey = 49275 216 | OnHotKey = JvApplicationHotKey1HotKey 217 | OnHotKeyRegisterFailed = JvApplicationHotKey1HotKeyRegisterFailed 218 | Left = 184 219 | Top = 264 220 | end 221 | object JvAppEvents1: TJvAppEvents 222 | OnActivate = JvAppEvents1Activate 223 | Left = 440 224 | Top = 360 225 | end 226 | object MadExceptionHandler1: TMadExceptionHandler 227 | Left = 432 228 | Top = 248 229 | end 230 | object BalloonHint1: TBalloonHint 231 | Style = bhsStandard 232 | Delay = 150 233 | HideAfter = 500 234 | Left = 368 235 | Top = 288 236 | end 237 | object JvApplicationHotKey2: TJvApplicationHotKey 238 | HotKey = 0 239 | OnHotKey = JvApplicationHotKey2HotKey 240 | OnHotKeyRegisterFailed = JvApplicationHotKey2HotKeyRegisterFailed 241 | Left = 288 242 | Top = 216 243 | end 244 | object ActionList1: TActionList 245 | Left = 136 246 | Top = 136 247 | object actSwitchAIChats: TAction 248 | Caption = 'actSwitchAIChats' 249 | ShortCut = 16464 250 | OnExecute = actSwitchAIChatsExecute 251 | end 252 | end 253 | object JvApplicationHotKey3: TJvApplicationHotKey 254 | HotKey = 49184 255 | OnHotKey = JvApplicationHotKey3HotKey 256 | OnHotKeyRegisterFailed = JvApplicationHotKey3HotKeyRegisterFailed 257 | Left = 384 258 | Top = 152 259 | end 260 | object tmrDelayAction: TTimer 261 | Enabled = False 262 | OnTimer = tmrDelayActionTimer 263 | Left = 648 264 | Top = 368 265 | end 266 | end 267 | -------------------------------------------------------------------------------- /settings.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/AIChatbar/968b1ac335ff07a07a9cc029c12cafa1e76d59aa/settings.pas -------------------------------------------------------------------------------- /settingsHelper.pas: -------------------------------------------------------------------------------- 1 | unit settingsHelper; 2 | 3 | interface 4 | 5 | uses 6 | FireDAC.Phys.SQLite, Generics.Collections, Classes, SysUtils, JSON, 7 | FireDAC.Comp.Client, FireDAC.Stan.Param, FireDAC.Stan.Error, 8 | FireDAC.Stan.Intf, FireDAC.Stan.Option, Winapi.ShellAPI, 9 | FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, 10 | FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait, FireDAC.DatS, 11 | FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet; 12 | 13 | type 14 | TSite = class 15 | private 16 | FId: Integer; 17 | FName: string; 18 | FUrl: string; 19 | FAltUrl: string; 20 | FIcon: string; 21 | FPosition: Integer; 22 | FUserScript: string; 23 | FUserStyle: string; 24 | FUserScriptEnabled: Boolean; 25 | FUserStyleEnabled: Boolean; 26 | FEnabled: Boolean; 27 | FUA: string; 28 | published 29 | property Id: Integer read FId write FId; 30 | property Name: string read FName write FName; 31 | property Url: string read FUrl write FUrl; 32 | property AltUrl: string read FAltUrl write FAltUrl; 33 | property Icon: string read FIcon write FIcon; 34 | property Position: Integer read FPosition write FPosition; 35 | property UserStyle: string read FUserStyle write FUserStyle; 36 | property UserScript: string read FUserScript write FUserScript; 37 | property UserStyleEnabled: Boolean read FUserStyleEnabled write FUserStyleEnabled; 38 | property UserScriptEnabled: Boolean read FUserScriptEnabled write FUserScriptEnabled; 39 | property Enabled: Boolean read FEnabled write FEnabled; 40 | property UA: string read FUA write FUA; 41 | end; 42 | 43 | TSettings = class 44 | private 45 | FDB: TFDConnection; 46 | FSites: TObjectList; 47 | // app settings 48 | FSettingsPath: string; 49 | FDatabaseName: string; 50 | FInifileName: string; 51 | 52 | FAutoHide: Boolean; 53 | FAutoStart: Boolean; 54 | FDetectClipboardText: Boolean; 55 | FDetectClipboardImage: Boolean; 56 | FDisableOnFullScreen: Boolean; 57 | FDisableOnFullScreenDirectX: Boolean; 58 | FGlobalHotkey: string; 59 | FTaskHotkey: string; 60 | FLauncherHotkey: string; 61 | FRequireWinkey: Boolean; 62 | FRequireWinkeyTask: Boolean; 63 | FRequireWinkeyLauncher: Boolean; 64 | FProxy: string; 65 | FBarPosition: Integer; //ABE_RIGHT 66 | FDarkMode: Boolean; 67 | FMouseDelay: Boolean; 68 | FMouseDelayValue: Integer; // milliseconds 69 | FMouseGesture: Boolean; //a.k.a. knock-knock gesture 70 | 71 | public 72 | procedure CreateTables; 73 | constructor Create(const settingsPath: string); 74 | destructor Destroy; override; 75 | 76 | procedure AddSites(const name, url, alturl, svgicon, uscript, ustyle: string; 77 | uscriptOn, ustyleOn, enabled: Boolean; position: Integer; const UA: string); 78 | 79 | procedure ReadSites; 80 | procedure SaveSettings; 81 | procedure LoadSettings; 82 | procedure UpdateSite(id: Integer; const name, url, alturl, svgicon, uscript, ustyle: string; 83 | uscriptOn, ustyleOn, enabled: Boolean; position: Integer; const UA: string); 84 | procedure DeleteSite(id: Integer); 85 | 86 | property DB: TFDConnection read FDB; 87 | property Sites: TObjectList read FSites write FSites; 88 | 89 | property AutoHide: Boolean read FAutoHide write FAutoHide; 90 | property AutoStart: Boolean read FAutoStart write FAutoStart; 91 | property DetectClipboardText: Boolean read FDetectClipboardText write FDetectClipboardText; 92 | property DetectClipboardImage: Boolean read FDetectClipboardImage write FDetectClipboardImage; 93 | property DisableOnFullScreen: Boolean read FDisableOnFullScreen write FDisableOnFullScreen; 94 | property DisableOnFullScreenDirectX: Boolean read FDisableOnFullScreenDirectX write FDisableOnFullScreenDirectX; 95 | property GlobalHotkey: string read FGlobalHotkey write FGlobalHotkey; 96 | property TaskHotkey: string read FTaskHotkey write FTaskHotkey; 97 | property LauncherHotkey: string read FLauncherHotkey write FLauncherHotkey; 98 | property RequireWinKey: Boolean read FRequireWinkey write FRequireWinkey; 99 | property RequireWinKeyTask: Boolean read FRequireWinkeyTask write FRequireWinkeyTask; 100 | property RequireWinKeyLauncher: Boolean read FRequireWinkeyLauncher write FRequireWinkeyLauncher; 101 | property Proxy: string read FProxy write FProxy; 102 | property BarPosition: Integer read FBarPosition write FBarPosition; 103 | property DarkMode: Boolean read FDarkMode write FDarkMode; 104 | property MouseDelay: Boolean read FMouseDelay write FMouseDelay; 105 | property MouseDelayValue: Integer read FMouseDelayValue write FMouseDelayValue; 106 | property MouseGesture: Boolean read FMouseGesture write FMouseGesture; 107 | end; 108 | 109 | implementation 110 | 111 | uses 112 | System.IniFiles; 113 | 114 | { TSettings } 115 | 116 | procedure TSettings.AddSites(const name, url, alturl, svgicon, uscript, 117 | ustyle: string; uscriptOn, ustyleOn, enabled: Boolean; position: Integer; const UA: string); 118 | var 119 | q: TFDQuery; 120 | begin 121 | q := TFDQuery.Create(nil); 122 | try 123 | q.Connection := FDB; 124 | q.SQL.Text := 'INSERT OR IGNORE INTO settings (name, url, alturl, svgIcon,' + 125 | 'userscript, userscriptactive,' + 126 | 'userstyle, userstyleactive,' + 127 | 'enabled, position, ua) VALUES (:name, :url, :alturl, :svgIcon,' + 128 | ':userscript, :userscriptactive,' + 129 | ':userstyle, :userstyleactive,' + 130 | ':enabled, :position, :ua)'; 131 | q.Params.ParamByName('name').AsWideString := name; 132 | q.Params.ParamByName('url').AsWideString := url; 133 | q.Params.ParamByName('alturl').AsWideString := alturl; 134 | q.Params.ParamByName('svgIcon').AsWideString := svgicon; 135 | q.Params.ParamByName('userscript').AsWideString := uscript; 136 | q.Params.ParamByName('userscriptactive').AsBoolean := uscriptOn; 137 | q.Params.ParamByName('userstyle').AsWideString := ustyle; 138 | q.Params.ParamByName('userstyleactive').AsBoolean := ustyleOn; 139 | q.Params.ParamByName('enabled').AsBoolean := enabled; 140 | q.Params.ParamByName('position').AsInteger := position; 141 | q.Params.ParamByName('ua').AsWideString := UA; 142 | 143 | q.ExecSQL; 144 | finally 145 | q.Free; 146 | end; 147 | end; 148 | 149 | constructor TSettings.Create(const settingsPath: string); 150 | var 151 | FileInfo: TSearchRec; 152 | begin 153 | FSettingsPath := ExtractFilePath(settingsPath); 154 | FDatabaseName := ExtractFileName(settingsPath); 155 | FInifileName := StringReplace(FDatabaseName, ExtractFileExt(FDatabaseName), '.ini', [rfIgnoreCase]); 156 | 157 | FDB := TFDConnection.Create(nil); 158 | FDB.Params.DriverID := 'SQLite'; 159 | FDB.Params.Database := settingsPath; 160 | FDB.Open; 161 | 162 | if FindFirst(settingsPath, faAnyFile, FileInfo) = 0 then 163 | begin 164 | try 165 | if (FileInfo.Size = 0) then 166 | CreateTables; 167 | finally 168 | FindClose(FileInfo); 169 | end; 170 | end; 171 | 172 | FSites := TObjectList.Create; 173 | end; 174 | 175 | procedure TSettings.CreateTables; 176 | var 177 | qr: TFDQuery; 178 | begin 179 | qr := TFDQuery.Create(nil); 180 | try 181 | qr.Connection := FDB; 182 | qr.SQL.Text := 'CREATE TABLE IF NOT EXISTS settings(id INTEGER PRIMARY KEY,' + 183 | 'name TEXT, url TEXT, alturl TEXT, svgIcon TEXT,' + 184 | 'userscript TEXT, userscriptactive INTEGER,' + 185 | 'userstyle TEXT, userstyleactive INTEGER,' + 186 | 'enabled INTEGER, position INTEGER, ua TEXT)'; 187 | qr.ExecSQL; 188 | qr.SQL.Text := 'CREATE UNIQUE INDEX IF NOT EXISTS name_index on settings(name)'; 189 | qr.ExecSQL; 190 | finally 191 | qr.Free; 192 | end; 193 | end; 194 | 195 | procedure TSettings.DeleteSite(id: Integer); 196 | var 197 | q: TFDQuery; 198 | begin 199 | q := TFDQuery.Create(nil); 200 | try 201 | q.Connection := FDB; 202 | q.SQL.Text := 'DELETE from settings WHERE id = :id'; 203 | q.Params.ParamByName('id').AsInteger := id; 204 | 205 | q.ExecSQL; 206 | finally 207 | q.Free; 208 | end; 209 | 210 | end; 211 | 212 | destructor TSettings.Destroy; 213 | begin 214 | inherited; 215 | FSites.Free; 216 | FDB.CloneConnection; 217 | FDB.Free; 218 | end; 219 | 220 | procedure TSettings.LoadSettings; 221 | var 222 | ini: TIniFile; 223 | begin 224 | ini := TIniFile.Create(FSettingsPath + FInifileName); 225 | try 226 | FAutoHide := ini.ReadBool('settings', 'autohide', True); 227 | FAutoStart := ini.ReadBool('settings', 'autostart', False); 228 | FDetectClipboardText := ini.ReadBool('settings', 'cliptext', False); 229 | FDetectClipboardImage := ini.ReadBool('settings', 'clipimg', False); 230 | FDisableOnFullScreen := ini.ReadBool('settings', 'notonfs', True); 231 | FDisableOnFullScreenDirectX := ini.ReadBool('settings', 'notonfs3d', True); 232 | FGlobalHotkey := ini.ReadString('settings', 'hotkey', ''); 233 | FTaskHotkey := ini.ReadString('settings', 'taskhotkey', ''); 234 | FLauncherHotkey := ini.ReadString('settings', 'launcherhotkey', ''); 235 | FRequireWinkey := ini.ReadBool('settings', 'requirewinkey', False); 236 | FRequireWinkeyTask := ini.ReadBool('settings', 'requirewinkeytask', False); 237 | FRequireWinkeyLauncher := ini.ReadBool('settings', 'requirewinkeylauncher', False); 238 | FProxy := ini.ReadString('settings', 'proxy', 'localhost:8080'); 239 | FBarPosition := ini.ReadInteger('settings', 'position', ABE_RIGHT); 240 | FDarkMode := ini.ReadBool('settings', 'darkmode', True); 241 | FMouseDelay := ini.ReadBool('settings', 'mousedelay', False); 242 | FMouseDelayValue := ini.ReadInteger('settings', 'mousedelayvalue', 250); 243 | FMouseGesture := ini.ReadBool('settings', 'mousegesture', False); 244 | finally 245 | ini.Free; 246 | end; 247 | end; 248 | 249 | procedure TSettings.ReadSites; 250 | var 251 | q: TFDQuery; 252 | begin 253 | q := TFDQuery.Create(nil); 254 | try 255 | q.Connection := FDB; 256 | q.SQL.Text := 'SELECT * FROM settings'; 257 | q.Open; 258 | // clear current FSites if it is filled already 259 | FSites.Clear; 260 | while not q.Eof do 261 | begin 262 | var site := TSite.Create; 263 | try 264 | with site do 265 | begin 266 | FId := q.FieldByName('id').AsInteger; 267 | FName := q.FieldByName('name').AsWideString; 268 | FUrl := q.FieldByName('url').AsWideString; 269 | FAltUrl := q.FieldByName('alturl').AsWideString; 270 | FIcon := q.FieldByName('svgIcon').AsWideString; 271 | FUserScript := q.FieldByName('userscript').AsWideString; 272 | FUserScriptEnabled := Boolean(q.FieldByName('userscriptactive').AsInteger); 273 | FUserStyle := q.FieldByName('userstyle').AsWideString; 274 | FUserStyleEnabled := Boolean(q.FieldByName('userstyleactive').AsInteger); 275 | FEnabled := Boolean(q.FieldByName('enabled').AsInteger); 276 | FPosition := q.FieldByName('position').AsInteger; 277 | FUA := q.FieldByName('ua').AsWideString; 278 | end; 279 | FSites.Add(site); 280 | finally 281 | //site.Free; nil) then FBrowserFrame.CreateBrowser; 75 | end; 76 | 77 | procedure TBrowserCard.CreateBrowser(const aHomepage, aUA: string); 78 | begin 79 | CreateFrame(aHomepage, aUA); 80 | 81 | if (FBrowserFrame <> nil) then FBrowserFrame.CreateBrowser; 82 | end; 83 | 84 | procedure TBrowserCard.CreateFrame( 85 | const aArgs: TCoreWebView2NewWindowRequestedEventArgs); 86 | begin 87 | CreateFrame('', ''); 88 | 89 | FBrowserFrame.Args := aArgs; 90 | end; 91 | 92 | procedure TBrowserCard.CtrlPEvent(Sender: TObject); 93 | begin 94 | if Assigned(FCardCtrlPEvent) then 95 | FCardCtrlPEvent(Self); 96 | end; 97 | 98 | 99 | 100 | procedure TBrowserCard.FocusBrowser; 101 | begin 102 | if (FBrowserFrame <> nil) then 103 | begin 104 | Winapi.Windows.SetFocus(FBrowserFrame.ChildHandle); 105 | end; 106 | end; 107 | 108 | procedure TBrowserCard.CreateFrame(const aHomepage, aUA: string); 109 | begin 110 | if (FBrowserFrame = nil) then 111 | begin 112 | FBrowserFrame := TBrowserFrame.Create(self); 113 | FBrowserFrame.Name := 'BrowserFrame' + IntToStr(CardID); 114 | FBrowserFrame.Parent := self; 115 | FBrowserFrame.Align := alClient; 116 | FBrowserFrame.Visible := True; 117 | FBrowserFrame.OnBrowserTitleChange := BrowserFrame_OnBrowserTitleChange; 118 | FBrowserFrame.CreateAllHandles; 119 | end; 120 | 121 | FBrowserFrame.UA := aUA; 122 | FBrowserFrame.Homepage := aHomepage; 123 | FBrowserFrame.CtrlPEvent := CtrlPEvent; 124 | end; 125 | 126 | function TBrowserCard.GetCookies: TCookieManager; 127 | begin 128 | Result := nil; 129 | if (FBrowserFrame <> nil) then 130 | Result := FBrowserFrame.Cookies; 131 | end; 132 | 133 | function TBrowserCard.GetInitialized: Boolean; 134 | begin 135 | Result := (FBrowserFrame <> nil) and 136 | FBrowserFrame.Initialized; 137 | end; 138 | 139 | function TBrowserCard.GetRamUsage: Int64; 140 | begin 141 | Result := 0; 142 | if (FBrowserFrame <> nil) then 143 | Result := FBrowserFrame.MemoryUsage; 144 | end; 145 | 146 | procedure TBrowserCard.Navigate(const url: string); 147 | begin 148 | FBrowserFrame.WVBrowser1.Navigate(url); 149 | end; 150 | 151 | procedure TBrowserCard.NotifyParentWindowPositionChanged; 152 | begin 153 | FBrowserFrame.NotifyParentWindowPositionChanged; 154 | end; 155 | 156 | end. 157 | -------------------------------------------------------------------------------- /uBrowserFrame.pas: -------------------------------------------------------------------------------- 1 | unit uBrowserFrame; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 7 | Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | uWVBrowserBase, uWVBrowser, uWVWinControl, uWVWindowParent, uWVTypeLibrary, uWVTypes, 9 | uChildForm, uWVCoreWebView2Args, uWVCoreWebView2Deferral, Skia, 10 | Vcl.ExtCtrls, Winapi.TlHelp32, Winapi.PsAPI, Net.HttpClient; 11 | 12 | type 13 | TBrowserTitleEvent = procedure(Sender: TObject; const aTitle : string) of object; 14 | 15 | TBrowserFrame = class(TFrame) 16 | WVBrowser1: TWVBrowser; 17 | WVWindowParent1: TWVWindowParent; 18 | SkAnimatedImage1: TSkAnimatedImage; 19 | Timer1: TTimer; 20 | procedure WVBrowser1AfterCreated(Sender: TObject); 21 | procedure WVBrowser1DocumentTitleChanged(Sender: TObject); 22 | procedure WVBrowser1NavigationStarting(Sender: TObject; 23 | const aWebView: ICoreWebView2; 24 | const aArgs: ICoreWebView2NavigationStartingEventArgs); 25 | procedure WVBrowser1NavigationCompleted(Sender: TObject; 26 | const aWebView: ICoreWebView2; 27 | const aArgs: ICoreWebView2NavigationCompletedEventArgs); 28 | procedure WVBrowser1SourceChanged(Sender: TObject; 29 | const aWebView: ICoreWebView2; 30 | const aArgs: ICoreWebView2SourceChangedEventArgs); 31 | procedure WVBrowser1InitializationError(Sender: TObject; 32 | aErrorCode: HRESULT; const aErrorMessage: wvstring); 33 | procedure WVBrowser1NewWindowRequested(Sender: TObject; 34 | const aWebView: ICoreWebView2; 35 | const aArgs: ICoreWebView2NewWindowRequestedEventArgs); 36 | procedure WVBrowser1DOMContentLoaded(Sender: TObject; 37 | const aWebView: ICoreWebView2; 38 | const aArgs: ICoreWebView2DOMContentLoadedEventArgs); 39 | procedure WVBrowser1WebMessageReceived(Sender: TObject; 40 | const aWebView: ICoreWebView2; 41 | const aArgs: ICoreWebView2WebMessageReceivedEventArgs); 42 | procedure WVBrowser1WebResourceResponseReceived(Sender: TObject; 43 | const aWebView: ICoreWebView2; 44 | const aArgs: ICoreWebView2WebResourceResponseReceivedEventArgs); 45 | procedure Timer1Timer(Sender: TObject); 46 | procedure WVBrowser1GetCookiesCompleted(Sender: TObject; aResult: HRESULT; 47 | const aCookieList: ICoreWebView2CookieList); 48 | private 49 | { Private declarations } 50 | FChildHandle: THandle; 51 | FTimeout: Integer; 52 | FMemoryUsage: Int64; 53 | FCtrlPEvent: TNotifyEvent; 54 | FCookies: TCookieManager; 55 | function GetMemoryUsage: Int64; 56 | protected 57 | FGetHeaders : boolean; 58 | FHeaders : TStringList; 59 | FHomepage : wvstring; 60 | FUA : wvstring; 61 | FDisableCSP : Boolean; 62 | FOnBrowserTitleChange : TBrowserTitleEvent; 63 | FArgs : TCoreWebView2NewWindowRequestedEventArgs; 64 | FDeferral : TCoreWebView2Deferral; 65 | 66 | function GetInitialized : boolean; 67 | 68 | procedure SetArgs(const aValue : TCoreWebView2NewWindowRequestedEventArgs); 69 | 70 | public 71 | { Public declarations } 72 | constructor Create(AOwner : TComponent); override; 73 | destructor Destroy; override; 74 | procedure NotifyParentWindowPositionChanged; 75 | procedure CreateBrowser; 76 | procedure CreateAllHandles; 77 | 78 | property Initialized : boolean read GetInitialized; 79 | property Homepage : wvstring read FHomepage write FHomepage; 80 | property UA : wvstring read FUA write FUA; 81 | property OnBrowserTitleChange : TBrowserTitleEvent read FOnBrowserTitleChange write FOnBrowserTitleChange; 82 | property Args : TCoreWebView2NewWindowRequestedEventArgs read FArgs write SetArgs; 83 | property ChildHandle : THandle read FChildHandle; 84 | property Headers : TStringList read FHeaders; 85 | property DisableCSP : Boolean read FDisableCSP write FDisableCSP; 86 | property MemoryUsage : Int64 read GetMemoryUsage; 87 | property CtrlPEvent : TNotifyEvent read FCtrlPEvent write FCtrlPEvent; 88 | property Cookies : TCookieManager read FCookies write FCookies; 89 | end; 90 | 91 | implementation 92 | 93 | {$R *.dfm} 94 | 95 | uses 96 | uWVCoreWebView2WindowFeatures, frmChatWebView, menu, 97 | uWVCoreWebView2WebResourceResponseView, uWVCoreWebView2HttpResponseHeaders, 98 | uWVCoreWebView2HttpHeadersCollectionIterator, 99 | uWVCoreWebView2ProcessInfoCollection, uWVCoreWebView2ProcessInfo, 100 | uWVCoreWebView2Delegates, 101 | uWVCoreWebView2CookieList, uWVCoreWebView2Cookie; 102 | 103 | constructor TBrowserFrame.Create(AOwner: TComponent); 104 | begin 105 | inherited Create(AOwner); 106 | AOwner.GetParentComponent; 107 | FHomepage := ''; 108 | FOnBrowserTitleChange := nil; 109 | FHeaders := TStringList.Create; 110 | FTimeOut := 3; // 3 seconds 111 | FCookies := TCookieManager.Create; 112 | end; 113 | 114 | procedure TBrowserFrame.CreateAllHandles; 115 | begin 116 | CreateHandle; 117 | 118 | WVWindowParent1.CreateHandle; 119 | end; 120 | 121 | procedure TBrowserFrame.CreateBrowser; 122 | begin 123 | WVBrowser1.DefaultURL := FHomepage; 124 | // WVBrowser1.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/116.0.0.0 Safari/537.36 Edg/116.0.0.0'; 125 | WVBrowser1.CreateBrowser(WVWindowParent1.Handle); 126 | FChildHandle := WVWindowParent1.ChildWindowHandle; 127 | end; 128 | 129 | destructor TBrowserFrame.Destroy; 130 | begin 131 | FCookies.Free; 132 | 133 | if assigned(FDeferral) then 134 | FreeAndNil(FDeferral); 135 | 136 | if assigned(FArgs) then 137 | FreeAndNil(FArgs); 138 | 139 | FHeaders.Free; 140 | 141 | inherited Destroy; 142 | end; 143 | 144 | function TBrowserFrame.GetInitialized: boolean; 145 | begin 146 | Result := WVBrowser1.Initialized; 147 | end; 148 | 149 | procedure TBrowserFrame.NotifyParentWindowPositionChanged; 150 | begin 151 | WVBrowser1.NotifyParentWindowPositionChanged; 152 | end; 153 | 154 | procedure TBrowserFrame.SetArgs( 155 | const aValue: TCoreWebView2NewWindowRequestedEventArgs); 156 | begin 157 | FArgs := aValue; 158 | FDeferral := TCoreWebView2Deferral.Create(FArgs.Deferral); 159 | end; 160 | 161 | function TBrowserFrame.GetMemoryUsage: Int64; 162 | var 163 | TempCollection: TCoreWebView2ProcessInfoCollection; 164 | TempInfo: TCoreWebView2ProcessInfo; 165 | I: Cardinal; 166 | TempHandle: THandle; 167 | TempMemCtrs: TProcessMemoryCounters; 168 | begin 169 | Result := 0; 170 | TempCollection := nil; 171 | TempInfo := nil; 172 | 173 | try 174 | TempCollection := TCoreWebView2ProcessInfoCollection.Create(WVBrowser1.ProcessInfos); 175 | 176 | I := 0; 177 | while (I < TempCollection.Count) do 178 | begin 179 | if Assigned(TempInfo) then 180 | TempInfo.BaseIntf := TempCollection.Items[I] 181 | else 182 | TempInfo := TCoreWebView2ProcessInfo.Create(TempCollection.Items[I]); 183 | 184 | {case TempInfo.Kind of 185 | COREWEBVIEW2_PROCESS_KIND_BROWSER : 186 | 187 | end;} 188 | 189 | TempHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, TempInfo.ProcessId); 190 | if TempHandle <> 0 then 191 | try 192 | ZeroMemory(@TempMemCtrs, SizeOf(TProcessMemoryCounters)); 193 | TempMemCtrs.cb := SizeOf(TProcessMemoryCounters); 194 | 195 | if GetProcessMemoryInfo(TempHandle, @TempMemCtrs, TempMemCtrs.cb) then 196 | Result := Result + TempMemCtrs.WorkingSetSize; 197 | 198 | finally 199 | CloseHandle(TempHandle); 200 | end; 201 | 202 | 203 | Inc(I); 204 | end; 205 | 206 | finally 207 | if Assigned(TempCollection) then 208 | FreeAndNil(TempCollection); 209 | 210 | if Assigned(TempInfo) then 211 | FreeAndNil(TempInfo); 212 | 213 | end; 214 | 215 | end; 216 | 217 | procedure TBrowserFrame.Timer1Timer(Sender: TObject); 218 | begin 219 | if FTimeout > 0 then 220 | Dec(FTimeOut) 221 | else 222 | begin 223 | Timer1.Enabled := False; 224 | WVWindowParent1.Visible := True; 225 | end; 226 | 227 | end; 228 | 229 | procedure TBrowserFrame.WVBrowser1AfterCreated(Sender: TObject); 230 | begin 231 | if FUA = '' then 232 | WVBrowser1.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/116.0.0.0 Safari/537.36 Edg/116.0.0.0' 233 | else 234 | WVBrowser1.UserAgent := FUA; 235 | if assigned(FArgs) and assigned(FDeferral) then 236 | try 237 | FArgs.NewWindow := WVBrowser1.CoreWebView2.BaseIntf; 238 | FArgs.Handled := True; 239 | 240 | FDeferral.Complete; 241 | finally 242 | FreeAndNil(FDeferral); 243 | FreeAndNil(FArgs); 244 | end; 245 | 246 | WVWindowParent1.UpdateSize; 247 | // NavControlPnl.Enabled := True; 248 | Timer1.Enabled := True; 249 | end; 250 | 251 | procedure TBrowserFrame.WVBrowser1DocumentTitleChanged(Sender: TObject); 252 | begin 253 | if assigned(FOnBrowserTitleChange) then 254 | FOnBrowserTitleChange(self, WVBrowser1.DocumentTitle); 255 | end; 256 | 257 | procedure TBrowserFrame.WVBrowser1DOMContentLoaded(Sender: TObject; 258 | const aWebView: ICoreWebView2; 259 | const aArgs: ICoreWebView2DOMContentLoadedEventArgs); 260 | begin 261 | WVWindowParent1.Visible := True; 262 | WVBrowser1.GetCookies(); 263 | end; 264 | 265 | procedure TBrowserFrame.WVBrowser1GetCookiesCompleted(Sender: TObject; 266 | aResult: HRESULT; const aCookieList: ICoreWebView2CookieList); 267 | var 268 | TempCookieList: TCoreWebView2CookieList; 269 | TempCookie: TCoreWebView2Cookie; 270 | I: Integer; 271 | a, b, c: Boolean; 272 | begin 273 | TempCookieList := nil; 274 | TempCookie := nil; 275 | 276 | if Assigned(aCookieList) then 277 | try 278 | TempCookieList := TCoreWebView2CookieList.Create(aCookieList); 279 | TempCookie := TCoreWebView2Cookie.Create(nil); 280 | 281 | FCookies.Clear; 282 | var counter := TempCookieList.Count; 283 | if counter > 0 then 284 | for I := 0 to TempCookieList.Count - 1 do 285 | begin 286 | TempCookie.BaseIntf := TempCookieList.Items[I]; 287 | Cookies.AddServerCookie(TempCookie.Name + '=' + TempCookie.Value, PChar('https://'+TempCookie.Domain)); 288 | end; 289 | 290 | finally 291 | if Assigned(TempCookieList) then 292 | FreeAndNil(TempCookieList); 293 | if Assigned(TempCookie) then 294 | FreeAndNil(TempCookie); 295 | end; 296 | end; 297 | 298 | procedure TBrowserFrame.WVBrowser1InitializationError(Sender: TObject; 299 | aErrorCode: HRESULT; const aErrorMessage: wvstring); 300 | begin 301 | showmessage(aErrorMessage); 302 | end; 303 | 304 | procedure TBrowserFrame.WVBrowser1NavigationCompleted(Sender: TObject; 305 | const aWebView: ICoreWebView2; 306 | const aArgs: ICoreWebView2NavigationCompletedEventArgs); 307 | begin 308 | // UpdateNavButtons(False); 309 | SkAnimatedImage1.Enabled := False; 310 | SkAnimatedImage1.Visible := False; 311 | Winapi.Windows.SetFocus(WVWindowParent1.ChildWindowHandle); 312 | WVBrowser1.ExecuteScript('window.addEventListener("keydown", function (e) { if (e.ctrlKey && e.key ==="p") { e.preventDefault(); window.chrome.webview.postMessage("ctrlp"); } });'); 313 | end; 314 | 315 | procedure TBrowserFrame.WVBrowser1NavigationStarting(Sender: TObject; 316 | const aWebView: ICoreWebView2; 317 | const aArgs: ICoreWebView2NavigationStartingEventArgs); 318 | begin 319 | FGetHeaders := True; 320 | // UpdateNavButtons(True); 321 | WVWindowParent1.Visible := False; 322 | end; 323 | 324 | procedure TBrowserFrame.WVBrowser1NewWindowRequested(Sender: TObject; 325 | const aWebView: ICoreWebView2; 326 | const aArgs: ICoreWebView2NewWindowRequestedEventArgs); 327 | var 328 | TempChildForm : TChildForm; 329 | begin 330 | TempChildForm := TChildForm.Create(Self, aArgs); 331 | TempChildForm.Show; 332 | end; 333 | 334 | procedure TBrowserFrame.WVBrowser1SourceChanged(Sender: TObject; 335 | const aWebView: ICoreWebView2; 336 | const aArgs: ICoreWebView2SourceChangedEventArgs); 337 | begin 338 | // URLCbx.Text := WVBrowser1.Source; 339 | end; 340 | 341 | procedure TBrowserFrame.WVBrowser1WebMessageReceived(Sender: TObject; 342 | const aWebView: ICoreWebView2; 343 | const aArgs: ICoreWebView2WebMessageReceivedEventArgs); 344 | var 345 | Msgs: TCoreWebView2WebMessageReceivedEventArgs; 346 | begin 347 | Msgs := TCoreWebView2WebMessageReceivedEventArgs.Create(aArgs); 348 | try 349 | // create here the rules to interact with the webapps 350 | 351 | // handle Ctrl+P to switch among the other AI chats 352 | if Msgs.WebMessageAsString = 'ctrlp' then 353 | begin 354 | // PostMessage(Application.Handle, WM_USER + 99, 0, 0); 355 | if Assigned(FCtrlPEvent) then 356 | FCtrlPEvent(Self); 357 | end; 358 | 359 | // Msgs.WebMessageAsJson; 360 | finally 361 | Msgs.Free; 362 | end; 363 | WVBrowser1.ExecuteScript('document.currentScript.setAttribute(''sanbox'', ''allow-forms'')'); 364 | end; 365 | 366 | procedure TBrowserFrame.WVBrowser1WebResourceResponseReceived(Sender: TObject; 367 | const aWebView: ICoreWebView2; 368 | const aArgs: ICoreWebView2WebResourceResponseReceivedEventArgs); 369 | var 370 | TempArgs : TCoreWebView2WebResourceResponseReceivedEventArgs; 371 | TempResponse : TCoreWebView2WebResourceResponseView; 372 | TempHeaders : TCoreWebView2HttpResponseHeaders; 373 | TempIterator : TCoreWebView2HttpHeadersCollectionIterator; 374 | TempName : wvstring; 375 | TempValue : wvstring; 376 | TempHandler : ICoreWebView2WebResourceResponseViewGetContentCompletedHandler; 377 | begin 378 | if FGetHeaders then 379 | try 380 | FHeaders.Clear; 381 | FGetHeaders := False; 382 | TempArgs := TCoreWebView2WebResourceResponseReceivedEventArgs.Create(aArgs); 383 | TempResponse := TCoreWebView2WebResourceResponseView.Create(TempArgs.Response); 384 | TempHandler := TCoreWebView2WebResourceResponseViewGetContentCompletedHandler.Create(WVBrowser1); 385 | TempHeaders := TCoreWebView2HttpResponseHeaders.Create(TempResponse.Headers); 386 | TempIterator := TCoreWebView2HttpHeadersCollectionIterator.Create(TempHeaders.Iterator); 387 | 388 | // TempHeaders.AppendHeader('Content-Security-Policy', 'script-src ''self'' https://'); 389 | 390 | TempResponse.GetContent(TempHandler); 391 | while TempIterator.HasCurrentHeader do 392 | begin 393 | if TempIterator.GetCurrentHeader(TempName, TempValue) then 394 | begin 395 | FHeaders.Add(TempName + ':' + TempValue); 396 | end; 397 | TempIterator.MoveNext; 398 | end; 399 | 400 | if FDisableCSP then 401 | TempHeaders.AppendHeader('Content-Security-Policy', ''); 402 | 403 | finally 404 | FreeAndNil(TempIterator); 405 | FreeAndNil(TempHeaders); 406 | FreeAndNil(TempResponse); 407 | FreeAndNil(TempArgs); 408 | TempHandler := nil; 409 | end; 410 | end; 411 | 412 | end. 413 | -------------------------------------------------------------------------------- /uChildForm.dfm: -------------------------------------------------------------------------------- 1 | object ChildForm: TChildForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'ChildForm' 5 | ClientHeight = 441 6 | ClientWidth = 624 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnClose = FormClose 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | OnResize = FormResize 17 | OnShow = FormShow 18 | TextHeight = 15 19 | object WVWindowParent1: TWVWindowParent 20 | Left = 0 21 | Top = 0 22 | Width = 624 23 | Height = 422 24 | Align = alClient 25 | Color = clNone 26 | TabOrder = 0 27 | Browser = WVBrowser1 28 | end 29 | object StatusBar1: TStatusBar 30 | Left = 0 31 | Top = 422 32 | Width = 624 33 | Height = 19 34 | Cursor = crHandPoint 35 | Panels = < 36 | item 37 | Width = 50 38 | end> 39 | OnDblClick = StatusBar1DblClick 40 | end 41 | object WVBrowser1: TWVBrowser 42 | TargetCompatibleBrowserVersion = '95.0.1020.44' 43 | AllowSingleSignOnUsingOSPrimaryAccount = False 44 | OnAfterCreated = WVBrowser1AfterCreated 45 | OnDocumentTitleChanged = WVBrowser1DocumentTitleChanged 46 | OnNewWindowRequested = WVBrowser1NewWindowRequested 47 | OnWindowCloseRequested = WVBrowser1WindowCloseRequested 48 | Left = 144 49 | Top = 168 50 | end 51 | end 52 | -------------------------------------------------------------------------------- /uChildForm.pas: -------------------------------------------------------------------------------- 1 | unit uChildForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | uWVBrowser, uWVWinControl, uWVWindowParent, uWVTypes, uWVTypeLibrary, 9 | uWVBrowserBase, uWVCoreWebView2Args, uWVCoreWebView2Deferral, Vcl.ComCtrls; 10 | 11 | type 12 | TChildForm = class(TForm) 13 | WVWindowParent1: TWVWindowParent; 14 | WVBrowser1: TWVBrowser; 15 | StatusBar1: TStatusBar; 16 | 17 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 18 | procedure FormShow(Sender: TObject); 19 | 20 | procedure WVBrowser1AfterCreated(Sender: TObject); 21 | procedure FormDestroy(Sender: TObject); 22 | procedure WVBrowser1WindowCloseRequested(Sender: TObject); 23 | procedure WVBrowser1NewWindowRequested(Sender: TObject; 24 | const aWebView: ICoreWebView2; 25 | const aArgs: ICoreWebView2NewWindowRequestedEventArgs); 26 | procedure FormCreate(Sender: TObject); 27 | procedure FormResize(Sender: TObject); 28 | procedure WVBrowser1DocumentTitleChanged(Sender: TObject); 29 | procedure StatusBar1DblClick(Sender: TObject); 30 | 31 | private 32 | FArgs : TCoreWebView2NewWindowRequestedEventArgs; 33 | FDeferral : TCoreWebView2Deferral; 34 | FURL : string; 35 | 36 | public 37 | constructor Create(AOwner: TComponent; const aArgs : ICoreWebView2NewWindowRequestedEventArgs); reintroduce; overload; 38 | constructor Create(AOwner: TComponent; const aURL: string); reintroduce; overload; 39 | end; 40 | 41 | var 42 | ChildForm: TChildForm; 43 | 44 | implementation 45 | 46 | {$R *.dfm} 47 | 48 | uses 49 | uWVCoreWebView2WindowFeatures, menu, functions, Winapi.ShellAPI; 50 | 51 | constructor TChildForm.Create(AOwner: TComponent; const aArgs : ICoreWebView2NewWindowRequestedEventArgs); 52 | begin 53 | inherited Create(AOwner); 54 | 55 | FArgs := TCoreWebView2NewWindowRequestedEventArgs.Create(aArgs); 56 | FDeferral := TCoreWebView2Deferral.Create(FArgs.Deferral); 57 | end; 58 | 59 | constructor TChildForm.Create(AOwner: TComponent; const aURL: string); 60 | begin 61 | inherited Create(AOwner); 62 | 63 | FArgs := nil; // No event args in this constructor 64 | FDeferral := nil; 65 | FURL := aURL; 66 | end; 67 | 68 | procedure TChildForm.FormClose(Sender: TObject; var Action: TCloseAction); 69 | begin 70 | Action := caFree; 71 | end; 72 | 73 | procedure TChildForm.FormCreate(Sender: TObject); 74 | begin 75 | EnableNCShadow(Handle); 76 | if frmMenu.PopupWindowRect.Width > 100 then 77 | begin 78 | BoundsRect := frmMenu.PopupWindowRect; 79 | end; 80 | end; 81 | 82 | procedure TChildForm.FormDestroy(Sender: TObject); 83 | begin 84 | if assigned(FDeferral) then 85 | FreeAndNil(FDeferral); 86 | 87 | if assigned(FArgs) then 88 | FreeAndNil(FArgs); 89 | end; 90 | 91 | procedure TChildForm.FormResize(Sender: TObject); 92 | begin 93 | frmMenu.PopupWindowRect := BoundsRect; 94 | end; 95 | 96 | procedure TChildForm.FormShow(Sender: TObject); 97 | var 98 | TempWindowFeatures : TCoreWebView2WindowFeatures; 99 | begin 100 | TempWindowFeatures := nil; 101 | 102 | if assigned(FArgs) then 103 | try 104 | TempWindowFeatures := TCoreWebView2WindowFeatures.Create(FArgs.WindowFeatures); 105 | 106 | if TempWindowFeatures.HasPosition then 107 | begin 108 | WVBrowser1.SetFormLeftTo(TempWindowFeatures.Left); 109 | WVBrowser1.SetFormTopTo(TempWindowFeatures.Top); 110 | end; 111 | 112 | if TempWindowFeatures.HasSize then 113 | begin 114 | WVBrowser1.ResizeFormWidthTo(TempWindowFeatures.width); 115 | WVBrowser1.ResizeFormHeightTo(TempWindowFeatures.height); 116 | end; 117 | finally 118 | if assigned(TempWindowFeatures) then 119 | FreeAndNil(TempWindowFeatures); 120 | end; 121 | // WVBrowser1.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/116.0.0.0 Safari/537.36 Edg/116.0.0.0'; 122 | WVBrowser1.CreateBrowser(WVWindowParent1.Handle); 123 | 124 | end; 125 | 126 | procedure TChildForm.StatusBar1DblClick(Sender: TObject); 127 | var 128 | url: string; 129 | begin 130 | url := StatusBar1.Panels[0].Text; 131 | if url.StartsWith('http') then 132 | ShellExecute(0, 'OPEN', PChar(url), nil, nil, SW_SHOWNORMAL); 133 | end; 134 | 135 | procedure TChildForm.WVBrowser1AfterCreated(Sender: TObject); 136 | begin 137 | if assigned(FArgs) and assigned(FDeferral) then 138 | try 139 | FArgs.NewWindow := WVBrowser1.CoreWebView2.BaseIntf; 140 | FArgs.Handled := True; 141 | 142 | FDeferral.Complete; 143 | finally 144 | FreeAndNil(FDeferral); 145 | FreeAndNil(FArgs); 146 | end; 147 | 148 | WVWindowParent1.UpdateSize; 149 | if FURL <> '' then 150 | WVBrowser1.Navigate(FURL); 151 | end; 152 | 153 | procedure TChildForm.WVBrowser1DocumentTitleChanged(Sender: TObject); 154 | begin 155 | Caption := 'AIChatBar - ' + WVBrowser1.DocumentTitle; 156 | StatusBar1.Panels[0].Text := WVBrowser1.Source; 157 | end; 158 | 159 | procedure TChildForm.WVBrowser1NewWindowRequested(Sender: TObject; 160 | const aWebView: ICoreWebView2; 161 | const aArgs: ICoreWebView2NewWindowRequestedEventArgs); 162 | var 163 | TempChildForm : TChildForm; 164 | begin 165 | TempChildForm := TChildForm.Create(Self, aArgs); 166 | TempChildForm.Show; 167 | end; 168 | 169 | procedure TChildForm.WVBrowser1WindowCloseRequested(Sender: TObject); 170 | begin 171 | PostMessage(Handle, WM_CLOSE, 0, 0); 172 | end; 173 | 174 | end. 175 | -------------------------------------------------------------------------------- /utils.pas: -------------------------------------------------------------------------------- 1 | unit utils; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Forms, Classes, TLHelp32, PsAPI, SysUtils, Registry, Graphics, DWMAPI, 7 | OleAcc, Variants, DirectDraw, ActiveX, ShellAPI; 8 | 9 | function IsDirectXAppRunningFullScreen: Boolean; 10 | function DetectFullScreen3D: Boolean; 11 | function DetectFullScreenApp(AHandle: HWND = 0): Boolean; 12 | function IsDesktopWindow(AHandle: HWND): Boolean; 13 | 14 | implementation 15 | 16 | function GetShellWindow:HWND;stdcall; 17 | external user32 Name 'GetShellWindow'; 18 | 19 | function IsDirectXAppRunningFullScreen: Boolean; 20 | var 21 | LSPI: Boolean; 22 | begin 23 | Result := False; 24 | if SystemParametersInfo(SPI_GETCURSORSHADOW, 0, @LSPI, 0) and not LSPI then 25 | begin 26 | if SystemParametersInfo(SPI_GETHOTTRACKING, 0, @LSPI, 0) and not LSPI then 27 | begin 28 | Result := DetectFullScreen3D; 29 | end; 30 | end; 31 | end; 32 | 33 | function DetectFullScreen3D: Boolean; 34 | var 35 | DW: IDirectDraw7; 36 | HR: HRESULT; 37 | begin 38 | Result := False; 39 | 40 | HR := coinitialize(nil); 41 | if Succeeded(HR) then 42 | begin 43 | HR := DirectDrawCreateEx(PGUID(DDCREATE_EMULATIONONLY), DW, IDirectDraw7, nil); 44 | if HR = DD_OK then 45 | begin 46 | HR := DW.TestCooperativeLevel; 47 | if HR = DDERR_EXCLUSIVEMODEALREADYSET then 48 | Result := True; 49 | end; 50 | end; 51 | 52 | CoUninitialize; 53 | end; 54 | 55 | function DetectFullScreenApp(AHandle: HWND = 0): Boolean; 56 | var 57 | curwnd: HWND; 58 | wndPlm: WINDOWPLACEMENT; 59 | R: TRect; 60 | Mon: TMonitor; 61 | begin 62 | Result := False; 63 | if AHandle = 0 then 64 | curwnd := GetForegroundWindow 65 | else 66 | curwnd := AHandle; 67 | if curwnd <= 0 then Exit; 68 | 69 | // ignore maximized windows with caption bar 70 | if GetWindowLong(curwnd, GWL_STYLE) and WS_CAPTION = WS_CAPTION then 71 | Exit; 72 | 73 | if not IsWindow(curwnd) then Exit; 74 | if IsDesktopWindow(curwnd) then Exit; 75 | 76 | Mon := Screen.MonitorFromWindow(curwnd); 77 | { TODO : This workaround kind of fixes, but it blocks on fast fullscreen apps detection leaving them as if it were full app, } 78 | // if Assigned(Mon) then //o fix Mon.BoundsRect EAccessViolation ... added Assigned(Mon) to following 2 comparisons 79 | begin 80 | GetWindowRect(curwnd, R); 81 | GetWindowPlacement(curwnd, wndPlm); 82 | if (wndPlm.showCmd and SW_SHOWMAXIMIZED) = SW_SHOWMAXIMIZED then 83 | begin 84 | if Assigned(Mon) and (Mon.BoundsRect.Width = R.Width) and (Mon.BoundsRect.Height = R.Height) then 85 | Result := True; 86 | end 87 | else 88 | begin 89 | // some applications do not set SW_SHOWMAXIMIZED flag e.g. MPC-HC media player 90 | // ignore maximized when workarearect is similar (i.e. taskbar is on top, might not be the same on secondary monitor) 91 | // if IsTaskbarAlwaysOnTop then 92 | // begin 93 | // if (Screen.MonitorCount > 1) and (Mon.Handle = 94 | // if ((Screen.MonitorCount > 1) and (FindWindow('Shell_SecondaryTrayWnd', nil)<>0) and (Mon.WorkareaRect <> Mon.BoundsRect)) 95 | // // if there is another monitor without taskbar then 96 | // or ((Screen.MonitorCount > 1) and (FindWindow('Shell_SecondaryTrayWnd', nil)=0) and (Mon.WorkareaRect = Mon.BoundsRect)) 97 | // then 98 | begin 99 | if Assigned(Mon) and (Mon.BoundsRect.Width = R.Width) and (Mon.BoundsRect.Height = R.Height) then 100 | Result := True; 101 | // end; 102 | end; 103 | end; 104 | end; 105 | end; 106 | 107 | // detect desktop is present 108 | // those are different on specific conditions, like slideshow, win10 special features, and maybe third party tools installed for desktop handling 109 | function IsDesktopWindow(AHandle: HWND): Boolean; 110 | var 111 | AppClassName: array[0..255] of char; 112 | ChildHwnd: HWND; 113 | begin 114 | Result := False; 115 | if AHandle = GetDesktopWindow then Result := True 116 | else if AHandle = GetShellWindow then Result := True 117 | else 118 | begin 119 | GetClassName(AHandle, AppClassName, 255); 120 | if AppClassName = 'WorkerW' then 121 | begin 122 | // it should have a children with 'SHELLDLL_DefView' present 123 | ChildHwnd := FindWindowEx(AHandle, 0, 'SHELLDLL_DefView', nil); 124 | if ChildHwnd <> 0 then 125 | begin 126 | //if DetectFullScreenApp(AHandle) then 127 | Result := True; 128 | end; 129 | end; 130 | end; 131 | end; 132 | 133 | end. 134 | --------------------------------------------------------------------------------