├── .gitignore ├── MIT-License.md ├── README.md ├── article-02+03 ├── Hello.rtf ├── LICENSE.md ├── RCDataCreator.dpr ├── RCDataCreatorForm.dfm ├── RCDataCreatorForm.pas ├── RCDataUser.dpr ├── RCDataUserForm.dfm ├── RCDataUserForm.pas └── README.md ├── article-04 ├── LICENSE.md ├── README.md ├── WdwStateDemo.dpr ├── WdwStateDemo.res ├── WdwStateDemoFm.dfm └── WdwStateDemoFm.pas ├── article-05 ├── LICENSE.md ├── MainForm.dfm ├── MainForm.pas ├── README.md └── StrWrapArtPrj.dpr ├── article-06 ├── ChangeLog.txt ├── Clean.bat ├── FmSpawnProcess.dfm ├── FmSpawnProcess.pas ├── FmTestEnvVars.dfm ├── FmTestEnvVars.pas ├── FmTestExpandVars.dfm ├── FmTestExpandVars.pas ├── LICENSE.md ├── README.md ├── TestEnvVars.dpr ├── TestEnvVars.dproj ├── TestEnvVars.res └── UEnvVars.pas ├── article-07 ├── FmReader.dfm ├── FmReader.pas ├── FmWriter.dfm ├── FmWriter.pas ├── LICENSE.md ├── Payload.bpg ├── README.md ├── Reader.dpr ├── Reader.res ├── UPayload.pas ├── Writer.dpr └── Writer.res ├── article-08 ├── ExeType.dpr ├── ExeType.res ├── LICENSE.md ├── MainForm.dfm ├── MainForm.pas ├── PJDropFiles.pas └── README.md ├── article-09 ├── CBEdit.dpr ├── CBEdit.dproj ├── CBEdit.res ├── FmEditor.dfm ├── FmEditor.pas ├── LICENSE.md └── README.md ├── article-10 ├── Article10.dpr ├── Article10.res ├── FmMain.dfm ├── FmMain.pas ├── HTML.rc ├── HTML.res ├── HTML │ ├── index.html │ ├── logo.gif │ ├── page1.html │ ├── page2.html │ ├── rcdata.html │ └── style.css ├── LICENSE.md └── README.md ├── article-11 ├── DragDropDemo.cfg ├── DragDropDemo.dof ├── DragDropDemo.dpr ├── DragDropDemo.dsk ├── DragDropDemo.res ├── FmMain.dfm ├── FmMain.pas ├── LICENSE.md ├── README.md └── UFileCatcher.pas ├── article-12 ├── FmSendToDemo.dfm ├── FmSendToDemo.pas ├── LICENSE.md ├── README.md ├── SendToDemo.dpr └── SendToDemo.res ├── article-13 ├── Article13.bpg ├── Clean.bat ├── LICENSE.md ├── README.md ├── SingleInstDemo │ ├── FmDemo.dfm │ ├── FmDemo.pas │ ├── SingleInstDemo.dpr │ ├── SingleInstDemo.res │ ├── UMySingleInst.pas │ └── USingleInst.pas └── TemplateDemo │ ├── FmTemplate.dfm │ ├── FmTemplate.pas │ ├── TemplateDemo.dpr │ ├── TemplateDemo.res │ └── UStartup.pas ├── article-14 ├── Clean.bat ├── FmMain.dfm ├── FmMain.pas ├── FmSampleCodeEncodingDlg.dfm ├── FmSampleCodeEncodingDlg.pas ├── FmSaveEncodingDlg.dfm ├── FmSaveEncodingDlg.pas ├── HTML.rc ├── HTML.res ├── LICENSE.md ├── README.md ├── Resources │ ├── HTMLRes.html │ ├── Help.html │ ├── Sample-ANSI.html │ ├── Sample-UCS2LE.html │ └── Sample-UTF8.html ├── Test-ANSI.html ├── Test-USC2BE.html ├── Test-USC2LE.html ├── Test-UTF8.html ├── UWebBrowserWrapper.pas ├── WebBrowserTests.dpr ├── WebBrowserTests.dproj └── WebBrowserTests.res ├── article-16 ├── CustomLVDemo.dpr ├── CustomLVDemo.res ├── DelphiDabbler.ico ├── FmLVCustDrawDemo.dfm ├── FmLVCustDrawDemo.pas ├── LICENSE.md └── README.md ├── article-17 ├── DefEventDemo.pas ├── LICENSE.md └── README.md ├── article-18 ├── CHANGELOG.md ├── Clean.bat ├── LICENSE.md ├── Phase1 │ ├── FmArtDemo1.dfm │ ├── FmArtDemo1.pas │ ├── WBUIArtDemo1.bdsproj │ ├── WBUIArtDemo1.dpr │ ├── WBUIArtDemo1.dproj │ └── WBUIArtDemo1.res ├── Phase2 │ ├── FmArtDemo2.dfm │ ├── FmArtDemo2.pas │ ├── IntfDocHostUIHandler.pas │ ├── UContainer.pas │ ├── UNulContainer.pas │ ├── WBUIArtDemo2.bdsproj │ ├── WBUIArtDemo2.dpr │ ├── WBUIArtDemo2.dproj │ └── WBUIArtDemo2.res ├── README.md ├── Shared │ └── DlgContent.html ├── WBUIDemos.bdsgroup ├── WBUIDemos.bpg └── WBUIDemos.groupproj ├── article-19 ├── 1 │ ├── Demo1.dpr │ ├── Demo1.res │ ├── FmDemo1.dfm │ └── FmDemo1.pas ├── 2 │ ├── Demo2.dpr │ ├── Demo2.res │ ├── FmDemo2.dfm │ └── FmDemo2.pas ├── 3 │ ├── Demo3.dpr │ ├── Demo3.res │ ├── FmDemo3.dfm │ └── FmDemo3.pas ├── LICENSE.md └── README.md ├── article-20 ├── Article20.bpg ├── Article20.dpr ├── Article20.res ├── FmDemo.dfm ├── FmDemo.pas ├── LICENSE.md ├── MultiVer.dpr ├── NoTransVer.dpr ├── NoVerInfo.dpr ├── README.md ├── UVerInfoClass.pas ├── UVerInfoRoutines.pas ├── UVerInfoTypes.pas ├── VArticle20.rc ├── VArticle20.res ├── VMultiVer.rc ├── VMultiVer.res ├── VNoTransVer.rc └── VNoTransVer.res ├── article-21 ├── CaseStudy │ ├── Article21.dpr │ ├── Article21.res │ ├── FmDemo.dfm │ ├── FmDemo.pas │ └── Test.html ├── LICENSE.md ├── README.md └── ReturnValue │ ├── Demo.dpr │ ├── Demo.res │ ├── Unit1.dfm │ ├── Unit1.pas │ └── test.htm ├── article-22 ├── Article22.dat ├── Article22.dpr ├── Article22.html ├── Article22.res ├── Article22.tlb ├── Article22_TLB.pas ├── CHANGELOG.md ├── FmDemo.dfm ├── FmDemo.pas ├── IntfDocHostUIHandler.pas ├── LICENSE.md ├── README.md ├── UExternalContainer.pas ├── UMyExternal.pas └── UNulContainer.pas ├── article-23 ├── Article23.dpr ├── Article23.res ├── FmDemo.dfm ├── FmDemo.pas ├── LICENSE.md ├── README.md └── UOSInfo.pas ├── article-24 ├── Article24.bpg ├── Eg1 │ ├── Article24Eg1.dpr │ ├── Article24Eg1.res │ ├── FmEg1.dfm │ ├── FmEg1.pas │ └── UHelper.pas ├── Eg2 │ ├── Article24Eg2.dpr │ ├── Article24Eg2.res │ ├── FmEg2.dfm │ └── FmEg2.pas ├── LICENSE.md └── README.md ├── article-25 ├── 1 │ ├── Article25Demo1.dpr │ ├── Article25Demo1.res │ ├── FmDemo1.dfm │ └── FmDemo1.pas ├── 2 │ ├── Article25Demo2.dpr │ ├── Article25Demo2.res │ ├── FmDemo2.dfm │ └── FmDemo2.pas ├── 3 │ ├── Article25Demo3.dpr │ ├── Article25Demo3.res │ ├── FmDemo3.dfm │ ├── FmDemo3.pas │ └── UNulDropTarget.pas ├── 4 │ ├── Article25Demo4.dpr │ ├── Article25Demo4.res │ ├── Demo4.html │ ├── FmDemo4.dfm │ ├── FmDemo4.pas │ └── UCustomDropTarget.pas ├── Article25Demos.bpg ├── CHANGELOG.md ├── LICENSE.md ├── README.md └── Shared │ ├── IntfDocHostUIHandler.pas │ ├── MainIcon.ico │ ├── UNulContainer.pas │ └── UWBDragDropContainer.pas └── article-27 ├── EnumDelphiInstalls.dpr ├── EnumDelphiInstalls.dproj ├── EnumDelphiInstalls.res ├── LICENSE.md ├── README.md ├── Unit1.dfm └── Unit1.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Based on Delphi.gitignore from https://github.com/github/gitignore 2 | # Public domain CC0 license https://creativecommons.org/publicdomain/zero/1.0/ 3 | 4 | # Uncomment these types if you want even more clean repository. But be careful. 5 | # It can make harm to an existing project source. Read explanations below. 6 | # 7 | # Resource files are binaries containing manifest, project icon and version info. 8 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 9 | #*.res 10 | # 11 | # Type library file (binary). In old Delphi versions it should be stored. 12 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 13 | #*.tlb 14 | # 15 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 16 | # Uncomment this if you are not using diagrams or use newer Delphi version. 17 | *.ddp 18 | # 19 | # Visual LiveBindings file. Added in Delphi XE2. 20 | # Uncomment this if you are not using LiveBindings Designer. 21 | *.vlb 22 | # 23 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 24 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 25 | *.deployproj 26 | # 27 | 28 | # Delphi compiler-generated binaries (safe to delete) 29 | *.exe 30 | *.dll 31 | *.bpl 32 | *.bpi 33 | *.dcp 34 | *.so 35 | *.apk 36 | *.drc 37 | *.map 38 | *.dres 39 | *.rsm 40 | *.tds 41 | 42 | # Delphi autogenerated files (duplicated info) 43 | #*.cfg 44 | #*Resource.rc 45 | 46 | # Delphi local files (user-specific info) 47 | *.local 48 | *.identcache 49 | *.projdata 50 | *.tvsconfig 51 | *.dsk 52 | 53 | # Delphi history and backups 54 | __history/ 55 | __recovery 56 | *.~* 57 | 58 | # Project specific files added by DelphiDabbler: 59 | 60 | # unit files 61 | *.dcu 62 | 63 | # project option files for Delphi 7 64 | # (we create them as required from .tplt files) 65 | *.dof 66 | *.cfg 67 | # Build directories (Exe not actually needed since it is covered by *.exe above 68 | Bin 69 | Release 70 | Exe 71 | -------------------------------------------------------------------------------- /MIT-License.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright 2020-2022 Peter Johnson (https://gravatar.com/delphidabbler) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 6 | 7 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # article-demos 2 | 3 | This repository contains demo code relating to [articles](https://delphidabbler.com/articles) on [delphidabbler.com](https://delphidabbler.com). 4 | 5 | Each article's demo is placed in a subdirectory named after the article number. 6 | 7 | # Bug Reports 8 | 9 | > **Note:** Unless otherwise stated, the demos are designed for compilation with Delphi for Windows targets only. Please do not report bugs for other compilers or other OS targets. 10 | 11 | *Only report bugs in article **demo** projects here. If you've found an error in an article itself please report it on the [website's Issues page](https://github.com/delphidabbler/delphidabbler.github.io/issues) instead.* 12 | 13 | 14 | If you find a bug in any of the demos please report it on the [Issues page](https://github.com/delphidabbler/article-demos/issues). 15 | 16 | Before creating a new issue please do the following: 17 | 18 | 1. Make sure you are using the latest version of the demo. If not please update your code and check that the bug still exists. 19 | 2. Read any documentation included with the demo - it's possible that the demo won't work with your version of Delphi or Windows. 20 | 3. Check if the bug has already been reported. If so please add any information you can to that report and / or give the issue a :+1: (entered as `:+1:`). 21 | 22 | If, having worked through the checklist above, you've found a new bug then please create a new issue. You should: 23 | 24 | * Specify the number, title or URL of the article the demo relates to. 25 | * Describe the bug, giving as much detail as possible. 26 | * State which version of Delphi you are using and whether you were compiling for a 32 or 64 bit target. 27 | * State which version of Windows you are using. 28 | * If possible provide the source code of a test case that reproduces the bug. Feel free to upload a zip file containing the source. 29 | * I you are able, provide a fix by submitting a pull request (preferred) or attaching source code. 30 | 31 | # Licenses 32 | 33 | Each article's demo code has its own license that is described in a file named `LICENSE.md` located in the demo subdirectory. 34 | 35 | `.gitignore`, in the repository root, is based on `Delphi.gitignore` from the [github/gitignore](https://github.com/github/gitignore) project and is licensed under the [CC0-1.0](https://raw.githubusercontent.com/github/gitignore/master/LICENSE) Public Domain license. 36 | -------------------------------------------------------------------------------- /article-02+03/Hello.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl {\f0\fnil\fcharset0 Times New Roman;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fnil\fcharset2 Symbol;}} 2 | {\colortbl ;\red0\green0\blue0;\red0\green128\blue0;\red0\green0\blue128;} 3 | \uc1\pard\cf1\ulnone\f0\fs28 This demo program shows how to:\par 4 | \cf0\fs20\par 5 | \pard {\pntext\f2\'b7\tab}{\*\pn\pnlvlblt\pnf2\pnindent0{\pntxtb\'b7}}\fi-720\li720\cf2\f1\fs24 create a resource file that embeds a data file\cf0\par 6 | \cf3 {\pntext\f2\'b7\tab}read the data from the resource file.\cf0\par 7 | \pard\f0\fs20\par 8 | \fs24 I hope it's been useful.\par 9 | \fs20\par 10 | } 11 | -------------------------------------------------------------------------------- /article-02+03/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Articles 2 & 3 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-02+03/RCDataCreator.dpr: -------------------------------------------------------------------------------- 1 | program RCDataCreator; 2 | 3 | uses 4 | Forms, 5 | RCDataCreatorForm in 'RCDataCreatorForm.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-02+03/RCDataCreatorForm.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-02+03/RCDataCreatorForm.dfm -------------------------------------------------------------------------------- /article-02+03/RCDataCreatorForm.pas: -------------------------------------------------------------------------------- 1 | unit RCDataCreatorForm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | Button1: TButton; 12 | Button2: TButton; 13 | procedure Button1Click(Sender: TObject); 14 | procedure Button2Click(Sender: TObject); 15 | end; 16 | 17 | var 18 | Form1: TForm1; 19 | 20 | implementation 21 | 22 | {$R *.DFM} 23 | type 24 | TResHeader = record 25 | DataSize: DWORD; 26 | HeaderSize: DWORD; 27 | ResType: DWORD; 28 | ResId: DWORD; 29 | DataVersion: DWORD; 30 | MemoryFlags: WORD; 31 | LanguageId: WORD; 32 | Version: DWORD; 33 | Characteristics: DWORD; 34 | end; 35 | 36 | procedure CreateResourceFile( 37 | DataFile, ResFile: string; // file names 38 | ResID: Integer // id of resource 39 | ); 40 | var 41 | FS, RS: TFileStream; 42 | FileHeader, ResHeader: TResHeader; 43 | Padding: array[0..SizeOf(DWORD)-1] of Byte; 44 | begin 45 | FS := TFileStream.Create( // to read data file 46 | DataFile, fmOpenRead); 47 | RS := TFileStream.Create( // to write res file 48 | ResFile, fmCreate); 49 | { Create res file header - all zeros except 50 | for HeaderSize, ResType and ResID } 51 | FillChar(FileHeader, SizeOf(FileHeader), #0); 52 | FileHeader.HeaderSize := SizeOf(FileHeader); 53 | FileHeader.ResId := $0000FFFF; 54 | FileHeader.ResType := $0000FFFF; 55 | { Create data header for RC_DATA file } 56 | FillChar(ResHeader, SizeOf(ResHeader), #0); 57 | ResHeader.HeaderSize := SizeOf(ResHeader); 58 | // resource id - FFFF says "not a string!" 59 | ResHeader.ResId := $0000FFFF or (ResId shl 16); 60 | // resource type - RT_RCDATA (from Windows unit) 61 | ResHeader.ResType := $0000FFFF 62 | or (WORD(RT_RCDATA) shl 16); 63 | // data file size is size of file 64 | ResHeader.DataSize := FS.Size; 65 | // set required memory flags 66 | ResHeader.MemoryFlags := $0030; 67 | { Write the headers to the resource file } 68 | RS.WriteBuffer(FileHeader, sizeof(FileHeader)); 69 | RS.WriteBuffer(ResHeader, sizeof(ResHeader)); 70 | { Copy the file into the resource } 71 | RS.CopyFrom(FS, FS.Size); 72 | { Pad data out to DWORD boundary } 73 | if FS.Size mod SizeOf(DWORD) <> 0 then 74 | RS.WriteBuffer(Padding, SizeOf(DWORD) - 75 | FS.Size mod SizeOf(DWORD)); 76 | { Close the files } 77 | FS.Free; 78 | RS.Free; 79 | end; 80 | 81 | procedure TForm1.Button1Click(Sender: TObject); 82 | begin 83 | // Create out resource file 84 | CreateResourceFile('Hello.rtf', 'Hello.res', 100); 85 | // Show a message to say we've done 86 | ShowMessage('Resource file Hello.res has been created'#10#10 87 | + 'Now build RCDataUser.dpr and run it'); 88 | end; 89 | 90 | procedure TForm1.Button2Click(Sender: TObject); 91 | begin 92 | // Close the app 93 | Close; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /article-02+03/RCDataUser.dpr: -------------------------------------------------------------------------------- 1 | program RCDataUser; 2 | 3 | uses 4 | Forms, 5 | RCDataUserForm in 'RCDataUserForm.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | {$R HELLO.RES} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TForm1, Form1); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /article-02+03/RCDataUserForm.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-02+03/RCDataUserForm.dfm -------------------------------------------------------------------------------- /article-02+03/RCDataUserForm.pas: -------------------------------------------------------------------------------- 1 | unit RCDataUserForm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, ComCtrls; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | RichEdit1: TRichEdit; 12 | Button1: TButton; 13 | Button2: TButton; 14 | procedure Button1Click(Sender: TObject); 15 | procedure Button2Click(Sender: TObject); 16 | private 17 | { Private declarations } 18 | public 19 | { Public declarations } 20 | end; 21 | 22 | var 23 | Form1: TForm1; 24 | 25 | implementation 26 | 27 | {$R *.DFM} 28 | 29 | procedure TForm1.Button1Click(Sender: TObject); 30 | var 31 | RS: TResourceStream; 32 | begin 33 | // Create resource stream 34 | RS := TResourceStream.CreateFromID(HInstance, 100, RT_RCDATA); 35 | try 36 | // Load the rich edit component 37 | RichEdit1.Lines.LoadFromStream(RS); 38 | finally 39 | // Free the stream 40 | RS.Free; 41 | end; 42 | end; 43 | 44 | procedure TForm1.Button2Click(Sender: TObject); 45 | begin 46 | Close; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /article-02+03/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Articles 2 & 3 2 | 3 | This directory contains demo code for DelphiDabbler's articles "[How to store files inside an executable program](https://delphidabbler.com/articles/article-2)" and "[How to read data embedded in your program's resources](https://delphidabbler.com/articles/article-3)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 30 September 2001. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 24 April 2022. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-04/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 4 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-04/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 4 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to remember a window's size, state and position](https://delphidabbler.com/articles/article-4)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 27 March 2000. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 27 May 2020. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-04/WdwStateDemo.dpr: -------------------------------------------------------------------------------- 1 | program WdwStateDemo; 2 | 3 | uses 4 | Forms, 5 | WdwStateDemoFm in 'WdwStateDemoFm.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-04/WdwStateDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-04/WdwStateDemo.res -------------------------------------------------------------------------------- /article-04/WdwStateDemoFm.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-04/WdwStateDemoFm.dfm -------------------------------------------------------------------------------- /article-05/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 5 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-05/MainForm.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-05/MainForm.dfm -------------------------------------------------------------------------------- /article-05/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 5 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to write filters that extend the functionality of the TStream classes](https://delphidabbler.com/articles/article-5)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 24 April 2000. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 24 April 2022. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-05/StrWrapArtPrj.dpr: -------------------------------------------------------------------------------- 1 | program StrWrapArtPrj; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {Main}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TMain, Main); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-06/ChangeLog.txt: -------------------------------------------------------------------------------- 1 | v1.2 of 19 Feb 2010 2 | + Main environment variables unit brought into sync with code from article. 3 | + Renamed main unit from PJEnvVars to UEnvVars. Former clashed with Delphi library code on delphidabbler.com. 4 | + Added project file for later Delphis. 5 | + Added batch file to remove binaries and temporary editing files. 6 | + Switch off unsafe code warnings in Delphi 7 and later. 7 | + Updated code that executes child apps to work correctly on Unicode API. 8 | + Added disclaimers to source code. 9 | + Updated documentation. 10 | 11 | v1.1 of 13 Aug 2003 12 | + Fixed bug in GetEnvVar routine in PJEnvVars.pas 13 | 14 | v1.0 of unknown date 15 | + Original demo 16 | -------------------------------------------------------------------------------- /article-06/Clean.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal 3 | 4 | echo Tidying 5 | echo ~~~~~~~ 6 | echo. 7 | 8 | set RootDir=. 9 | 10 | echo Deleting temporary files 11 | del /S %RootDir%\*.~* 12 | del /S %RootDir%\*.tmp 13 | del /S %RootDir%\*.ddp 14 | del /S %RootDir%\*.dcu 15 | del /S %RootDir%\*.exe 16 | del /S %RootDir%\*.dsk 17 | del /S %RootDir%\*.bak 18 | del /S %RootDir%\*.local 19 | del /S %RootDir%\*.identcache 20 | del /S /AH %RootDir%\*.GID 21 | echo. 22 | 23 | echo Deleting temporary directories 24 | for /F "usebackq" %%i in (`dir /S /B /A:D %RootDir%\__history*`) do rmdir /S /Q %%i 25 | echo. 26 | 27 | echo Done. 28 | 29 | endlocal 30 | -------------------------------------------------------------------------------- /article-06/FmSpawnProcess.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-06/FmSpawnProcess.dfm -------------------------------------------------------------------------------- /article-06/FmTestEnvVars.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-06/FmTestEnvVars.dfm -------------------------------------------------------------------------------- /article-06/FmTestExpandVars.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-06/FmTestExpandVars.dfm -------------------------------------------------------------------------------- /article-06/FmTestExpandVars.pas: -------------------------------------------------------------------------------- 1 | unit FmTestExpandVars; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | TExpandVarsDlg = class(TForm) 11 | memoToExpand: TMemo; 12 | memoExpanded: TMemo; 13 | cbVars: TComboBox; 14 | lblVars: TLabel; 15 | btnClose: TButton; 16 | btnExpand: TButton; 17 | procedure cbVarsClick(Sender: TObject); 18 | procedure btnExpandClick(Sender: TObject); 19 | procedure FormShow(Sender: TObject); 20 | end; 21 | 22 | var 23 | ExpandVarsDlg: TExpandVarsDlg; 24 | 25 | implementation 26 | 27 | uses 28 | UEnvVars; 29 | 30 | {$R *.DFM} 31 | 32 | procedure TExpandVarsDlg.btnExpandClick(Sender: TObject); 33 | // expand env vars in string in upper memo and display result in lower memo 34 | begin 35 | memoExpanded.Text := ExpandEnvVars(memoToExpand.Text); 36 | end; 37 | 38 | procedure TExpandVarsDlg.cbVarsClick(Sender: TObject); 39 | // add environment var with chosen name to upper memo at insertion point 40 | begin 41 | if (cbVars.ItemIndex > -1) and (cbVars.Items[cbVars.ItemIndex] <> '') then 42 | begin 43 | memoToExpand.SelText := '%' + cbVars.Items[cbVars.ItemIndex] + '%'; 44 | memoToExpand.SetFocus; 45 | end; 46 | end; 47 | 48 | procedure TExpandVarsDlg.FormShow(Sender: TObject); 49 | // populate combo box with current env var names 50 | var 51 | Vars: TStringList; // all env vars 52 | Idx: Integer; // loops thru env vars 53 | begin 54 | // get current env vars 55 | Vars := TStringList.Create; 56 | try 57 | GetAllEnvVars(Vars); 58 | // add names of vars to combo box 59 | cbVars.Clear; 60 | for Idx := 0 to Pred(Vars.Count) do 61 | cbVars.Items.Add(Vars.Names[Idx]); 62 | finally 63 | Vars.Free; 64 | end; 65 | end; 66 | 67 | 68 | end. 69 | -------------------------------------------------------------------------------- /article-06/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 6 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-06/TestEnvVars.dpr: -------------------------------------------------------------------------------- 1 | program TestEnvVars; 2 | 3 | uses 4 | Forms, 5 | FmTestEnvVars in 'FmTestEnvVars.pas' {EnvVarsForm}, 6 | UEnvVars in 'UEnvVars.pas', 7 | FmSpawnProcess in 'FmSpawnProcess.pas' {SpawnDlg}, 8 | FmTestExpandVars in 'FmTestExpandVars.pas' {ExpandVarsDlg}; 9 | 10 | {$R *.RES} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.CreateForm(TEnvVarsForm, EnvVarsForm); 15 | Application.CreateForm(TSpawnDlg, SpawnDlg); 16 | Application.CreateForm(TExpandVarsDlg, ExpandVarsDlg); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /article-06/TestEnvVars.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-06/TestEnvVars.res -------------------------------------------------------------------------------- /article-07/FmReader.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-07/FmReader.dfm -------------------------------------------------------------------------------- /article-07/FmReader.pas: -------------------------------------------------------------------------------- 1 | unit FmReader; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | TReaderForm = class(TForm) 11 | memData: TMemo; 12 | btnClose: TButton; 13 | lblHelp: TLabel; 14 | lblSize: TLabel; 15 | procedure btnCloseClick(Sender: TObject); 16 | procedure FormCreate(Sender: TObject); 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | ReaderForm: TReaderForm; 25 | 26 | implementation 27 | 28 | uses 29 | UPayload; 30 | 31 | {$R *.DFM} 32 | 33 | procedure TReaderForm.btnCloseClick(Sender: TObject); 34 | begin 35 | Close; 36 | end; 37 | 38 | procedure TReaderForm.FormCreate(Sender: TObject); 39 | var 40 | PL: TPayload; 41 | DataStr: string; 42 | begin 43 | PL := TPayload.Create(ParamStr(0)); 44 | try 45 | if PL.HasPayload then 46 | begin 47 | lblSize.Caption := Format('Payload data size = %d', [PL.PayloadSize]); 48 | SetLength(DataStr, PL.PayloadSize); 49 | PL.GetPayload(PChar(DataStr)^); 50 | memData.Text := DataStr; 51 | end 52 | else 53 | begin 54 | lblSize.Caption := 'No payload present'; 55 | lblSize.Font.Style := [fsBold]; 56 | end; 57 | finally 58 | PL.Free; 59 | end; 60 | 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /article-07/FmWriter.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-07/FmWriter.dfm -------------------------------------------------------------------------------- /article-07/FmWriter.pas: -------------------------------------------------------------------------------- 1 | unit FmWriter; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | TWriterForm = class(TForm) 11 | lblHelp: TLabel; 12 | memData: TMemo; 13 | btnStore: TButton; 14 | btnDelete: TButton; 15 | btnClose: TButton; 16 | procedure btnCloseClick(Sender: TObject); 17 | procedure btnDeleteClick(Sender: TObject); 18 | procedure btnStoreClick(Sender: TObject); 19 | procedure FormCreate(Sender: TObject); 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | var 27 | WriterForm: TWriterForm; 28 | 29 | implementation 30 | 31 | uses 32 | UPayload; 33 | 34 | const 35 | cReaderFile = 'Reader.exe'; 36 | 37 | {$R *.DFM} 38 | 39 | procedure TWriterForm.btnCloseClick(Sender: TObject); 40 | begin 41 | Close; 42 | end; 43 | 44 | procedure TWriterForm.btnDeleteClick(Sender: TObject); 45 | var 46 | PL: TPayload; 47 | begin 48 | PL := TPayload.Create(cReaderFile); 49 | try 50 | PL.RemovePayload; 51 | finally 52 | PL.Free; 53 | end; 54 | end; 55 | 56 | procedure TWriterForm.btnStoreClick(Sender: TObject); 57 | var 58 | PL: TPayload; 59 | begin 60 | PL := TPayload.Create(cReaderFile); 61 | try 62 | PL.SetPayload(PChar(memData.Text)^, Length(memData.Text)); 63 | finally 64 | PL.Free; 65 | end; 66 | end; 67 | 68 | procedure TWriterForm.FormCreate(Sender: TObject); 69 | begin 70 | if not FileExists(cReaderFile) then 71 | begin 72 | lblHelp.Caption := 73 | 'ERROR:'#13#10'You must compile Reader.exe before using this program.'; 74 | lblHelp.Font.Color := clRed; 75 | lblHelp.Font.Style := [fsBold]; 76 | btnDelete.Enabled := False; 77 | btnStore.Enabled := False; 78 | end; 79 | end; 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /article-07/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 7 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-07/Payload.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = Reader.exe Writer.exe 13 | #------------------------------------------------------------------------------ 14 | default: $(PROJECTS) 15 | #------------------------------------------------------------------------------ 16 | 17 | Reader.exe: Reader.dpr 18 | $(DCC) 19 | 20 | Writer.exe: Writer.dpr 21 | $(DCC) 22 | 23 | 24 | -------------------------------------------------------------------------------- /article-07/Reader.dpr: -------------------------------------------------------------------------------- 1 | program Reader; 2 | 3 | uses 4 | Forms, 5 | FmReader in 'FmReader.pas' {ReaderForm}, 6 | UPayload in 'UPayload.pas'; 7 | 8 | {$R *.RES} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TReaderForm, ReaderForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-07/Reader.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-07/Reader.res -------------------------------------------------------------------------------- /article-07/Writer.dpr: -------------------------------------------------------------------------------- 1 | program Writer; 2 | 3 | uses 4 | Forms, 5 | FmWriter in 'FmWriter.pas' {WriterForm}, 6 | UPayload in 'UPayload.pas'; 7 | 8 | {$R *.RES} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TWriterForm, WriterForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-07/Writer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-07/Writer.res -------------------------------------------------------------------------------- /article-08/ExeType.dpr: -------------------------------------------------------------------------------- 1 | program ExeType; 2 | 3 | uses 4 | Forms, 5 | MainForm in 'MainForm.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-08/ExeType.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-08/ExeType.res -------------------------------------------------------------------------------- /article-08/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 8 demo code 2 | 3 | The demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md), with the exception of `PJDropFiles.pas`. See the header comments in `PJDropFiles.pas` for details of the license that applies to that file. 4 | -------------------------------------------------------------------------------- /article-08/MainForm.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-08/MainForm.dfm -------------------------------------------------------------------------------- /article-08/PJDropFiles.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-08/PJDropFiles.pas -------------------------------------------------------------------------------- /article-08/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 8 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to detect the types of executable files](https://delphidabbler.com/articles/article-8)". 4 | 5 | The demo was not originally developed under version control. It's last update appears to hav been in 2003. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | This demo exercises the _ExeType_ function described in the article. 10 | 11 | ### Installing the files 12 | 13 | The files included in the demo are as follows: 14 | 15 | * `ExeType.dpr` - the demo program source file. 16 | * `ExeType.res` - the demo program resource file. 17 | * `MainForm.dfm` - the demo program main form. 18 | * `MainForm.pas` - the demo program main form source (includes _ExeType_ function). 19 | * `PJDropFiles.pas` - unit used by main form source file. 20 | * `ReadMe.txt` - this file. 21 | 22 | ### Compiling the projects 23 | 24 | This demo contains a project file `ExeType.dpr`. Load the project into Delphi and compile. The demo was created using Delphi 4. 25 | 26 | `MainForm.pas` uses the `PJDropFiles.pas` component unit to enable it to catch files dragged and dropped from Explorer. The program dynamically creates the component so there should be no need to install `PJDropFiles.pas` into your IDE, providing the unit is kept in the same folder as `MainForm.pas`. 27 | 28 | ### Using the demo program 29 | 30 | Simply start the demo, select some files in Windows Explorer and drag and drop them onto the demo program's window. The window will come to the front and will list the name(s) of the dropped file(s), followed by the file type(s), using names from the _TExeFileKind_ enumeration. 31 | 32 | ## Bug Reports 33 | 34 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 35 | -------------------------------------------------------------------------------- /article-09/CBEdit.dpr: -------------------------------------------------------------------------------- 1 | program CBEdit; 2 | 3 | uses 4 | Forms, 5 | FmEditor in 'FmEditor.pas' {EditorForm}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TEditorForm, EditorForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-09/CBEdit.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-09/CBEdit.res -------------------------------------------------------------------------------- /article-09/FmEditor.dfm: -------------------------------------------------------------------------------- 1 | object EditorForm: TEditorForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'EditorForm' 5 | ClientHeight = 300 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object btnCut: TButton 19 | Left = 8 20 | Top = 8 21 | Width = 75 22 | Height = 25 23 | Caption = 'Cut' 24 | TabOrder = 0 25 | OnClick = btnCutClick 26 | end 27 | object btnCopy: TButton 28 | Left = 87 29 | Top = 8 30 | Width = 75 31 | Height = 25 32 | Caption = 'Copy' 33 | TabOrder = 1 34 | OnClick = btnCopyClick 35 | end 36 | object btnPaste: TButton 37 | Left = 168 38 | Top = 8 39 | Width = 75 40 | Height = 25 41 | Caption = 'Paste' 42 | TabOrder = 2 43 | OnClick = btnPasteClick 44 | end 45 | object RichEdit1: TRichEdit 46 | Left = 8 47 | Top = 39 48 | Width = 619 49 | Height = 253 50 | Font.Charset = ANSI_CHARSET 51 | Font.Color = clWindowText 52 | Font.Height = -11 53 | Font.Name = 'Tahoma' 54 | Font.Style = [] 55 | ParentFont = False 56 | ScrollBars = ssVertical 57 | TabOrder = 3 58 | OnSelectionChange = RichEdit1SelectionChange 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /article-09/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 9 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-09/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 9 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to get notified when the content of the clipboard changes](https://delphidabbler.com/articles/article-9)". 4 | 5 | The demo was originally developed in a Git repository on Bitbucket. It's last update was on 21 Aug 2014. The code was imported, with history to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 26 Nov 2021. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-10/Article10.dpr: -------------------------------------------------------------------------------- 1 | program Article10; 2 | 3 | uses 4 | Forms, 5 | FmMain in 'FmMain.pas' {MainForm}; 6 | 7 | {$R *.res} 8 | {$Resource HTML.res} // for HTML and other resources 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TMainForm, MainForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-10/Article10.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-10/Article10.res -------------------------------------------------------------------------------- /article-10/FmMain.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-10/FmMain.dfm -------------------------------------------------------------------------------- /article-10/FmMain.pas: -------------------------------------------------------------------------------- 1 | unit FmMain; 2 | 3 | interface 4 | 5 | {$BOOLEVAL OFF} 6 | 7 | {$IFDEF CONDITIONALEXPRESSIONS} 8 | {$IF CompilerVersion >= 15.0} // >= Delphi 7 9 | {$WARN UNSAFE_TYPE OFF} 10 | {$IFEND} 11 | {$ENDIF} 12 | 13 | uses 14 | Forms, StdCtrls, OleCtrls, SHDocVw, Controls, ExtCtrls, Classes; 15 | 16 | type 17 | TMainForm = class(TForm) 18 | btnIndex: TButton; 19 | btnLogo: TButton; 20 | pnlBrowser: TPanel; 21 | webBrowser: TWebBrowser; 22 | btnCSS: TButton; 23 | btnRCDATA: TButton; 24 | edURL: TEdit; 25 | Label1: TLabel; 26 | procedure btnIndexClick(Sender: TObject); 27 | procedure btnLogoClick(Sender: TObject); 28 | procedure btnCSSClick(Sender: TObject); 29 | procedure btnRCDATAClick(Sender: TObject); 30 | procedure FormCreate(Sender: TObject); 31 | private 32 | procedure ShowURL(const URL: string); 33 | end; 34 | 35 | var 36 | MainForm: TMainForm; 37 | 38 | implementation 39 | 40 | uses 41 | SysUtils, Windows; 42 | 43 | {$R *.dfm} 44 | 45 | { 46 | Do not use this function to URL encode query strings: see the more flexible 47 | version in the Code Snippets Database at 48 | http://www.delphidabbler.com/codesnip?action=named&routines=URLEncode 49 | } 50 | function URLEncode(const S: string): string; 51 | var 52 | Idx: Integer; // loops thru characters in string 53 | begin 54 | Result := ''; 55 | for Idx := 1 to Length(S) do 56 | begin 57 | {$IFDEF UNICODE} 58 | if CharInSet(S[Idx], ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.']) then 59 | {$ELSE} 60 | if S[Idx] in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.'] then 61 | {$ENDIF} 62 | Result := Result + S[Idx] 63 | else 64 | Result := Result + '%' + IntToHex(Ord(S[Idx]), 2); 65 | end; 66 | end; 67 | 68 | function FormatResNameOrType(ResID: PChar): string; 69 | begin 70 | if HiWord(LongWord(ResID)) = 0 then 71 | // high word = 0 => numeric resource id 72 | // numeric value is stored in low word 73 | Result := Format('#%d', [LoWord(LongWord(ResID))]) 74 | else 75 | // high word <> 0 => string value 76 | // PChar is implicitly converted to string 77 | Result := ResID; 78 | end; 79 | 80 | function MakeResourceURL(const ModuleName: string; const ResName: PChar; 81 | const ResType: PChar = nil): string; overload; 82 | begin 83 | Assert(ModuleName <> ''); 84 | Assert(Assigned(ResName)); 85 | Result := 'res://' + URLEncode(ModuleName); 86 | if Assigned(ResType) then 87 | Result := Result + '/' + URLEncode(FormatResNameOrType(ResType)); 88 | Result := Result + '/' + URLEncode(FormatResNameOrType(ResName)); 89 | end; 90 | 91 | function MakeResourceURL(const Module: HMODULE; const ResName: PChar; 92 | const ResType: PChar = nil): string; overload; 93 | begin 94 | Result := MakeResourceURL(GetModuleName(Module), ResName, ResType); 95 | end; 96 | 97 | procedure TMainForm.btnIndexClick(Sender: TObject); 98 | begin 99 | ShowURL(MakeResourceURL(HInstance, 'INDEX_PAGE')); 100 | end; 101 | 102 | procedure TMainForm.btnLogoClick(Sender: TObject); 103 | const 104 | RT_HTML = MakeIntResource(23); 105 | begin 106 | ShowURL(MakeResourceURL(HInstance, 'LOGO_GIF', RT_HTML)); 107 | end; 108 | 109 | procedure TMainForm.btnCSSClick(Sender: TObject); 110 | begin 111 | ShowURL(MakeResourceURL(HInstance, 'STYLE_CSS')); 112 | end; 113 | 114 | procedure TMainForm.btnRCDATAClick(Sender: TObject); 115 | begin 116 | ShowURL(MakeResourceURL(HInstance, MakeIntResource(42), RT_RCDATA)); 117 | end; 118 | 119 | procedure TMainForm.ShowURL(const URL: string); 120 | begin 121 | edURL.Text := URL; 122 | edURL.SelStart := Length(URL); 123 | webBrowser.Navigate(URL); 124 | end; 125 | 126 | procedure TMainForm.FormCreate(Sender: TObject); 127 | begin 128 | webBrowser.Navigate('about:blank'); 129 | end; 130 | 131 | end. 132 | 133 | -------------------------------------------------------------------------------- /article-10/HTML.rc: -------------------------------------------------------------------------------- 1 | /* standard resource # for HTML */ 2 | #define HTML 23 3 | 4 | /* HTML resource */ 5 | INDEX_PAGE HTML "HTML\index.html" 6 | PAGE_1 HTML "HTML\page1.html" 7 | PAGE_2 HTML "HTML\page2.html" 8 | LOGO_GIF HTML "HTML\logo.gif" 9 | STYLE_CSS HTML "HTML\style.css" 10 | 11 | /* RCDATA resource */ 12 | 42 RCDATA "HTML\rcdata.html" 13 | 14 | -------------------------------------------------------------------------------- /article-10/HTML.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-10/HTML.res -------------------------------------------------------------------------------- /article-10/HTML/index.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | Article 10 - Demo Index 6 | 7 | 8 | 9 |
10 | 11 | 12 | 13 |
14 |

Article #10 Demo

15 |

This demo application demonstrates the use of the Internet Explorer 16 | res:// protocol. It uses the same manifest of files stored in 17 | resources discussed in the "Naming of resource" section of the 18 | DelphiDabbler article 19 | "How to create and use HTML resource files".

21 |

The page was loaded into a TWebBrowser control using the MakeResourceURL 22 | routine discussed in the article. Check out the demo's source code.

23 |

Here are the links to some subsidiary demo pages:

24 |
25 | Page 1
26 | Page 2 27 |
28 | 29 | 30 | -------------------------------------------------------------------------------- /article-10/HTML/logo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-10/HTML/logo.gif -------------------------------------------------------------------------------- /article-10/HTML/page1.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | Article 10 - Demo Page 1 6 | 7 | 8 | 9 |
10 | 11 | 12 | 13 |
14 |

Page One

15 |

This page has been loaded from the HTML resource named PAGE_1 16 | using a relative link on the index page thus:

17 |
18 | <a href="PAGE_1"> 19 |
20 |

Go back to the index page.

21 | 22 | -------------------------------------------------------------------------------- /article-10/HTML/page2.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | Article 10 - Demo Page 2 6 | 7 | 8 | 9 |
10 | 11 | 12 | 13 |
14 |

Page Two

15 |

This page has been loaded from the HTML resource named PAGE_2 16 | using a relative link on the index page thus:

17 |
18 | <a href="PAGE_2"> 19 |
20 |

Go back to the index page.

21 | 22 | -------------------------------------------------------------------------------- /article-10/HTML/rcdata.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | Page shown from RCDATA 6 | 7 | 8 |

RCDATA page

9 |

This page shows a resource loaded from RT_RCDATA rather than RT_HTML.

10 | 11 | -------------------------------------------------------------------------------- /article-10/HTML/style.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: Verdana, Arial, Helvetica, sans-serif; 3 | font-size: 10pt; 4 | } 5 | 6 | h1 { 7 | font-size: 12pt; 8 | font-weight: bold; 9 | text-align: center; 10 | border-top: 1px #C6C6FF solid; 11 | border-bottom: 1px #C6C6FF solid; 12 | margin-left: 100px; 13 | margin-right: 100px; 14 | padding-top: 12px; 15 | padding-bottom: 12px; 16 | color: #003399; 17 | } 18 | 19 | -------------------------------------------------------------------------------- /article-10/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 10 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-10/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 10 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to create and use HTML resource files](https://delphidabbler.com/articles/article-10)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 26 September 2009. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 6 June 2020. 6 | 7 | ## About the Demo 8 | 9 | The demo was developed on Delphi 7 and tested with Delphi 7 and Delphi 2010. The code is likely to compile on any version from 7 up and maybe on earlier compilers, though this has not been tested. 10 | 11 | Load the project file, `Article10.dpr`, into Delphi and compile and run it. If successful you should see a window, titled "Article #10 Demo", that has four buttons across the top, a greyed-out, empty, edit box and an empty web browser control. 12 | 13 | The available buttons are: 14 | 15 | * "Show Index Page": loads and displays the HTML resource named `INDEX_PAGE`. Clicking the "Page 1" and "Page 2" links on this page will cause the `PAGE_1` and `PAGE_2` HTML resources to be loaded and displayed, respectively. Clicking the index page's logo accesses the DelphiDabbler website. The page also contains a link to the article. 16 | * "Show Logo Only": displays the DelphiDabber logo GIF on its own. This resource is named `LOGO_GIF` and is also used by other pages. 17 | * "Show Raw CSS": displays the contents of the resource containing the application's Cascading Style Sheets. This resource is linked to by all HTML pages except the one stored in _RT_RCDATA_ resources. The style sheet resource is named `STYLE_CSS` and is displayed without formatting. 18 | * "Show RCDATA Page": displays another HTML resource. This resource has the _RT_RCDATA_ type instead of the _RT_HTML_ type used by the other resources. It also has a numeric resource name (`42`). 19 | 20 | The edit box below the buttons displays the `res://` URL used by each button to display the required content. You can copy the URL from the edit box to the clipboard and paste it into Internet Explorer's location bar. Pressing Enter will cause IE to display the resource in the browser. All links will still work. 21 | 22 | The source files that are embedded in the application's resources are provided in the HTML sub-folder. `HTML.rc` references all the files in the HTML folder and causes them to be embedded in either _RT_HTML_ or _RT_RCDATA_ resources in the binary resource file `HTML.res` (provided). This resource file is linked into the program in the main project file. The binary file was built using BRCC32. 23 | 24 | ## Bug Reports 25 | 26 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 27 | -------------------------------------------------------------------------------- /article-11/DragDropDemo.cfg: -------------------------------------------------------------------------------- 1 | -$A+ 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LNd:\program files\borland\delphi4\Lib 35 | -------------------------------------------------------------------------------- /article-11/DragDropDemo.dof: -------------------------------------------------------------------------------- 1 | [Compiler] 2 | A=8 3 | B=0 4 | C=1 5 | D=1 6 | E=0 7 | F=0 8 | G=1 9 | H=1 10 | I=1 11 | J=0 12 | K=0 13 | L=1 14 | M=0 15 | N=1 16 | O=1 17 | P=1 18 | Q=0 19 | R=0 20 | S=0 21 | T=0 22 | U=0 23 | V=1 24 | W=0 25 | X=1 26 | Y=1 27 | Z=1 28 | ShowHints=1 29 | ShowWarnings=1 30 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 31 | [Linker] 32 | MapFile=0 33 | OutputObjs=0 34 | ConsoleApp=1 35 | DebugInfo=0 36 | RemoteSymbols=0 37 | MinStackSize=16384 38 | MaxStackSize=1048576 39 | ImageBase=4194304 40 | ExeDescription= 41 | [Directories] 42 | OutputDir= 43 | UnitOutputDir= 44 | PackageDLLOutputDir= 45 | PackageDCPOutputDir= 46 | SearchPath= 47 | Packages= 48 | Conditionals= 49 | DebugSourceDirs= 50 | UsePackages=0 51 | [Parameters] 52 | RunParams= 53 | HostApplication= 54 | [Version Info] 55 | IncludeVerInfo=0 56 | AutoIncBuild=0 57 | MajorVer=1 58 | MinorVer=0 59 | Release=0 60 | Build=0 61 | Debug=0 62 | PreRelease=0 63 | Special=0 64 | Private=0 65 | DLL=0 66 | Locale=2057 67 | CodePage=1252 68 | [Version Info Keys] 69 | CompanyName= 70 | FileDescription= 71 | FileVersion=1.0.0.0 72 | InternalName= 73 | LegalCopyright= 74 | LegalTrademarks= 75 | OriginalFilename= 76 | ProductName= 77 | ProductVersion=1.0.0.0 78 | Comments= 79 | [HistoryLists\hlUnitAliases] 80 | Count=1 81 | Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 82 | -------------------------------------------------------------------------------- /article-11/DragDropDemo.dpr: -------------------------------------------------------------------------------- 1 | program DragDropDemo; 2 | 3 | uses 4 | Forms, 5 | FmMain in 'FmMain.pas' {Form1}, 6 | UFileCatcher in 'UFileCatcher.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-11/DragDropDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-11/DragDropDemo.res -------------------------------------------------------------------------------- /article-11/FmMain.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-11/FmMain.dfm -------------------------------------------------------------------------------- /article-11/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 11 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-11/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 11 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to catch files dragged and dropped on an application from Explorer](https://delphidabbler.com/articles/article-11)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 13 April 2004. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 27 May 2020. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-11/UFileCatcher.pas: -------------------------------------------------------------------------------- 1 | unit UFileCatcher; 2 | 3 | interface 4 | 5 | uses 6 | Windows, ShellAPI; 7 | 8 | type 9 | TFileCatcher = class(TObject) 10 | private 11 | fDropHandle: HDROP; 12 | function GetFile(Idx: Integer): string; 13 | function GetFileCount: Integer; 14 | function GetPoint: TPoint; 15 | public 16 | constructor Create(DropHandle: HDROP); 17 | destructor Destroy; override; 18 | property FileCount: Integer read GetFileCount; 19 | property Files[Idx: Integer]: string read GetFile; 20 | property DropPoint: TPoint read GetPoint; 21 | end; 22 | 23 | implementation 24 | 25 | { TFileCatcher } 26 | 27 | constructor TFileCatcher.Create(DropHandle: HDROP); 28 | begin 29 | inherited Create; 30 | fDropHandle := DropHandle; 31 | end; 32 | 33 | destructor TFileCatcher.Destroy; 34 | begin 35 | DragFinish(fDropHandle); 36 | inherited; 37 | end; 38 | 39 | function TFileCatcher.GetFile(Idx: Integer): string; 40 | var 41 | FileNameLength: Integer; 42 | begin 43 | FileNameLength := DragQueryFile(fDropHandle, Idx, nil, 0); 44 | SetLength(Result, FileNameLength); 45 | DragQueryFile(fDropHandle, Idx, PChar(Result), FileNameLength + 1); 46 | end; 47 | 48 | function TFileCatcher.GetFileCount: Integer; 49 | begin 50 | Result := DragQueryFile(fDropHandle, $FFFFFFFF, nil, 0); 51 | end; 52 | 53 | function TFileCatcher.GetPoint: TPoint; 54 | begin 55 | DragQueryPoint(fDropHandle, Result); 56 | end; 57 | 58 | end. 59 | -------------------------------------------------------------------------------- /article-12/FmSendToDemo.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-12/FmSendToDemo.dfm -------------------------------------------------------------------------------- /article-12/FmSendToDemo.pas: -------------------------------------------------------------------------------- 1 | unit FmSendToDemo; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls; 8 | 9 | type 10 | TDemoForm = class(TForm) 11 | btnMakeSCut: TButton; 12 | edFileList: TMemo; 13 | btnDelSCut: TButton; 14 | procedure FormCreate(Sender: TObject); 15 | procedure btnMakeSCutClick(Sender: TObject); 16 | procedure btnDelSCutClick(Sender: TObject); 17 | end; 18 | 19 | var 20 | DemoForm: TDemoForm; 21 | 22 | implementation 23 | 24 | uses 25 | ShlObj, ActiveX; 26 | 27 | {$R *.dfm} 28 | 29 | function GetSendToFolder: string; 30 | var 31 | pidl: PItemIDList; 32 | PPath: array[0..MAX_PATH] of AnsiChar; 33 | begin 34 | Result := ''; 35 | if SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pidl) = NOERROR then 36 | begin 37 | try 38 | if SHGetPathFromIDList(pidl, PPath) then 39 | begin 40 | Result := PPath; 41 | end; 42 | finally 43 | ActiveX.CoTaskMemFree(pidl); 44 | end; 45 | end 46 | else 47 | if (Assigned(pidl)) then showmessage('assigned') else showmessage('not assigned'); 48 | end; 49 | 50 | // 51 | // From code snip database: http://www.delphidabbler.com/codesnip.php 52 | // 53 | function CreateShellLink(const LinkFileName, AssocFileName, Desc, WorkDir, 54 | Args, IconFileName: string; const IconIdx: Integer): Boolean; 55 | var 56 | SL: ShlObj.IShellLink; // shell link object 57 | PF: ActiveX.IPersistFile; // persistant file interface to shell link object 58 | begin 59 | // Assume failure 60 | Result := False; 61 | // Ensure COM is initialised 62 | ActiveX.CoInitialize(nil); 63 | try 64 | // Create shell link object 65 | if ActiveX.Succeeded( 66 | ActiveX.CoCreateInstance( 67 | ShlObj.CLSID_ShellLink, 68 | nil, 69 | ActiveX.CLSCTX_INPROC_SERVER, 70 | ShlObj.IShellLink, SL 71 | ) 72 | ) then 73 | begin 74 | // Store required properties of shell link 75 | SL.SetPath(PChar(AssocFileName)); 76 | SL.SetDescription(PChar(Desc)); 77 | SL.SetWorkingDirectory(PChar(WorkDir)); 78 | SL.SetArguments(PChar(Args)); 79 | if (IconFileName <> '') and (IconIdx >= 0) then 80 | SL.SetIconLocation(PChar(IconFileName), IconIdx); 81 | // Create persistant file interface to shell link to save link file 82 | PF := SL as ActiveX.IPersistFile; 83 | Result := ActiveX.Succeeded( 84 | PF.Save(PWideChar(WideString(LinkFileName)), True) 85 | ); 86 | end; 87 | finally 88 | // Finalize COM 89 | ActiveX.CoUninitialize; 90 | end; 91 | end; 92 | 93 | 94 | { TDemoForm } 95 | 96 | const 97 | cShortcutName = 'Send To Demo.lnk'; 98 | 99 | procedure TDemoForm.btnDelSCutClick(Sender: TObject); 100 | begin 101 | DeleteFile(GetSendToFolder + '\' + cShortcutName); 102 | end; 103 | 104 | procedure TDemoForm.btnMakeSCutClick(Sender: TObject); 105 | var 106 | SendToFolder: string; 107 | LinkFileName: string; 108 | begin 109 | LinkFileName := ChangeFileExt(ExtractFileName(ParamStr(0)), '.lnk'); 110 | SendToFolder := GetSendToFolder; 111 | CreateShellLink( 112 | SendToFolder + '\' + cShortcutName, 113 | ParamStr(0), 114 | 'Test SendTo Application', 115 | ExtractFileDir(ParamStr(0)), 116 | '', 117 | '', 118 | -1 119 | ); 120 | 121 | end; 122 | 123 | procedure TDemoForm.FormCreate(Sender: TObject); 124 | var 125 | I: Integer; 126 | begin 127 | for I := 1 to ParamCount do 128 | edFileList.Lines.Add(ParamStr(I)); 129 | end; 130 | 131 | end. 132 | -------------------------------------------------------------------------------- /article-12/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 12 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-12/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 12 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to add a program to the Explorer Send To menu](https://delphidabbler.com/articles/article-12)". 4 | 5 | The demo was not originally developed under version control. It's last update was probably in 2004. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The demo project comprises a single Delphi project: `SendToDemo.dpr`. Compile the project and run the resulting application. Then: 10 | 11 | 1. Click the "Create Send-To Shortcut" shortcut button to create a short cut to the program in the current user's Send To folder. 12 | 13 | 2. Exit the application. 14 | 15 | 3. Select one or more files in Explorer then select the Send To "mouse menu". Select the new "Send To Demo" option. The demo program will start and the names of the selected file(s) will be displayed in the program. 16 | 17 | When finished experimenting click the "Delete Send-To Shortcut" button to tidy up. 18 | 19 | ## Bug Reports 20 | 21 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 22 | -------------------------------------------------------------------------------- /article-12/SendToDemo.dpr: -------------------------------------------------------------------------------- 1 | program SendToDemo; 2 | 3 | uses 4 | Forms, 5 | FmSendToDemo in 'FmSendToDemo.pas' {DemoForm}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TDemoForm, DemoForm); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-12/SendToDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-12/SendToDemo.res -------------------------------------------------------------------------------- /article-13/Article13.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = TemplateDemo.exe SingleInstDemo.exe 13 | #------------------------------------------------------------------------------ 14 | default: $(PROJECTS) 15 | #------------------------------------------------------------------------------ 16 | 17 | TemplateDemo.exe: TemplateDemo\TemplateDemo.dpr 18 | $(DCC) 19 | 20 | SingleInstDemo.exe: SingleInstDemo\SingleInstDemo.dpr 21 | $(DCC) 22 | 23 | 24 | -------------------------------------------------------------------------------- /article-13/Clean.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal 3 | 4 | echo Tidying 5 | echo ~~~~~~~ 6 | echo. 7 | 8 | set RootDir=. 9 | 10 | echo Deleting temporary files 11 | del /S %RootDir%\*.~* 12 | del /S %RootDir%\*.tmp 13 | del /S %RootDir%\*.ddp 14 | del /S %RootDir%\*.dcu 15 | del /S %RootDir%\*.exe 16 | del /S %RootDir%\*.dsk 17 | del /S %RootDir%\*.bak 18 | del /S %RootDir%\*.local 19 | del /S %RootDir%\*.identcache 20 | del /S /AH %RootDir%\*.GID 21 | echo. 22 | 23 | echo Deleting temporary directories 24 | for /F "usebackq" %%i in (`dir /S /B /A:D %RootDir%\__history*`) do rmdir /S /Q %%i 25 | echo. 26 | 27 | echo Done. 28 | 29 | endlocal 30 | -------------------------------------------------------------------------------- /article-13/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 13 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-13/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 13 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to run a single instance of an application](https://delphidabbler.com/articles/article-13)". 4 | 5 | The demo was not originally developed under version control. It's last update was probably on 9 May 2011. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The code was originally written in Delphi 4 and was revised using Delphi 7 on 7th August 2005. The code was updated to work correctly when compiled with Unicode versions of Delphi on 9th May 2011 and tested with Delphi 2010. The code should work with versions back to Delphi 4 but this hasn't been tested. 10 | 11 | There are two different projects included in the demo – `SingleInstDemo.dpr` and `TemplateDemo.dpr`. Each project is stored in its own sub folder. Both are referenced by the project group file `Article13.bpg` stored in the root folder. The projects are described below. 12 | 13 | ### `TemplateDemo` Project 14 | 15 | `TemplateDemo` is an exact copy of the code presented in the section of the article named "An Initial Approach". It compiles into a do-nothing application. Only one instance of the application can be run at a time. Any minimized window will be restored when an attempt is made to start a second instance. 16 | 17 | The purpose of this "do nothing" demo is to provide some code that can be copied into your own projects. Some of the "bolier plate" code can be simply cut and pasted, while other code will need be to be modified to suit. This code is suitable for a one off use, but if you require a reusable or object oriented solution you will need to use the `SingleInstDemo` demo below. 18 | 19 | ### `SingleInstDemo` Project 20 | 21 | This project brings together the code presented in the section of the article named "An Object Oriented Solution". It compiles into an application that displays the parameters passed to it in the form's list box. Only one instance of the application can be run at a time. Any minimized window will be restored when an attempt is made to start a second instance. 22 | 23 | The program uses a subclassed version of _TSingleInst_ named _TMySingleInst_. The classes are implemented in `USingleInst.pas` and `UMySingleInst.pas` respectively. _TMySingleInst_ simply provides a window class name for the project's main form along with a watermark to use when passing data between applications. The main form is implemented in `FmDemo.pas` and `FmDemo.dfm`. 24 | 25 | The main item of interest here is `UMySingleInst.pas` which is designed to be reusable in various projects – the idea being to include the unit in your project and to override _TSingleInst_ to customise it as required. `UMySingleInst.pas` simply provides an example of how to do this. As noted in the article, you still need to make a few "boiler plate" changes to the project and main form source files. `SingleInstDemo.dpr` and `FmDemo.pas` show how to do this. 26 | 27 | ## Bug Reports 28 | 29 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 30 | -------------------------------------------------------------------------------- /article-13/SingleInstDemo/FmDemo.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-13/SingleInstDemo/FmDemo.dfm -------------------------------------------------------------------------------- /article-13/SingleInstDemo/FmDemo.pas: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | 3 | unit FmDemo; 4 | 5 | interface 6 | 7 | uses 8 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 9 | StdCtrls; 10 | 11 | type 12 | TForm1 = class(TForm) 13 | ListBox1: TListBox; 14 | procedure FormCreate(Sender: TObject); 15 | protected 16 | procedure WndProc(var Msg: TMessage); override; 17 | procedure HandleParam(const Param: string); 18 | procedure CreateParams(var Params: TCreateParams); override; 19 | end; 20 | 21 | var 22 | Form1: TForm1; 23 | 24 | implementation 25 | 26 | uses 27 | USingleInst; 28 | 29 | {$R *.DFM} 30 | 31 | { TForm1 } 32 | 33 | procedure TForm1.CreateParams(var Params: TCreateParams); 34 | begin 35 | inherited; 36 | SingleInst.CreateParams(Params); 37 | end; 38 | 39 | procedure TForm1.FormCreate(Sender: TObject); 40 | var 41 | I: Integer; 42 | begin 43 | SingleInst.OnProcessParam := HandleParam; 44 | for I := 1 to ParamCount do 45 | HandleParam(ParamStr(I)); 46 | end; 47 | 48 | procedure TForm1.HandleParam(const Param: string); 49 | begin 50 | ListBox1.Items.Add(Param); 51 | end; 52 | 53 | procedure TForm1.WndProc(var Msg: TMessage); 54 | begin 55 | if not SingleInst.HandleMessages(Self.Handle, Msg) then 56 | inherited; 57 | end; 58 | 59 | end. 60 | -------------------------------------------------------------------------------- /article-13/SingleInstDemo/SingleInstDemo.dpr: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$APPTYPE GUI} 3 | 4 | program SingleInstDemo; 5 | 6 | uses 7 | Forms, 8 | FmDemo in 'FmDemo.pas' {Form1}, 9 | USingleInst in 'USingleInst.pas', 10 | UMySingleInst in 'UMySingleInst.pas'; 11 | 12 | {$R *.RES} 13 | 14 | begin 15 | if SingleInst.CanStartApp then 16 | begin 17 | Application.Initialize; 18 | Application.CreateForm(TForm1, Form1); 19 | Application.Run; 20 | end; 21 | end. 22 | -------------------------------------------------------------------------------- /article-13/SingleInstDemo/SingleInstDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-13/SingleInstDemo/SingleInstDemo.res -------------------------------------------------------------------------------- /article-13/SingleInstDemo/UMySingleInst.pas: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | 3 | unit UMySingleInst; 4 | 5 | interface 6 | 7 | uses 8 | Windows, 9 | USingleInst; 10 | 11 | type 12 | TMySingleInst = class(TSingleInst) 13 | protected 14 | function WdwClassName: string; override; 15 | function WaterMark: DWORD; override; 16 | end; 17 | 18 | implementation 19 | 20 | { TMySingleInst } 21 | 22 | function TMySingleInst.WaterMark: DWORD; 23 | begin 24 | Result := $DE1F1DAB; 25 | end; 26 | 27 | function TMySingleInst.WdwClassName: string; 28 | begin 29 | Result := 'DelphiDabbler.SingleInstDemo.1'; 30 | end; 31 | 32 | initialization 33 | 34 | RegisterSingleInstClass(TMySingleInst); 35 | 36 | end. 37 | -------------------------------------------------------------------------------- /article-13/TemplateDemo/FmTemplate.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-13/TemplateDemo/FmTemplate.dfm -------------------------------------------------------------------------------- /article-13/TemplateDemo/FmTemplate.pas: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARN UNSAFE_TYPE OFF} 3 | 4 | unit FmTemplate; 5 | 6 | interface 7 | 8 | uses 9 | Windows, Messages, SysUtils, Controls, Forms, 10 | UStartup; 11 | 12 | type 13 | TForm1 = class(TForm) 14 | procedure FormCreate(Sender: TObject); 15 | private 16 | procedure ProcessParam(const Param: string); 17 | procedure UMEnsureRestored(var Msg: TMessage); 18 | message UM_ENSURERESTORED; 19 | procedure WMCopyData(var Msg: TWMCopyData); 20 | message WM_COPYDATA; 21 | protected 22 | procedure CreateParams(var Params: TCreateParams); 23 | override; 24 | public 25 | end; 26 | 27 | var 28 | Form1: TForm1; 29 | 30 | implementation 31 | 32 | {$R *.dfm} 33 | 34 | { TForm1 } 35 | 36 | procedure TForm1.CreateParams(var Params: TCreateParams); 37 | begin 38 | inherited; 39 | StrCopy(Params.WinClassName, cWindowClassName); 40 | end; 41 | 42 | procedure TForm1.FormCreate(Sender: TObject); 43 | var 44 | I: Integer; 45 | begin 46 | for I := 1 to ParamCount do 47 | ProcessParam(ParamStr(I)); 48 | end; 49 | 50 | procedure TForm1.ProcessParam(const Param: string); 51 | begin 52 | { TODO : Code to process a parameter } 53 | end; 54 | 55 | procedure TForm1.UMEnsureRestored(var Msg: TMessage); 56 | begin 57 | if IsIconic(Application.Handle) then 58 | Application.Restore; 59 | if not Visible then 60 | Visible := True; 61 | Application.BringToFront; 62 | SetForegroundWindow(Self.Handle); 63 | end; 64 | 65 | procedure TForm1.WMCopyData(var Msg: TWMCopyData); 66 | var 67 | PData: PChar; 68 | Param: string; 69 | begin 70 | if Msg.CopyDataStruct.dwData <> cCopyDataWaterMark then 71 | raise Exception.Create( 72 | 'Invalid data structure passed in WM_COPYDATA' 73 | ); 74 | PData := Msg.CopyDataStruct.lpData; 75 | while PData^ <> #0 do 76 | begin 77 | Param := PData; 78 | ProcessParam(Param); 79 | Inc(PData, Length(Param) + 1); 80 | end; 81 | Msg.Result := 1; 82 | end; 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /article-13/TemplateDemo/TemplateDemo.dpr: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$APPTYPE GUI} 3 | 4 | 5 | program TemplateDemo; 6 | 7 | uses 8 | Forms, 9 | Windows, 10 | FmTemplate in 'FmTemplate.pas' {Form1}, 11 | UStartup in 'UStartup.pas'; 12 | 13 | {$R *.res} 14 | 15 | function CanStart: Boolean; 16 | var 17 | Wdw: HWND; 18 | begin 19 | Wdw := FindDuplicateMainWdw; 20 | if Wdw = 0 then 21 | Result := True 22 | else 23 | Result := not SwitchToPrevInst(Wdw); 24 | end; 25 | 26 | begin 27 | if CanStart then 28 | begin 29 | Application.Initialize; 30 | Application.CreateForm(TForm1, Form1); 31 | Application.Run; 32 | end; 33 | end. 34 | -------------------------------------------------------------------------------- /article-13/TemplateDemo/TemplateDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-13/TemplateDemo/TemplateDemo.res -------------------------------------------------------------------------------- /article-13/TemplateDemo/UStartup.pas: -------------------------------------------------------------------------------- 1 | {$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARN UNSAFE_TYPE OFF} 3 | {$WARN UNSAFE_CODE OFF} 4 | 5 | unit UStartup; 6 | 7 | interface 8 | 9 | uses 10 | Windows, Messages; 11 | 12 | const 13 | // Name of main window class 14 | cWindowClassName = 'DelphiDabbler.SingleApp.Demo'; 15 | // Any 32 bit number here to perform check on copied data 16 | cCopyDataWaterMark = $DE1F1DAB; 17 | // User window message handled by main form ensures that 18 | // app not minimized or hidden and is in foreground 19 | UM_ENSURERESTORED = WM_USER + 1; 20 | 21 | function FindDuplicateMainWdw: HWND; 22 | function SwitchToPrevInst(Wdw: HWND): Boolean; 23 | 24 | implementation 25 | 26 | uses 27 | SysUtils; 28 | 29 | function SendParamsToPrevInst(Wdw: HWND): Boolean; 30 | var 31 | CopyData: TCopyDataStruct; 32 | I: Integer; 33 | CharCount: Integer; 34 | Data: PChar; 35 | PData: PChar; 36 | begin 37 | CharCount := 0; 38 | for I := 1 to ParamCount do 39 | Inc(CharCount, Length(ParamStr(I)) + 1); 40 | Inc(CharCount); 41 | Data := StrAlloc(CharCount); 42 | try 43 | PData := Data; 44 | for I := 1 to ParamCount do 45 | begin 46 | StrPCopy(PData, ParamStr(I)); 47 | Inc(PData, Length(ParamStr(I)) + 1); 48 | end; 49 | PData^ := #0; 50 | CopyData.lpData := Data; 51 | CopyData.cbData := CharCount * SizeOf(Char); 52 | CopyData.dwData := cCopyDataWaterMark; 53 | Result := SendMessage( 54 | Wdw, WM_COPYDATA, 0, LPARAM(@CopyData) 55 | ) = 1; 56 | finally 57 | StrDispose(Data); 58 | end; 59 | end; 60 | 61 | function FindDuplicateMainWdw: HWND; 62 | begin 63 | Result := FindWindow(cWindowClassName, nil); 64 | end; 65 | 66 | function SwitchToPrevInst(Wdw: HWND): Boolean; 67 | begin 68 | Assert(Wdw <> 0); 69 | if ParamCount > 0 then 70 | Result := SendParamsToPrevInst(Wdw) 71 | else 72 | Result := True; 73 | if Result then 74 | SendMessage(Wdw, UM_ENSURERESTORED, 0, 0); 75 | end; 76 | 77 | end. 78 | -------------------------------------------------------------------------------- /article-14/Clean.bat: -------------------------------------------------------------------------------- 1 | @rem Script used to delete temporary files and directories. 2 | 3 | @echo off 4 | setlocal 5 | 6 | echo Tidying 7 | echo ~~~~~~~ 8 | echo. 9 | 10 | set RootDir=. 11 | 12 | echo Deleting temporary files 13 | del /S %RootDir%\*.~* 14 | del /S %RootDir%\*.tmp 15 | del /S %RootDir%\*.ddp 16 | del /S %RootDir%\*.dcu 17 | del /S %RootDir%\*.exe 18 | del /S %RootDir%\*.dsk 19 | del /S %RootDir%\*.bak 20 | del /S %RootDir%\*.local 21 | del /S %RootDir%\*.identcache 22 | del /S /AH %RootDir%\*.GID 23 | echo. 24 | 25 | echo Deleting temporary directories 26 | for /F "usebackq" %%i in (`dir /S /B /A:D %RootDir%\__history*`) do rmdir /S /Q %%i 27 | echo. 28 | 29 | echo Done. 30 | 31 | endlocal 32 | -------------------------------------------------------------------------------- /article-14/FmMain.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/FmMain.dfm -------------------------------------------------------------------------------- /article-14/FmSampleCodeEncodingDlg.dfm: -------------------------------------------------------------------------------- 1 | object SampleCodeEncodingDlg: TSampleCodeEncodingDlg 2 | Left = 656 3 | Top = 380 4 | BorderStyle = bsDialog 5 | Caption = 'Choose encoding' 6 | ClientHeight = 154 7 | ClientWidth = 203 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poOwnerFormCenter 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object rgFileType: TRadioGroup 19 | Left = 8 20 | Top = 8 21 | Width = 185 22 | Height = 105 23 | Caption = 'Choose encoding of sample HTML' 24 | ItemIndex = 0 25 | Items.Strings = ( 26 | 'ANSI' 27 | 'UTF-8' 28 | 'Unicode (UCS-2)') 29 | TabOrder = 0 30 | end 31 | object btnOK: TButton 32 | Left = 23 33 | Top = 119 34 | Width = 75 35 | Height = 25 36 | Caption = 'OK' 37 | Default = True 38 | ModalResult = 1 39 | TabOrder = 1 40 | end 41 | object btnCancel: TButton 42 | Left = 104 43 | Top = 119 44 | Width = 75 45 | Height = 25 46 | Cancel = True 47 | Caption = 'Cancel' 48 | ModalResult = 2 49 | TabOrder = 2 50 | end 51 | end 52 | -------------------------------------------------------------------------------- /article-14/FmSampleCodeEncodingDlg.pas: -------------------------------------------------------------------------------- 1 | unit FmSampleCodeEncodingDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls; 8 | 9 | type 10 | TSampleCodeEncodingDlg = class(TForm) 11 | rgFileType: TRadioGroup; 12 | btnOK: TButton; 13 | btnCancel: TButton; 14 | private 15 | {$IFDEF UNICODE} 16 | function GetEncoding: TEncoding; 17 | {$ENDIF} 18 | function GetResourceName: string; 19 | public 20 | {$IFDEF UNICODE} 21 | property Encoding: TEncoding read GetEncoding; 22 | {$ENDIF} 23 | property ResourceName: string read GetResourceName; 24 | end; 25 | 26 | var 27 | SampleCodeEncodingDlg: TSampleCodeEncodingDlg; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | { TSampleCodeEncodingDlg } 34 | 35 | {$IFDEF UNICODE} 36 | function TSampleCodeEncodingDlg.GetEncoding: TEncoding; 37 | begin 38 | Result := nil; 39 | case rgFileType.ItemIndex of 40 | 0: Result := TEncoding.Default; // ANSI 41 | 1: Result := TEncoding.UTF8; 42 | 2: Result := TEncoding.Unicode; // little endian only 43 | end; 44 | Assert(Assigned(Result)); 45 | end; 46 | {$ENDIF} 47 | 48 | function TSampleCodeEncodingDlg.GetResourceName: string; 49 | begin 50 | Result := ''; 51 | case rgFileType.ItemIndex of 52 | 0: Result := 'SAMPLE_HTML_ANSI'; 53 | 1: Result := 'SAMPLE_HTML_UTF8'; 54 | 2: Result := 'SAMPLE_HTML_UCS2LE'; 55 | end; 56 | Assert(Result <> ''); 57 | end; 58 | 59 | end. 60 | 61 | -------------------------------------------------------------------------------- /article-14/FmSaveEncodingDlg.dfm: -------------------------------------------------------------------------------- 1 | object SaveEncodingDlg: TSaveEncodingDlg 2 | Left = 656 3 | Top = 380 4 | BorderStyle = bsDialog 5 | Caption = 'Choose Save Encoding' 6 | ClientHeight = 219 7 | ClientWidth = 203 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poOwnerFormCenter 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object lblDesc: TLabel 20 | Left = 8 21 | Top = 8 22 | Width = 162 23 | Height = 13 24 | Caption = 'Choose encoding in which to save' 25 | end 26 | object rgEncoding: TRadioGroup 27 | Left = 8 28 | Top = 27 29 | Width = 185 30 | Height = 153 31 | Caption = 'Encodings' 32 | ItemIndex = 0 33 | Items.Strings = ( 34 | 'Current Browser Encoding' 35 | 'ANSI' 36 | 'UTF-8' 37 | 'Unicode (UCS-2 Little Endian)' 38 | 'Unicode (UCS-2 Big Endian)') 39 | TabOrder = 0 40 | end 41 | object btnOK: TButton 42 | Left = 23 43 | Top = 186 44 | Width = 75 45 | Height = 25 46 | Caption = 'OK' 47 | Default = True 48 | ModalResult = 1 49 | TabOrder = 1 50 | end 51 | object btnCancel: TButton 52 | Left = 104 53 | Top = 186 54 | Width = 75 55 | Height = 25 56 | Cancel = True 57 | Caption = 'Cancel' 58 | ModalResult = 2 59 | TabOrder = 2 60 | end 61 | end 62 | -------------------------------------------------------------------------------- /article-14/FmSaveEncodingDlg.pas: -------------------------------------------------------------------------------- 1 | unit FmSaveEncodingDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls; 8 | 9 | type 10 | TSaveEncodingDlg = class(TForm) 11 | rgEncoding: TRadioGroup; 12 | btnOK: TButton; 13 | btnCancel: TButton; 14 | lblDesc: TLabel; 15 | procedure FormShow(Sender: TObject); 16 | private 17 | {$IFDEF UNICODE} 18 | function GetEncoding: TEncoding; 19 | {$ENDIF} 20 | public 21 | {$IFDEF UNICODE} 22 | property Encoding: TEncoding read GetEncoding; 23 | {$ENDIF} 24 | end; 25 | 26 | var 27 | SaveEncodingDlg: TSaveEncodingDlg; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | { TSaveEncodingDlg } 34 | 35 | procedure TSaveEncodingDlg.FormShow(Sender: TObject); 36 | begin 37 | // select default browser encoding option each time shown 38 | rgEncoding.ItemIndex := 0; 39 | end; 40 | 41 | {$IFDEF UNICODE} 42 | function TSaveEncodingDlg.GetEncoding: TEncoding; 43 | begin 44 | case rgEncoding.ItemIndex of 45 | 1: Result := TEncoding.Default; 46 | 2: Result := TEncoding.UTF8; 47 | 3: Result := TEncoding.Unicode; 48 | 4: Result := TEncoding.BigEndianUnicode; 49 | else Result := nil; // includes case 0 - default browser encoding 50 | end; 51 | end; 52 | {$ENDIF} 53 | 54 | end. 55 | 56 | -------------------------------------------------------------------------------- /article-14/HTML.rc: -------------------------------------------------------------------------------- 1 | #define HTML 23 2 | 3 | /* 4 | Loaded from resources via res:// protocol: contains program's help document. 5 | */ 6 | HELP_HTML HTML "Resources\Help.html" 7 | 8 | /* 9 | Sample code loaded to show how to load HTML from resources. 10 | */ 11 | HTMLRES_HTML HTML "Resources\HTMLRes.html" 12 | 13 | /* 14 | Loaded from resources in stream as sample HTML code for display in a memo 15 | control in demo 16 | */ 17 | SAMPLE_HTML_ANSI RCDATA "Resources\Sample-ANSI.html" 18 | SAMPLE_HTML_UTF8 RCDATA "Resources\Sample-UTF8.html" 19 | SAMPLE_HTML_UCS2LE RCDATA "Resources\Sample-UCS2LE.html" 20 | -------------------------------------------------------------------------------- /article-14/HTML.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/HTML.res -------------------------------------------------------------------------------- /article-14/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 14 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md), with the exception of `UWebBrowserWrapper.pas`. See the header comments in `UWebBrowserWrapper.pas` for details of the license that applies to that file. 4 | -------------------------------------------------------------------------------- /article-14/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 14 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to load and save documents in TWebBrowser in a Delphi-like way](https://delphidabbler.com/articles/article-14)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 6 February 2010. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | Open the `WebBrowserTests` project in Delphi and compile the source code. Supports Delphi 7 and above. Not tested with earlier versions. 10 | 11 | Additional features are included in the demo when compiled with Unicode support (Delphi 2009 and later). 12 | 13 | Run the compiled program and read the help information displayed in the program's right hand "help" pane. 14 | 15 | ## Bug Reports 16 | 17 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 18 | -------------------------------------------------------------------------------- /article-14/Resources/HTMLRes.html: -------------------------------------------------------------------------------- 1 | 2 | 6 | 7 | 8 | 9 | HTML res:// File 10 | 11 | 12 | 13 |

14 | Example HTML resource file 15 |

16 |

17 | This page was loaded from HTML resources using the res:// 18 | protocol. The file was saved using ANSI encoding. 19 |

20 | 21 | 22 | -------------------------------------------------------------------------------- /article-14/Resources/Sample-ANSI.html: -------------------------------------------------------------------------------- 1 | 2 | 5 | 6 | 7 | 8 | Sample ANSI HTML File 9 | 10 | 11 | 12 |

13 | Sample HTML 14 |

15 |

16 | This sample page is stored with ANSI encoding. 17 |

18 |

19 | Its purpose is to be loaded into the demo program's HTML Code window and 20 | either edited or loaded using the Load from String or Load from 21 | Stream buttons. 22 |

23 | 24 | 25 | -------------------------------------------------------------------------------- /article-14/Resources/Sample-UCS2LE.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/Resources/Sample-UCS2LE.html -------------------------------------------------------------------------------- /article-14/Resources/Sample-UTF8.html: -------------------------------------------------------------------------------- 1 |  2 | 5 | 6 | 7 | 8 | Sample UTF-8 HTML File 9 | 10 | 11 | 12 |

13 | Sample HTML 14 |

15 |

16 | This sample page is stored with UTF-8 encoding. 17 |

18 |

19 | Its purpose is to be loaded into the demo program's HTML Code window and 20 | either edited or loaded using the Load from String or Load from 21 | Stream buttons. 22 |

23 |

24 | WARNING: Using the Save to String and Save to 25 | Stream with this code loaded into the browser control may cause 26 | unexpected results in demos compiled without Unicode support. Non-Unicode 27 | versions of UWebBrowserWrapper do not fully support non-ANSI 28 | encodings. 29 |

30 | 31 | 32 | -------------------------------------------------------------------------------- /article-14/Test-ANSI.html: -------------------------------------------------------------------------------- 1 | 2 | 5 | 6 | 7 | 8 | ANSI Encoded Test File 9 | 10 | 11 | 12 |

13 | Test File 14 |

15 |

16 | This HTML was loaded from Test-ANSI.html. The file was saved 17 | with ANSI encoding. 18 |

19 | 20 | -------------------------------------------------------------------------------- /article-14/Test-USC2BE.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/Test-USC2BE.html -------------------------------------------------------------------------------- /article-14/Test-USC2LE.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/Test-USC2LE.html -------------------------------------------------------------------------------- /article-14/Test-UTF8.html: -------------------------------------------------------------------------------- 1 |  2 | 6 | 7 | 8 | 9 | UTF-8 Encoded Test File 10 | 11 | 12 | 13 |

14 | Test File 15 |

16 |

17 | This HTML was loaded from Test-UTF8.html. The file was saved 18 | with UTF-8 encoding. 19 |

20 |

21 | WARNING: Using the Save to String and Save to 22 | Stream with this file loaded into the browser control may cause 23 | unexpected results in demos compiled without Unicode support. Non-Unicode 24 | versions of UWebBrowserWrapper do not fully support non-ANSI 25 | encodings. 26 |

27 | 28 | -------------------------------------------------------------------------------- /article-14/WebBrowserTests.dpr: -------------------------------------------------------------------------------- 1 | program WebBrowserTests; 2 | 3 | uses 4 | Forms, 5 | FmMain in 'FmMain.pas' {MainForm}, 6 | UWebBrowserWrapper in 'UWebBrowserWrapper.pas', 7 | FmSampleCodeEncodingDlg in 'FmSampleCodeEncodingDlg.pas' {SampleCodeEncodingDlg}, 8 | FmSaveEncodingDlg in 'FmSaveEncodingDlg.pas' {SaveEncodingDlg}; 9 | 10 | {$R *.res} 11 | {$R HTML.res} // for html code stored in resources 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TMainForm, MainForm); 16 | Application.CreateForm(TSampleCodeEncodingDlg, SampleCodeEncodingDlg); 17 | Application.CreateForm(TSaveEncodingDlg, SaveEncodingDlg); 18 | Application.Run; 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /article-14/WebBrowserTests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-14/WebBrowserTests.res -------------------------------------------------------------------------------- /article-16/CustomLVDemo.dpr: -------------------------------------------------------------------------------- 1 | program CustomLVDemo; 2 | 3 | uses 4 | Forms, 5 | FmLVCustDrawDemo in 'FmLVCustDrawDemo.pas' {FmCustomLVDemo}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TFmCustomLVDemo, FmCustomLVDemo); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-16/CustomLVDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-16/CustomLVDemo.res -------------------------------------------------------------------------------- /article-16/DelphiDabbler.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-16/DelphiDabbler.ico -------------------------------------------------------------------------------- /article-16/FmLVCustDrawDemo.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-16/FmLVCustDrawDemo.dfm -------------------------------------------------------------------------------- /article-16/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 16 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-16/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 16 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to use the TListView OnCustomDrawXXX events](https://delphidabbler.com/articles/article-16)". 4 | 5 | The demo was not originally developed under version control. The dat of the last update before adding to version control is not known. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The demo was created with Delphi 4 and has been tested with Delphi 4 and Delphi 7. 10 | 11 | Open `CustomLVDemo.dpr`, compile the source and run the program. 12 | 13 | Each of the examples from the article is displayed on a different tab of the display. Examine the source code of the various tabs do see how the _OnCustomDrawXXX_ event handlers have been used to customise the appearance of the list view. 14 | 15 | There are 5 tabs: 16 | 17 | 1. _Background Bitmap_: shows how to tile a bitmap in the background of the list view. Check the check box to display the text transparently over the background and clear it to show the text with a window colour background. 18 | 19 | 2. _Alternating Rows_: shows how to alternately colour the list view rows. 20 | 21 | 3. _Rainbow Columns_: shows how to display each list view column in a different colour. 22 | 23 | 4. _Custom Fonts_: shows how to display different fonts or font attributes in a column. 24 | 25 | 5. _Shaded Column_: shows how to highlight a selected column with a shading colour like Explorer does for the current sort column under Windows XP. Click a column header to highlight its column. 26 | 27 | ## Bug Reports 28 | 29 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 30 | -------------------------------------------------------------------------------- /article-17/DefEventDemo.pas: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D-,E-,F-,G+,H+,I+,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1} 2 | 3 | 4 | unit DefEventDemo; 5 | 6 | interface 7 | 8 | uses 9 | Classes, DesignIntf, DesignEditors; 10 | 11 | type 12 | TCompA = class(TComponent) 13 | private 14 | fOnFoo: TNotifyEvent; 15 | fOnBar: TNotifyEvent; 16 | fOnClick: TNotifyEvent; 17 | fOnChange: TNotifyEvent; 18 | fOnChanged: TNotifyEvent; 19 | fOnCreate: TNotifyEvent; 20 | published 21 | property OnFoo: TNotifyEvent read fOnFoo write fOnFoo; 22 | property OnBar: TNotifyEvent read fOnBar write fOnBar; 23 | property OnChange: TNotifyEvent read fOnChange write fOnChange; 24 | property OnChanged: TNotifyEvent read fOnChanged write fOnChanged; 25 | property OnClick: TNotifyEvent read fOnClick write fOnClick; 26 | property OnCreate: TNotifyEvent read fOnCreate write fOnCreate; 27 | end; 28 | 29 | TCompB = class(TComponent) 30 | private 31 | fOnFoo: TNotifyEvent; 32 | fOnBar: TNotifyEvent; 33 | fOnClick: TNotifyEvent; 34 | published 35 | property OnFoo: TNotifyEvent read fOnFoo write fOnFoo; 36 | property OnBar: TNotifyEvent read fOnBar write fOnBar; 37 | property OnClick: TNotifyEvent read fOnClick write fOnClick; 38 | end; 39 | 40 | TCompC = class(TComponent) 41 | private 42 | fOnFoo: TNotifyEvent; 43 | fOnBar: TNotifyEvent; 44 | published 45 | property OnFoo: TNotifyEvent read fOnFoo write fOnFoo; 46 | property OnBar: TNotifyEvent read fOnBar write fOnBar; 47 | end; 48 | 49 | TMyCompEditor = class(TDefaultEditor) 50 | protected 51 | procedure EditProperty(const PropertyEditor: IProperty; 52 | var Continue: Boolean); override; 53 | end; 54 | 55 | TCompEditorBase = class(TDefaultEditor) 56 | protected 57 | function DefaultEventName: string; virtual; abstract; 58 | { returns the name of the default event } 59 | procedure EditProperty(const PropertyEditor: IProperty; 60 | var Continue: Boolean); override; 61 | { records the property editor of the default event } 62 | end; 63 | 64 | TCompEditor = class(TCompEditorBase) 65 | protected 66 | function DefaultEventName: string; override; 67 | end; 68 | 69 | procedure Register; 70 | 71 | implementation 72 | 73 | uses 74 | SysUtils; 75 | 76 | procedure Register; 77 | begin 78 | // This registers the components 79 | RegisterComponents('DelphiDabbler', [TCompA, TCompB, TCompC]); 80 | // These register the component editors 81 | // un-comment as required 82 | // RegisterComponentEditor(TCompA, TMyCompEditor); 83 | // RegisterComponentEditor(TCompB, TCompEditor); 84 | // RegisterComponentEditor(TCompC, TCompEditor); 85 | end; 86 | 87 | { TMyCompEditor } 88 | 89 | procedure TMyCompEditor.EditProperty(const PropertyEditor: IProperty; 90 | var Continue: Boolean); 91 | begin 92 | // only call inherited method if required event name 93 | if CompareText(PropertyEditor.GetName, 'OnFoo') = 0 then 94 | inherited; 95 | end; 96 | 97 | { TCompEditorBase } 98 | 99 | procedure TCompEditorBase.EditProperty(const PropertyEditor: IProperty; 100 | var Continue: Boolean); 101 | begin 102 | if CompareText(PropertyEditor.GetName, DefaultEventName) = 0 then 103 | inherited; 104 | end; 105 | 106 | { TCompEditor } 107 | 108 | function TCompEditor.DefaultEventName: string; 109 | begin 110 | Result := 'OnFoo'; 111 | end; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /article-17/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 17 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-17/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 17 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to set a component's default event handler](https://delphidabbler.com/articles/article-17)". 4 | 5 | The demo was not originally developed under version control. The date of its last update before being placed under version control is not known. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The demo code is contained in `DefEventDemo.pas`. There is no demo project file or application - the code is designed to be added to a design time package and installed into the IDE. 10 | 11 | The code was targetted at Delphi 7. 12 | 13 | ### Test Components 14 | 15 | The unit defines the three sample components presented in the article: _TCompA_, _TCompB_ and _TCompC_. You can install the components into a package to test how Delphi determines the default event handler to create when the components are double clicked in the IDE. Comment out various events and rebuild the package and re-test to see how the default event handler changes. 16 | 17 | ### Component Editors 18 | 19 | Both the hard-wired component editor, _TMyCompEditor_, and the reusable versions (the abstract _TCompEditorBase_ and the concrete _TCompEditor_) are provided. 20 | 21 | The registration routines for the component editors are commented out to enable the default behaviour of the test components to be investigated (as above). 22 | 23 | #### TMyCompEditor 24 | 25 | To make _OnFoo_ the default event for _TCompA_ using _TMyCompEditor_ uncomment the line 26 | 27 | ```pascal 28 | RegisterComponentEditor(TCompA, TMyCompEditor); 29 | ``` 30 | 31 | from the _Register_ procedure and rebuild the component package. Then double click the component and check that the _OnFoo_ event handler has been created. 32 | 33 | #### TCompEditor 34 | 35 | To make _OnFoo_ the default event for _TCompB_ and/or _TCompC_ using _TCompEditor_ (derived from _TCompEditorBase_) uncomment the lines 36 | 37 | ```pascal 38 | RegisterComponentEditor(TCompB, TCompEditor); 39 | RegisterComponentEditor(TCompC, TCompEditor); 40 | ``` 41 | 42 | from the _Register_ procedure and rebuild the component package. Once again rebuild the component package and re-test. 43 | 44 | #### Going further 45 | 46 | To make a different default event for any of the components you can derive a new class from _TCompEditorBase_ and return the name of the required event from the overriden _DefaultEventName_ method. Then register your new class in the _Register_ routine for the required component. 47 | 48 | ## Bug Reports 49 | 50 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 51 | -------------------------------------------------------------------------------- /article-18/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Article #18 Demo Changelog 2 | 3 | ## v2.3 of 2010-05-30 4 | 5 | * Enabled compilation with Delphi's after v7 by adding required project files and groups. 6 | * IntfDocHostUIHandler.pas changed to MPL/GPL/LGPL tri-license and fixed some errors. 7 | * Added project file for later Delphis. 8 | * Removed duplication of DlgContent.html file. 9 | * Added batch file to remove binaries and temporary editing files. 10 | * Added disclaimers to source code. 11 | * Updated documentation. 12 | 13 | ## v2.2 of 2008-04-14 14 | 15 | * Revised IntfUIHandlers.pas: 16 | * Incorporated new DOCHOSTUIFLAG_ flags introduced in IE7. 17 | * Added value for DOCHOSTUIFLAG_ flags that had erroneous values. 18 | 19 | ## v2.1 of 2006-02-11 20 | 21 | * Revised IntfUIHandlers.pas based on unit of same name from article #22 demo. 22 | 23 | ## v2.0 of 2006-02-06 24 | 25 | * Revised Demo 2 to use new UContainer and UNulContainer units. 26 | 27 | ## v1.2 of 2006-01-29 28 | 29 | * Moved Demo 2 UI handler units to same folder as form. 30 | 31 | ## v1.1 of 2005-05-09 32 | 33 | * New stand-alone IntfUIHandlers.pas unit in demo 2. 34 | 35 | ## v1.0 of 2004-11-30 36 | 37 | * Original version. 38 | -------------------------------------------------------------------------------- /article-18/Clean.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Article #18 Demo program 3 | @rem 4 | @rem Script used to delete temporary files and directories. 5 | @rem --------------------------------------------------------------------------- 6 | 7 | @echo off 8 | setlocal 9 | 10 | echo Tidying 11 | echo ~~~~~~~ 12 | echo. 13 | 14 | set RootDir=. 15 | 16 | echo Deleting temporary files 17 | del /S %RootDir%\*.~* 18 | del /S %RootDir%\*.tmp 19 | del /S %RootDir%\*.ddp 20 | del /S %RootDir%\*.dcu 21 | del /S %RootDir%\*.exe 22 | del /S %RootDir%\*.dsk 23 | del /S %RootDir%\*.bak 24 | del /S %RootDir%\*.local 25 | del /S %RootDir%\*.identcache 26 | echo. 27 | 28 | echo Deleting temporary directories 29 | for /F "usebackq" %%i in (`dir /S /B /A:D %RootDir%\__history*`) do rmdir /S /Q %%i 30 | echo. 31 | 32 | echo Done. 33 | 34 | endlocal 35 | -------------------------------------------------------------------------------- /article-18/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 18 demo code 2 | 3 | The demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md), with the exception of `IntfDocHostUIHandler.pas` which is licensed under the [Mozilla Public License v2.0](https://www.mozilla.org/en-US/MPL/2.0/). 4 | -------------------------------------------------------------------------------- /article-18/Phase1/FmArtDemo1.dfm: -------------------------------------------------------------------------------- 1 | object ArtDemoForm1: TArtDemoForm1 2 | Left = 195 3 | Top = 117 4 | BorderStyle = bsDialog 5 | Caption = 'Article 18 Exercise' 6 | ClientHeight = 176 7 | ClientWidth = 380 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnCreate = FormCreate 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Button1: TButton 20 | Left = 156 21 | Top = 148 22 | Width = 75 23 | Height = 25 24 | Cancel = True 25 | Caption = 'Close' 26 | Default = True 27 | TabOrder = 0 28 | OnClick = Button1Click 29 | end 30 | object WebBrowser1: TWebBrowser 31 | Left = 0 32 | Top = 0 33 | Width = 380 34 | Height = 143 35 | Align = alTop 36 | PopupMenu = PopupMenu1 37 | TabOrder = 1 38 | ControlData = { 39 | 4C00000046270000C80E00000000000000000000000000000000000000000000 40 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 41 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 42 | 8000000000000000000000000000000000000000000000000000000000000000 43 | 00000000000000000100000000000000000000000000000000000000} 44 | end 45 | object PopupMenu1: TPopupMenu 46 | Left = 344 47 | Top = 8 48 | object ShowtheCSS1: TMenuItem 49 | Caption = 'Show the CSS...' 50 | end 51 | end 52 | end 53 | -------------------------------------------------------------------------------- /article-18/Phase1/FmArtDemo1.pas: -------------------------------------------------------------------------------- 1 | { 2 | * This source code accompanies the article "How to customise the TWebBrowser 3 | * user interface" which can be found at 4 | * https://delphidabbler.com/articles/article-18. 5 | } 6 | 7 | 8 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 9 | {$WARNINGS ON} 10 | 11 | 12 | unit FmArtDemo1; 13 | 14 | interface 15 | 16 | uses 17 | Forms, Menus, OleCtrls, SHDocVw, Classes, Controls, StdCtrls, XPMan; 18 | 19 | type 20 | TArtDemoForm1 = class(TForm) 21 | Button1: TButton; 22 | WebBrowser1: TWebBrowser; 23 | PopupMenu1: TPopupMenu; 24 | ShowtheCSS1: TMenuItem; 25 | procedure Button1Click(Sender: TObject); 26 | procedure FormCreate(Sender: TObject); 27 | end; 28 | 29 | var 30 | ArtDemoForm1: TArtDemoForm1; 31 | 32 | implementation 33 | 34 | uses 35 | SysUtils; 36 | 37 | {$R *.dfm} 38 | 39 | { TArtDemoForm } 40 | 41 | procedure TArtDemoForm1.FormCreate(Sender: TObject); 42 | begin 43 | WebBrowser1.Navigate( 44 | ExtractFilePath(ParamStr(0)) + '..\Shared\DlgContent.html' 45 | ); 46 | end; 47 | 48 | procedure TArtDemoForm1.Button1Click(Sender: TObject); 49 | begin 50 | Close; // close the application 51 | end; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /article-18/Phase1/WBUIArtDemo1.dpr: -------------------------------------------------------------------------------- 1 | { 2 | * This source code accompanies the article "How to customise the TWebBrowser 3 | * user interface" which can be found at 4 | * https://delphidabbler.com/articles/article-18 5 | } 6 | 7 | 8 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 9 | {$MINSTACKSIZE $00004000} 10 | {$MAXSTACKSIZE $00100000} 11 | {$IMAGEBASE $00400000} 12 | {$APPTYPE GUI} 13 | {$WARNINGS ON} 14 | 15 | 16 | program WBUIArtDemo1; 17 | 18 | uses 19 | Forms, 20 | FmArtDemo1 in 'FmArtDemo1.pas' {ArtDemoForm1}; 21 | 22 | {$R *.res} 23 | 24 | begin 25 | Application.Initialize; 26 | Application.CreateForm(TArtDemoForm1, ArtDemoForm1); 27 | Application.Run; 28 | end. 29 | -------------------------------------------------------------------------------- /article-18/Phase1/WBUIArtDemo1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-18/Phase1/WBUIArtDemo1.res -------------------------------------------------------------------------------- /article-18/Phase2/FmArtDemo2.dfm: -------------------------------------------------------------------------------- 1 | object ArtDemoForm2: TArtDemoForm2 2 | Left = 196 3 | Top = 118 4 | BorderStyle = bsDialog 5 | Caption = 'Article 18 Exercise' 6 | ClientHeight = 174 7 | ClientWidth = 378 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Button1: TButton 21 | Left = 156 22 | Top = 148 23 | Width = 75 24 | Height = 25 25 | Cancel = True 26 | Caption = 'Close' 27 | Default = True 28 | TabOrder = 0 29 | OnClick = Button1Click 30 | end 31 | object WebBrowser1: TWebBrowser 32 | Left = 0 33 | Top = 0 34 | Width = 378 35 | Height = 143 36 | Align = alTop 37 | PopupMenu = PopupMenu1 38 | TabOrder = 1 39 | ControlData = { 40 | 4C00000011270000C80E00000000000000000000000000000000000000000000 41 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 42 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 43 | 8000000000000000000000000000000000000000000000000000000000000000 44 | 00000000000000000100000000000000000000000000000000000000} 45 | end 46 | object PopupMenu1: TPopupMenu 47 | Left = 344 48 | Top = 8 49 | object ShowtheCSS1: TMenuItem 50 | Caption = 'Show the CSS...' 51 | OnClick = ShowtheCSS1Click 52 | end 53 | end 54 | end 55 | -------------------------------------------------------------------------------- /article-18/Phase2/FmArtDemo2.pas: -------------------------------------------------------------------------------- 1 | { 2 | * This source code accompanies the article "How to customise the TWebBrowser 3 | * user interface" which can be found at 4 | * https://delphidabbler.com/articles/article-18 5 | } 6 | 7 | 8 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 9 | {$WARNINGS ON} 10 | 11 | 12 | unit FmArtDemo2; 13 | 14 | interface 15 | 16 | uses 17 | Forms, Menus, OleCtrls, SHDocVw, Classes, Controls, StdCtrls, XPMan, 18 | 19 | UContainer; 20 | 21 | 22 | type 23 | TArtDemoForm2 = class(TForm) 24 | Button1: TButton; 25 | WebBrowser1: TWebBrowser; 26 | PopupMenu1: TPopupMenu; 27 | ShowtheCSS1: TMenuItem; 28 | procedure Button1Click(Sender: TObject); 29 | procedure FormCreate(Sender: TObject); 30 | procedure ShowtheCSS1Click(Sender: TObject); 31 | procedure FormDestroy(Sender: TObject); 32 | private 33 | fWBContainer: TWBContainer; 34 | end; 35 | 36 | var 37 | ArtDemoForm2: TArtDemoForm2; 38 | 39 | implementation 40 | 41 | uses 42 | SysUtils, Windows, Graphics, Dialogs; 43 | 44 | {$R *.dfm} 45 | 46 | { 47 | ColorToHTML is taken from the CodeSnip database at 48 | http://www.delphidabbler.com/codesnip 49 | } 50 | function ColorToHTML(const Color: TColor): string; 51 | var 52 | ColorRGB: Integer; 53 | begin 54 | ColorRGB := ColorToRGB(Color); 55 | Result := Format( 56 | '#%0.2X%0.2X%0.2X', 57 | [GetRValue(ColorRGB), GetGValue(ColorRGB), GetBValue(ColorRGB)] 58 | ); 59 | end; 60 | 61 | 62 | { TArtDemoForm } 63 | 64 | procedure TArtDemoForm2.FormCreate(Sender: TObject); 65 | const 66 | // Template for default CSS style 67 | cCSSTplt = 'body {'#13#10 68 | + ' background-color: %0:s;'#13#10 69 | + ' color: %1:s;'#13#10 70 | + ' font-family: "%2:s";'#13#10 71 | + ' font-size: %3:dpt;'#13#10 72 | + ' margin: 4px;'#13#10 73 | + '}'#13#10 74 | + 'h1 {'#13#10 75 | + ' font-size: %3:dpt;'#13#10 76 | + ' font-weight: bold;'#13#10 77 | + ' text-align: center;'#13#10 78 | + '}'#13#10 79 | + 'input#button {'#13#10 80 | + ' color: %1:s;'#13#10 81 | + ' font-family: "%2:s";'#13#10 82 | + ' font-size: %3:dpt;'#13#10 83 | + '}'#13#10 84 | + '.ruled {'#13#10 85 | + ' border-bottom: %4:s solid 2px;'#13#10 86 | + ' padding-bottom: 6px;'#13#10 87 | + '}'; 88 | var 89 | FmtCSS: string; // Stores default CSS 90 | begin 91 | // Create the CSS from system colours 92 | FmtCSS := Format( 93 | cCSSTplt, 94 | [ColorToHTML(Self.Color), ColorToHTML(Self.Font.Color), 95 | Self.Font.Name, Self.Font.Size, 96 | ColorToHTML(clInactiveCaption)] 97 | ); 98 | // Create web browser container and set required properties 99 | fWBContainer := TWBContainer.Create(WebBrowser1); 100 | fWBContainer.UseCustomCtxMenu := True; // use our popup menu 101 | fWBContainer.Show3DBorder := False; // no border 102 | fWBContainer.ShowScrollBars := False; // no scroll bars 103 | fWBContainer.AllowTextSelection := False; // no text selection (**) 104 | fWBContainer.CSS := FmtCSS; // CSS to be used 105 | // load content 106 | fWBContainer.HostedBrowser.Navigate( 107 | ExtractFilePath(ParamStr(0)) + '..\Shared\DlgContent.html' 108 | ); 109 | end; 110 | 111 | procedure TArtDemoForm2.Button1Click(Sender: TObject); 112 | begin 113 | Close; // close the application 114 | end; 115 | 116 | procedure TArtDemoForm2.ShowtheCSS1Click(Sender: TObject); 117 | begin 118 | ShowMessage(fWBContainer.CSS); // display the CSS code 119 | end; 120 | 121 | procedure TArtDemoForm2.FormDestroy(Sender: TObject); 122 | begin 123 | fWBContainer.Free; // free the container pbject 124 | end; 125 | 126 | end. 127 | -------------------------------------------------------------------------------- /article-18/Phase2/WBUIArtDemo2.dpr: -------------------------------------------------------------------------------- 1 | { 2 | * This source code accompanies the article "How to customise the TWebBrowser 3 | * user interface" which can be found at 4 | * https://delphidabbler.com/articles/article-18 5 | } 6 | 7 | 8 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 9 | {$MINSTACKSIZE $00004000} 10 | {$MAXSTACKSIZE $00100000} 11 | {$IMAGEBASE $00400000} 12 | {$APPTYPE GUI} 13 | {$WARNINGS ON} 14 | 15 | 16 | program WBUIArtDemo2; 17 | 18 | uses 19 | Forms, 20 | FmArtDemo2 in 'FmArtDemo2.pas' {ArtDemoForm2}, 21 | UNulContainer in 'UNulContainer.pas', 22 | IntfDocHostUIHandler in 'IntfDocHostUIHandler.pas', 23 | UContainer in 'UContainer.pas'; 24 | 25 | {$R *.res} 26 | 27 | begin 28 | Application.Initialize; 29 | Application.CreateForm(TArtDemoForm2, ArtDemoForm2); 30 | Application.Run; 31 | end. 32 | -------------------------------------------------------------------------------- /article-18/Phase2/WBUIArtDemo2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-18/Phase2/WBUIArtDemo2.res -------------------------------------------------------------------------------- /article-18/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 18 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to customise the TWebBrowser user interface](https://delphidabbler.com/articles/article-18)". 4 | 5 | The demo was not originally developed under version control. It's last update before being placed under version control was on 30 May 2010. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 13 June 2022. See [CHANGELOG.md](./CHANGELOG.md) for details of known updates. 6 | 7 | ## About the Demo 8 | 9 | The code was originally targetted at Delphi 7 and later. It has been tested with Delphi 7, 2006 and 2010 and includes project and project group files suitable for all these compilers. 10 | 11 | There are two demos: 12 | 13 | 1. The "phase 1" version of the sample application from the article. This shows an unmodified web browser displaying some HTML in a form. The project is `WBUIArtDemo1.dpr` and it is in the `ArticleDemo\Phase1` folder. The HTML that is displayed is found in the `DlgContent.html` file in the `Shared` folder. 14 | 15 | 2. The "phase 2" version of the above program. This project configures the web browser control as follows: 16 | 17 | * It uses the same background and fonts and theme as the form. 18 | * Scroll bars and borders are hidden. 19 | * A custom context menu is provided. 20 | * Text selection is prevented. 21 | 22 | The project is named `WBUIArtDemo2.dpr` and it is to be found in the `ArticleDemo\Phase2` folder. This demo uses the same HTML file, `DlgContent.html`, in the `Shared` folder as used in phase 1. 23 | 24 | You should compile and test the demos then examine the source code. Please review the programs alongside the article. 25 | 26 | ## Bug Reports 27 | 28 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 29 | -------------------------------------------------------------------------------- /article-18/Shared/DlgContent.html: -------------------------------------------------------------------------------- 1 | 3 | 10 | 11 | 12 | Demo Dialog Content 13 | 20 | 21 | 22 |

About this demo

23 |

24 | This demo relates to the DelphiDabbler.com article "How to 25 | customise the TWebBrowser user interface". 26 | 33 |

34 |

35 | © Copyright P D Johnson 36 | (delphidabbler.com), 2004-2022. 38 |

39 |

40 | Right click above the line to see the custom pop-up menu. 41 |

42 | 43 | -------------------------------------------------------------------------------- /article-18/WBUIDemos.bdsgroup: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Phase1\WBUIArtDemo1.bdsproj 15 | Phase2\WBUIArtDemo2.bdsproj 16 | WBUIArtDemo1.exe WBUIArtDemo2.exe 17 | 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /article-18/WBUIDemos.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = WBUIArtDemo1.exe WBUIArtDemo2.exe 13 | #------------------------------------------------------------------------------ 14 | default: $(PROJECTS) 15 | #------------------------------------------------------------------------------ 16 | 17 | 18 | WBUIArtDemo1.exe: Phase1\WBUIArtDemo1.dpr 19 | $(DCC) 20 | 21 | WBUIArtDemo2.exe: Phase2\WBUIArtDemo2.dpr 22 | $(DCC) 23 | 24 | 25 | -------------------------------------------------------------------------------- /article-18/WBUIDemos.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {BBFCD756-0BD5-4A7C-BFD7-8A3C951441F5} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /article-19/1/Demo1.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo project shows the problem that the article addresses. 3 | } 4 | 5 | 6 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 7 | {$MINSTACKSIZE $00004000} 8 | {$MAXSTACKSIZE $00100000} 9 | {$IMAGEBASE $00400000} 10 | {$APPTYPE GUI} 11 | {$WARNINGS ON} 12 | 13 | 14 | program Demo1; 15 | 16 | uses 17 | Forms, 18 | FmDemo1 in 'FmDemo1.pas' {DemoForm}; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TDemoForm, DemoForm); 25 | Application.Run; 26 | end. 27 | 28 | -------------------------------------------------------------------------------- /article-19/1/Demo1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/1/Demo1.res -------------------------------------------------------------------------------- /article-19/1/FmDemo1.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/1/FmDemo1.dfm -------------------------------------------------------------------------------- /article-19/1/FmDemo1.pas: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARNINGS ON} 3 | 4 | 5 | unit FmDemo1; 6 | 7 | interface 8 | 9 | uses 10 | Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, OleCtrls, SHDocVw, Classes, 11 | Controls; 12 | 13 | type 14 | TDemoForm = class(TForm) 15 | Memo1: TMemo; 16 | WebBrowser1: TWebBrowser; 17 | StatusBar1: TStatusBar; 18 | Timer1: TTimer; 19 | Button1: TButton; 20 | OpenDialog1: TOpenDialog; 21 | procedure Timer1Timer(Sender: TObject); 22 | procedure Button1Click(Sender: TObject); 23 | end; 24 | 25 | var 26 | DemoForm: TDemoForm; 27 | 28 | implementation 29 | 30 | uses 31 | SysUtils, MSHTML; 32 | 33 | {$R *.dfm} 34 | 35 | procedure TDemoForm.Timer1Timer(Sender: TObject); 36 | begin 37 | if Assigned(ActiveControl) then 38 | StatusBar1.SimpleText := 'ActiveControl = ' 39 | + ActiveControl.Name 40 | else 41 | StatusBar1.SimpleText := 'ActiveControl = nil'; 42 | end; 43 | 44 | procedure TDemoForm.Button1Click(Sender: TObject); 45 | begin 46 | if OpenDialog1.Execute then 47 | begin 48 | StatusBar1.SimpleText := ''; // fixes SB redraw problem 49 | if FileExists(OpenDialog1.FileName) then 50 | begin 51 | WebBrowser1.Navigate('file://' + OpenDialog1.FileName); 52 | Memo1.Lines.LoadFromFile(OpenDialog1.FileName); 53 | end 54 | else 55 | begin 56 | WebBrowser1.Navigate('about:blank'); 57 | Memo1.Text := 'about:blank'; 58 | end; 59 | end; 60 | end; 61 | 62 | end. 63 | 64 | -------------------------------------------------------------------------------- /article-19/2/Demo2.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demoproject relates to the first solution presented in the article. 3 | } 4 | 5 | 6 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 7 | {$MINSTACKSIZE $00004000} 8 | {$MAXSTACKSIZE $00100000} 9 | {$IMAGEBASE $00400000} 10 | {$APPTYPE GUI} 11 | {$WARNINGS ON} 12 | 13 | 14 | program Demo2; 15 | 16 | uses 17 | Forms, 18 | FmDemo2 in 'FmDemo2.pas' {DemoForm}; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TDemoForm, DemoForm); 25 | Application.Run; 26 | end. 27 | -------------------------------------------------------------------------------- /article-19/2/Demo2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/2/Demo2.res -------------------------------------------------------------------------------- /article-19/2/FmDemo2.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/2/FmDemo2.dfm -------------------------------------------------------------------------------- /article-19/2/FmDemo2.pas: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARNINGS ON} 3 | 4 | 5 | unit FmDemo2; 6 | 7 | interface 8 | 9 | uses 10 | Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, OleCtrls, SHDocVw, Classes, 11 | Controls; 12 | 13 | type 14 | TDemoForm = class(TForm) 15 | Memo1: TMemo; 16 | WebBrowser1: TWebBrowser; 17 | StatusBar1: TStatusBar; 18 | Timer1: TTimer; 19 | Button1: TButton; 20 | OpenDialog1: TOpenDialog; 21 | procedure FormShow(Sender: TObject); 22 | procedure Timer1Timer(Sender: TObject); 23 | procedure WebBrowser1CommandStateChange(Sender: TObject; 24 | Command: Integer; Enable: WordBool); 25 | procedure Button1Click(Sender: TObject); 26 | end; 27 | 28 | var 29 | DemoForm: TDemoForm; 30 | 31 | implementation 32 | 33 | uses 34 | SysUtils, MSHTML; 35 | 36 | {$R *.dfm} 37 | 38 | procedure TDemoForm.FormShow(Sender: TObject); 39 | begin 40 | WebBrowser1.Navigate('about:blank'); 41 | end; 42 | 43 | procedure TDemoForm.Timer1Timer(Sender: TObject); 44 | begin 45 | if Assigned(ActiveControl) then 46 | StatusBar1.SimpleText := 'ActiveControl = ' 47 | + ActiveControl.Name 48 | else 49 | StatusBar1.SimpleText := 'ActiveControl = nil'; 50 | end; 51 | 52 | procedure TDemoForm.WebBrowser1CommandStateChange(Sender: TObject; 53 | Command: Integer; Enable: WordBool); 54 | var 55 | Doc: IHTMLDocument2; // document object 56 | Sel: IHTMLSelectionObject; // current selection 57 | begin 58 | // Check we have a valid web browser triggering this event 59 | if not Assigned(Sender) or not (Sender is TWebBrowser) then 60 | Exit; 61 | // Check we have required command 62 | if TOleEnum(Command) <> CSC_UPDATECOMMANDS then 63 | Exit; 64 | // Get ref to document object and check not nil 65 | Doc := WebBrowser1.Document as IHTMLDocument2; 66 | if not Assigned(Doc) then 67 | Exit; 68 | // Get ref to current selection 69 | Sel := Doc.selection as IHTMLSelectionObject; 70 | // If selection is of correct type then we have a mouse click 71 | if Assigned(Sel) and (Sel.type_ = 'Text') then 72 | // Make the web browser the form's active control 73 | ActiveControl := Sender as TWebBrowser; 74 | end; 75 | 76 | procedure TDemoForm.Button1Click(Sender: TObject); 77 | begin 78 | if OpenDialog1.Execute then 79 | begin 80 | StatusBar1.SimpleText := ''; // fixes SB redraw problem 81 | if FileExists(OpenDialog1.FileName) then 82 | begin 83 | WebBrowser1.Navigate('file://' + OpenDialog1.FileName); 84 | Memo1.Lines.LoadFromFile(OpenDialog1.FileName); 85 | end 86 | else 87 | begin 88 | WebBrowser1.Navigate('about:blank'); 89 | Memo1.Text := 'about:blank'; 90 | end; 91 | end; 92 | end; 93 | 94 | end. 95 | -------------------------------------------------------------------------------- /article-19/3/Demo3.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo project relates to the second solution presented in the article. 3 | } 4 | 5 | 6 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 7 | {$MINSTACKSIZE $00004000} 8 | {$MAXSTACKSIZE $00100000} 9 | {$IMAGEBASE $00400000} 10 | {$APPTYPE GUI} 11 | {$WARNINGS ON} 12 | 13 | 14 | program Demo3; 15 | 16 | uses 17 | Forms, 18 | FmDemo3 in 'FmDemo3.pas' {DemoForm}; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TDemoForm, DemoForm); 25 | Application.Run; 26 | end. 27 | -------------------------------------------------------------------------------- /article-19/3/Demo3.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/3/Demo3.res -------------------------------------------------------------------------------- /article-19/3/FmDemo3.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-19/3/FmDemo3.dfm -------------------------------------------------------------------------------- /article-19/3/FmDemo3.pas: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARNINGS ON} 3 | 4 | 5 | unit FmDemo3; 6 | 7 | interface 8 | 9 | uses 10 | Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, OleCtrls, SHDocVw, Classes, 11 | Controls, AppEvnts, Windows; 12 | 13 | type 14 | TDemoForm = class(TForm) 15 | Memo1: TMemo; 16 | WebBrowser1: TWebBrowser; 17 | StatusBar1: TStatusBar; 18 | Timer1: TTimer; 19 | Button1: TButton; 20 | OpenDialog1: TOpenDialog; 21 | ApplicationEvents1: TApplicationEvents; 22 | procedure FormShow(Sender: TObject); 23 | procedure Timer1Timer(Sender: TObject); 24 | procedure Button1Click(Sender: TObject); 25 | procedure ApplicationEvents1Message(var Msg: tagMSG; 26 | var Handled: Boolean); 27 | private 28 | IEServerWindow: HWND; 29 | end; 30 | 31 | var 32 | DemoForm: TDemoForm; 33 | 34 | implementation 35 | 36 | uses 37 | SysUtils, MSHTML, Messages; 38 | 39 | {$R *.dfm} 40 | 41 | procedure TDemoForm.FormShow(Sender: TObject); 42 | begin 43 | WebBrowser1.Navigate('about:blank'); 44 | end; 45 | 46 | procedure TDemoForm.Timer1Timer(Sender: TObject); 47 | var 48 | NextWin: HWND; // handle of various child windows 49 | begin 50 | while IEServerWindow = 0 do 51 | begin 52 | NextWin := FindWindowEx(DemoForm.Handle, 0, 'Shell Embedding', nil); 53 | NextWin := FindWindowEx(NextWin, 0, 'Shell DocObject View', nil); 54 | IEServerWindow := FindWindowEx( 55 | NextWin, 0, 'Internet Explorer_Server', nil 56 | ); 57 | end; 58 | 59 | if Assigned(ActiveControl) then 60 | StatusBar1.SimpleText := 'ActiveControl = ' 61 | + ActiveControl.Name 62 | else 63 | StatusBar1.SimpleText := 'ActiveControl = nil'; 64 | end; 65 | 66 | procedure TDemoForm.Button1Click(Sender: TObject); 67 | begin 68 | if OpenDialog1.Execute then 69 | begin 70 | StatusBar1.SimpleText := ''; // fixes SB redraw problem 71 | if FileExists(OpenDialog1.FileName) then 72 | begin 73 | WebBrowser1.Navigate('file://' + OpenDialog1.FileName); 74 | Memo1.Lines.LoadFromFile(OpenDialog1.FileName); 75 | end 76 | else 77 | begin 78 | WebBrowser1.Navigate('about:blank'); 79 | Memo1.Text := 'about:blank'; 80 | end; 81 | end; 82 | end; 83 | 84 | procedure TDemoForm.ApplicationEvents1Message(var Msg: tagMSG; 85 | var Handled: Boolean); 86 | begin 87 | if (Msg.hwnd = IEServerWindow) then 88 | if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_RBUTTONDOWN) 89 | or (Msg.message = WM_MBUTTONDOWN) then 90 | ActiveControl := WebBrowser1; 91 | end; 92 | 93 | end. 94 | 95 | -------------------------------------------------------------------------------- /article-19/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 19 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-19/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 19 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to make a TWebBrowser become the active control when clicked](https://delphidabbler.com/articles/article-19)". 4 | 5 | The demo was not originally developed under version control. The date of its last update before being placed under version control is not known. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The code was originally targetted at Delphi 7 and has not been tested with other versions of the compiler. 10 | 11 | There are three projects, in sub-folders `1`, `2` & `3`, that have the following purposes: 12 | 13 | 1. Illustrates the problem. It is the code presented in Listings 1 and 2 in the article. 14 | 2. Illustrates the first solution. It is the code from listings 4 and 5. 15 | 3. Illustrates the second solution. It is the code from listings 6 and 7. 16 | 17 | Load and compile each of the demo projects from their respective folders. Click in each of the three controls and see the name of the focussed control change in the status bar. Observe the different in behaviour in each of the solutions (demos 2 & 3) compared with the default behaviour of demo 1. 18 | 19 | ## Bug Reports 20 | 21 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 22 | -------------------------------------------------------------------------------- /article-20/Article20.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = Article20.exe MultiVer.exe NoTransVer.exe NoVerInfo.exe 13 | #------------------------------------------------------------------------------ 14 | default: $(PROJECTS) 15 | #------------------------------------------------------------------------------ 16 | 17 | Article20.exe: Article20.dpr 18 | $(DCC) 19 | 20 | MultiVer.exe: MultiVer.dpr 21 | $(DCC) 22 | 23 | NoTransVer.exe: NoTransVer.dpr 24 | $(DCC) 25 | 26 | NoVerInfo.exe: NoVerInfo.dpr 27 | $(DCC) 28 | 29 | 30 | -------------------------------------------------------------------------------- /article-20/Article20.dpr: -------------------------------------------------------------------------------- 1 | program Article20; 2 | 3 | uses 4 | Forms, 5 | FmDemo in 'FmDemo.pas' {Form1}, 6 | UVerInfoRoutines in 'UVerInfoRoutines.pas', 7 | UVerInfoClass in 'UVerInfoClass.pas', 8 | UVerInfoTypes in 'UVerInfoTypes.pas'; 9 | 10 | {$R *.res} 11 | {$R VArticle20.res} 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TForm1, Form1); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /article-20/Article20.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-20/Article20.res -------------------------------------------------------------------------------- /article-20/FmDemo.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 192 3 | Top = 114 4 | Width = 696 5 | Height = 480 6 | Caption = 'Form1' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 16 18 | Top = 16 19 | Width = 161 20 | Height = 13 21 | Caption = 'Choose app to test for version info' 22 | end 23 | object ListBox1: TListBox 24 | Left = 16 25 | Top = 32 26 | Width = 241 27 | Height = 84 28 | Font.Charset = DEFAULT_CHARSET 29 | Font.Color = clWindowText 30 | Font.Height = -16 31 | Font.Name = 'MS Sans Serif' 32 | Font.Style = [] 33 | IntegralHeight = True 34 | ItemHeight = 20 35 | Items.Strings = ( 36 | 'This app (single translation)' 37 | 'MultiVer.exe' 38 | 'NoTransVer.exe' 39 | 'NoVerInfo.exe') 40 | ParentFont = False 41 | TabOrder = 0 42 | end 43 | object btnTestClass: TButton 44 | Left = 288 45 | Top = 32 46 | Width = 97 47 | Height = 25 48 | Caption = 'Test Class' 49 | TabOrder = 1 50 | OnClick = btnTestClassClick 51 | end 52 | object Memo1: TMemo 53 | Left = 16 54 | Top = 120 55 | Width = 665 56 | Height = 321 57 | Lines.Strings = ( 58 | 'Memo1') 59 | ScrollBars = ssBoth 60 | TabOrder = 2 61 | WordWrap = False 62 | end 63 | object btnTestRoutines: TButton 64 | Left = 288 65 | Top = 64 66 | Width = 97 67 | Height = 25 68 | Caption = 'Test Routines' 69 | TabOrder = 3 70 | OnClick = btnTestRoutinesClick 71 | end 72 | end 73 | -------------------------------------------------------------------------------- /article-20/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 20 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-20/MultiVer.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Do-nothing program with multi-language version information. 3 | } 4 | 5 | program MultiVer; 6 | 7 | {$APPTYPE CONSOLE} 8 | 9 | uses 10 | Windows; 11 | 12 | {$R VMultiVer.res} 13 | 14 | begin 15 | WriteLn('This app has multi-lingual version info'); 16 | Write('Press return to close'); 17 | ReadLn; 18 | end. 19 | -------------------------------------------------------------------------------- /article-20/NoTransVer.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Do-nothing program with no translations in version information. 3 | } 4 | 5 | program NoTransVer; 6 | 7 | 8 | uses 9 | Windows; 10 | 11 | {$R VNoTransVer.res} 12 | 13 | begin 14 | WriteLn('This app has no translation info'); 15 | Write('Press return to close'); 16 | ReadLn; 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /article-20/NoVerInfo.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Do-nothing program with no version information. 3 | } 4 | 5 | program NoVerInfo; 6 | 7 | {$APPTYPE CONSOLE} 8 | 9 | uses 10 | Windows; 11 | 12 | begin 13 | WriteLn('This app has no version info'); 14 | Write('Press return to close'); 15 | ReadLn; 16 | end. 17 | -------------------------------------------------------------------------------- /article-20/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 20 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to extract version information using the Windows API](https://delphidabbler.com/articles/article-20)". 4 | 5 | The demo was not originally developed under version control. The last update before being placed under version control appears to have been during 2005. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | The demo program can load version information from one of four supplied executables. One of these is the demo program itself while the others are do-nothing console programs whose sole purpose is to have their version information checked by the demo. The example programs contain various different configurations of version information as follows: 10 | 11 | * the demo program has a single translation / string table 12 | * one console program has two translations / string tables 13 | * another has no translations (just fixed file information) 14 | * the last has no version information at all 15 | 16 | The following files are included in the demo: 17 | 18 | * `Article20.bpg` - main project group - four programs 19 | * `Article20.dpr` - project file for demo program 20 | * `Article20.res` - icon etc for demo program 21 | * `FmDemo.pas/.dfm` - demo program's main form 22 | * `MultiVer.dpr` - do-nothing program containing 2 string tables / translations 23 | * `NoTransVer.dpr` - do-nothing program containing no string tables / translations 24 | * `NoVerInfo.dpr` - do-nothing program containing no version information at all 25 | * `UVerInfoClass.pas` - unit containing class developed in article. 26 | * `UVerInfoRoutines.pas` - unit containing routines developed in article. 27 | * `UVerInfoTypes.pas` - unit containing types declared in article 28 | * `VArticle20.rc/.res` - resource with single translation in ver info for demo 29 | * `VMultiVer.rc/.res` - resource with two translations in ver info 30 | * `VNoTransVer.rc/.res` - resource with no translations in ver info 31 | 32 | To use the demo start Delphi and load `Article20.bpg`. Now build all the projects in the project group. 33 | 34 | Run `Article20.exe`. Select one of the programs shown in the list box and click the "Test Class" and "Test Click" buttons to exercise either class. 35 | 36 | > **NOTE:** You **must** compile `MultiVer.exe`, `NoTransVer.exe` and `NoVerInfo.exe` before attempting to run `Article20.exe`. 37 | 38 | Once the demo program has been tested, examine the code in `UVerInfoClass.pas`, `UVerInfoRoutines.pas` and `UVerInfoTypes.pas` along with the code that exercises them in `FmDemo.pas`. 39 | 40 | ## Bug Reports 41 | 42 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 43 | -------------------------------------------------------------------------------- /article-20/UVerInfoClass.pas: -------------------------------------------------------------------------------- 1 | { 2 | Unit implements class that encapsulates version from an executable file. 3 | } 4 | 5 | unit UVerInfoClass; 6 | 7 | {$WARN UNSAFE_TYPE OFF} 8 | {$WARN UNSAFE_CODE OFF} 9 | 10 | interface 11 | 12 | uses 13 | Windows, 14 | UVerInfoTypes; 15 | 16 | type 17 | { 18 | TVerInfo: 19 | Class that encapsulates version information stored in an executable file. 20 | } 21 | TVerInfo = class(TObject) 22 | private 23 | fFixedFileInfo: TVSFixedFileInfo; // fixed file info record 24 | fTransTable: TTransRecArray; // translation table 25 | fHasVerInfo: Boolean; // whether file contains ver info 26 | fVerInfo: Pointer; // buffer storing ver info 27 | function GetString(const Trans, Name: string): string; 28 | function GetTranslation(Idx: Integer): string; 29 | function GetTranslationCount: Integer; 30 | public 31 | constructor Create(const FileName: string); 32 | destructor Destroy; override; 33 | property HasVerInfo: Boolean read fHasVerInfo; 34 | property FixedFileInfo: TVSFixedFileInfo read fFixedFileInfo; 35 | property Translations[Idx: Integer]: string read GetTranslation; 36 | property TranslationCount: Integer read GetTranslationCount; 37 | property Strings[const Trans, Name: string]: string read GetString; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | SysUtils, 44 | UVerInfoRoutines; 45 | 46 | { TVerInfo } 47 | 48 | constructor TVerInfo.Create(const FileName: string); 49 | var 50 | BufSize: Integer; // size of ver info buffer 51 | begin 52 | inherited Create; 53 | // Get size of buffer: no ver info if size = 0 54 | BufSize := GetVerInfoSize(FileName); 55 | fHasVerInfo := BufSize > 0; 56 | if fHasVerInfo then 57 | begin 58 | // Read ver info into buffer 59 | GetMem(fVerInfo, BufSize); 60 | GetVerInfo(FileName, BufSize, fVerInfo); 61 | // Read fixed file info and translation table 62 | fFixedFileInfo := GetFFI(fVerInfo); 63 | fTransTable := GetTransTable(fVerInfo); 64 | end; 65 | end; 66 | 67 | destructor TVerInfo.Destroy; 68 | begin 69 | // Free ver info buffer 70 | FreeMem(fVerInfo); 71 | inherited; 72 | end; 73 | 74 | function TVerInfo.GetString(const Trans, Name: string): string; 75 | begin 76 | Assert(fHasVerInfo); 77 | Result := GetVerInfoStr(fVerInfo, Trans, Name); 78 | end; 79 | 80 | function TVerInfo.GetTranslation(Idx: Integer): string; 81 | begin 82 | Assert(fHasVerInfo); 83 | Assert((Idx >= 0) and (Idx < TranslationCount)); 84 | // Return string representation of translation at given index 85 | Result := Format( 86 | '%4.4x%4.4x', [fTransTable[Idx].Lang, fTransTable[Idx].CharSet] 87 | ); 88 | end; 89 | 90 | function TVerInfo.GetTranslationCount: Integer; 91 | begin 92 | Result := Length(fTransTable); 93 | end; 94 | 95 | end. 96 | -------------------------------------------------------------------------------- /article-20/UVerInfoTypes.pas: -------------------------------------------------------------------------------- 1 | { 2 | Unit declares types used in reading version information. 3 | } 4 | 5 | unit UVerInfoTypes; 6 | 7 | interface 8 | 9 | type 10 | 11 | { 12 | TTransRec: 13 | Translation record: stores language code and character set (code page). 14 | } 15 | TTransRec = packed record 16 | Lang, // language code 17 | CharSet: Word; // character set (code page) 18 | end; 19 | 20 | { 21 | PTransRec: 22 | Pointer to translation record. 23 | } 24 | PTransRec = ^TTransRec; 25 | 26 | { 27 | TTransRecArray: 28 | Dynamic array of translation records: the translation table. 29 | } 30 | TTransRecArray = array of TTransRec; 31 | 32 | implementation 33 | 34 | end. 35 | -------------------------------------------------------------------------------- /article-20/VArticle20.rc: -------------------------------------------------------------------------------- 1 | #define VERINFO 1 2 | 3 | VERINFO VERSIONINFO 4 | FILEVERSION 1, 0, 0, 0 5 | PRODUCTVERSION 1, 0, 0, 0 6 | FILEFLAGSMASK 0x3F 7 | FILEOS VOS__WINDOWS32 8 | FILETYPE VFT_APP 9 | { 10 | BLOCK "StringFileInfo" 11 | { 12 | BLOCK "080904E4" 13 | { 14 | VALUE "Comments", "Demo application for article #20 on www.delphidabbler.com\000" 15 | VALUE "CompanyName", "DelphiDabbler\000" 16 | VALUE "FileDescription", "Article#20 demo app.\000" 17 | VALUE "FileVersion", "1.0\000" 18 | VALUE "LegalCopyright", "Copyright (c) Peter Johnson 2005\000" 19 | VALUE "OriginalFileName", "Article20\000" 20 | VALUE "ProductName", "DelphiDabbler article#20\000" 21 | VALUE "ProductVersion", "1.0\000" 22 | } 23 | } 24 | BLOCK "VarFileInfo" 25 | { 26 | VALUE "Translation", 0x0809, 1252 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /article-20/VArticle20.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-20/VArticle20.res -------------------------------------------------------------------------------- /article-20/VMultiVer.rc: -------------------------------------------------------------------------------- 1 | 1 VERSIONINFO 2 | 3 | FILEVERSION 1, 2, 3, 4 4 | PRODUCTVERSION 11, 22, 33, 44 5 | FILEFLAGSMASK 0x3F 6 | FILEFLAGS VS_FF_PRIVATEBUILD + VS_FF_SPECIALBUILD 7 | FILEOS VOS__WINDOWS32 8 | FILETYPE VFT_APP 9 | 10 | { 11 | BLOCK "StringFileInfo" 12 | { 13 | BLOCK "040904E4" 14 | { 15 | VALUE "Fred", "Fred's value\000" 16 | VALUE "Bert", "Bert's value (American special build): 2002\000" 17 | VALUE "SpecialBuild", "American special build\000" 18 | } 19 | BLOCK "080904E4" 20 | { 21 | VALUE "Comments", "Comments entry\000" 22 | VALUE "CompanyName", "PJSoft\000" 23 | VALUE "FileDescription", "A test multi language version info resource.\000" 24 | VALUE "FileVersion", "v1.2.3.4\000" 25 | VALUE "InternalName", "MultiVer\000" 26 | VALUE "LegalCopyright", "Copyright (c) PJSoft 2002\000" 27 | VALUE "LegalTrademarks", "\000" 28 | VALUE "OriginalFileName", "MultiVer.fnt\000" 29 | VALUE "PrivateBuild", "Not released\000" 30 | VALUE "ProductName", "Version Info Tester \000" 31 | VALUE "ProductVersion", "Version Info Tester Rel 11.22.33.44\000" 32 | VALUE "SpecialBuild", "English Special Build\000" 33 | } 34 | } 35 | BLOCK "VarFileInfo" 36 | { 37 | VALUE "Translation", 0x0409, 1252, 0x0809, 1252 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /article-20/VMultiVer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-20/VMultiVer.res -------------------------------------------------------------------------------- /article-20/VNoTransVer.rc: -------------------------------------------------------------------------------- 1 | 1 VERSIONINFO 2 | 3 | FILEVERSION 1, 2, 3, 4 4 | PRODUCTVERSION 111, 222, 333, 444 5 | FILEFLAGSMASK 0x3F 6 | FILEFLAGS VS_FF_PRIVATEBUILD + VS_FF_SPECIALBUILD 7 | FILEOS VOS__WINDOWS32 8 | FILETYPE VFT_APP 9 | 10 | { 11 | } -------------------------------------------------------------------------------- /article-20/VNoTransVer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-20/VNoTransVer.res -------------------------------------------------------------------------------- /article-21/CaseStudy/Article21.dpr: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$MINSTACKSIZE $00004000} 3 | {$MAXSTACKSIZE $00100000} 4 | {$IMAGEBASE $00400000} 5 | {$APPTYPE GUI} 6 | {$WARNINGS ON} 7 | 8 | program Article21; 9 | 10 | uses 11 | Forms, 12 | FmDemo in 'FmDemo.pas' {Form1}; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | Application.CreateForm(TForm1, Form1); 19 | Application.Run; 20 | end. 21 | -------------------------------------------------------------------------------- /article-21/CaseStudy/Article21.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-21/CaseStudy/Article21.res -------------------------------------------------------------------------------- /article-21/CaseStudy/FmDemo.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 192 3 | Top = 114 4 | Width = 474 5 | Height = 295 6 | Caption = 'Form1' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnShow = FormShow 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object WebBrowser1: TWebBrowser 18 | Left = 0 19 | Top = 39 20 | Width = 466 21 | Height = 222 22 | Align = alBottom 23 | TabOrder = 0 24 | OnDocumentComplete = WebBrowser1DocumentComplete 25 | ControlData = { 26 | 4C0000002A300000F21600000000000000000000000000000000000000000000 27 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 28 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 29 | 8000000000000000000000000000000000000000000000000000000000000000 30 | 00000000000000000100000000000000000000000000000000000000} 31 | end 32 | object ComboBox1: TComboBox 33 | Left = 8 34 | Top = 8 35 | Width = 241 36 | Height = 21 37 | Style = csDropDownList 38 | ItemHeight = 13 39 | TabOrder = 1 40 | OnChange = ComboBox1Change 41 | end 42 | end 43 | -------------------------------------------------------------------------------- /article-21/CaseStudy/FmDemo.pas: -------------------------------------------------------------------------------- 1 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 2 | {$WARNINGS ON} 3 | 4 | unit FmDemo; 5 | 6 | interface 7 | 8 | uses 9 | SHDocVw, Controls, StdCtrls, Classes, OleCtrls, Forms; 10 | 11 | type 12 | TForm1 = class(TForm) 13 | WebBrowser1: TWebBrowser; 14 | ComboBox1: TComboBox; 15 | procedure FormShow(Sender: TObject); 16 | procedure WebBrowser1DocumentComplete(Sender: TObject; 17 | const pDisp: IDispatch; var URL: OleVariant); 18 | procedure ComboBox1Change(Sender: TObject); 19 | end; 20 | 21 | var 22 | Form1: TForm1; 23 | 24 | implementation 25 | 26 | uses 27 | SysUtils, Dialogs, MSHTML; 28 | 29 | {$R *.dfm} 30 | 31 | procedure TForm1.ComboBox1Change(Sender: TObject); 32 | { Make browser use selected font } 33 | var 34 | Doc: IHTMLDocument2; // current HTML document 35 | HTMLWindow: IHTMLWindow2; // parent window of current HTML document 36 | JSFn: string; // stores JavaScipt function call 37 | begin 38 | // Get reference to current document 39 | Doc := WebBrowser1.Document as IHTMLDocument2; 40 | if not Assigned(Doc) then 41 | Exit; 42 | // Get parent window of current document 43 | HTMLWindow := Doc.parentWindow; 44 | if not Assigned(HTMLWindow) then 45 | Exit; 46 | // Run JavaScript 47 | try 48 | JSFn := 'SetFont(''' + ComboBox1.Text + ''')'; 49 | HTMLWindow.execScript(JSFn, 'JavaScript'); 50 | except 51 | // handle exception in case JavaScript fails to run 52 | ShowMessage('Error running JavaScript'); 53 | end; 54 | end; 55 | 56 | procedure TForm1.FormShow(Sender: TObject); 57 | { Setup combo box and load document } 58 | begin 59 | // Store screen fonts in combo box and disabled it 60 | ComboBox1.Items.Assign(Screen.Fonts); 61 | ComboBox1.Enabled := False; 62 | // Load the HTML page 63 | WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + 'Test.html'); 64 | end; 65 | 66 | procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; 67 | const pDisp: IDispatch; var URL: OleVariant); 68 | { Document loaded: enable combo box } 69 | begin 70 | ComboBox1.Enabled := True; 71 | end; 72 | 73 | end. 74 | 75 | -------------------------------------------------------------------------------- /article-21/CaseStudy/Test.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | ExecScript example 4 | 11 | 12 | 13 |

Test Document

14 |

Select a font above to change the font displayed in this document

15 | 16 | -------------------------------------------------------------------------------- /article-21/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 21 demo code 2 | 3 | There are two demo projects, each written by different authors, under different terms. 4 | 5 | * The code in the `CaseStudy` folder is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 6 | 7 | * The code in the `ReturnValue` folder is copyright (c) 2009, Christian Sciberras. _You are free to use the source code in any way you wish at your own risk. Credits would be appreciated but are not required._ 8 | -------------------------------------------------------------------------------- /article-21/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 21 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to call JavaScript functions in a TWebBrowser from Delphi](https://delphidabbler.com/articles/article-21)". 4 | 5 | The demo was not originally developed under version control. The date of the last update before adding to version control was probably in 2005. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 14 June 2022. 6 | 7 | ## About the Demo 8 | 9 | Two demos are included in separate sub-directories. They are 10 | 11 | ### `CaseStudy` directory 12 | 13 | This directory contains an implementation by Peter Johnson (DelphiDabbler) of the article's case study. The files are: 14 | 15 | * `Article21.dpr` - project file for demo program 16 | * `Article21.res` - icon etc for demo program 17 | * `FmDemo.pas/.dfm` - demo program's main form containing all Pascal code 18 | * `Test.html` - HTML document displayed in _TWebBrowser_ control 19 | 20 | To use the demo start Delphi and load `Article21.dpr`. Compile the program and run it. 21 | 22 | `Test.html` is displayed in the browser control. Select a font from the combo box and the browser will use that font to display `Test.html`. 23 | 24 | Once the program has been tested, examine the code in `FmDemo.pas`. 25 | 26 | ### `ReturnValue` directory 27 | 28 | This directory contains a demo by Christian Sciberras showing how to capture return values from JavaScript functions. The files are: 29 | 30 | * `Demo.dpr` - project file for demo program 31 | * `Demo.res` - icon etc for demo program 32 | * `Unit1.pas/.dfm` - demo program's main for containing all Pascal code 33 | * `test.htm` - HTML document displayed in _TWebBrowser_ control 34 | 35 | To use the demo start Delphi and load `Demo.dpr`. Compile the program and run it. 36 | 37 | `test.htm` is displayed in the browser control. Follow the instructions on screen. 38 | 39 | Once the program has been tested, examine the Pascal code in `Unit1.pas` and the 40 | JavaScript in `test.htm`. 41 | 42 | ## Bug Reports 43 | 44 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 45 | -------------------------------------------------------------------------------- /article-21/ReturnValue/Demo.dpr: -------------------------------------------------------------------------------- 1 | program Demo; 2 | 3 | uses 4 | Forms, 5 | Unit1 in 'Unit1.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /article-21/ReturnValue/Demo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-21/ReturnValue/Demo.res -------------------------------------------------------------------------------- /article-21/ReturnValue/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 192 3 | Top = 122 4 | Width = 569 5 | Height = 501 6 | Caption = 'JS Web Demo, (C) Covac Research / Christian Sciberras' 7 | Color = 16758590 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poScreenCenter 15 | OnCreate = FormCreate 16 | DesignSize = ( 17 | 553 18 | 465) 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object Shape4: TShape 22 | Left = 8 23 | Top = 8 24 | Width = 537 25 | Height = 265 26 | Anchors = [akLeft, akTop, akRight, akBottom] 27 | end 28 | object Shape7: TShape 29 | Left = 8 30 | Top = 280 31 | Width = 537 32 | Height = 177 33 | Anchors = [akLeft, akRight, akBottom] 34 | end 35 | object Label1: TLabel 36 | Left = 16 37 | Top = 290 38 | Width = 54 39 | Height = 13 40 | Anchors = [akLeft, akBottom] 41 | Caption = 'Expression:' 42 | Transparent = True 43 | end 44 | object Edit1: TEdit 45 | Left = 80 46 | Top = 286 47 | Width = 377 48 | Height = 21 49 | Anchors = [akLeft, akRight, akBottom] 50 | TabOrder = 0 51 | Text = '500+23/4' 52 | end 53 | object Button3: TButton 54 | Left = 464 55 | Top = 284 56 | Width = 73 57 | Height = 25 58 | Anchors = [akRight, akBottom] 59 | Caption = 'Eval it!' 60 | TabOrder = 1 61 | OnClick = Button3Click 62 | end 63 | object Panel1: TPanel 64 | Left = 16 65 | Top = 16 66 | Width = 521 67 | Height = 249 68 | Anchors = [akLeft, akTop, akRight, akBottom] 69 | BevelOuter = bvNone 70 | BorderStyle = bsSingle 71 | Caption = 'Panel1' 72 | Ctl3D = False 73 | ParentCtl3D = False 74 | TabOrder = 2 75 | object WebBrowser1: TWebBrowser 76 | Left = 0 77 | Top = 0 78 | Width = 519 79 | Height = 247 80 | Align = alClient 81 | TabOrder = 0 82 | ControlData = { 83 | 4C000000A4350000871900000100000001020000000000000000000000000000 84 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 85 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 86 | 8000000000000000000000000000000000000000000000000000000000000000 87 | 00000000000000000100000000000000000000000000000000000000} 88 | end 89 | end 90 | object RichEdit1: TRichEdit 91 | Left = 16 92 | Top = 312 93 | Width = 521 94 | Height = 137 95 | Anchors = [akLeft, akRight, akBottom] 96 | BorderStyle = bsNone 97 | Color = clGray 98 | Font.Charset = ANSI_CHARSET 99 | Font.Color = clWindowText 100 | Font.Height = -13 101 | Font.Name = 'Lucida Console' 102 | Font.Style = [] 103 | ParentFont = False 104 | ReadOnly = True 105 | ScrollBars = ssBoth 106 | TabOrder = 3 107 | WordWrap = False 108 | end 109 | end 110 | -------------------------------------------------------------------------------- /article-21/ReturnValue/test.htm: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | 12 | 13 | Type something here: 14 |
15 |

16 | 17 | To get the above text, type the following code in the below text box: 18 | 19 | 22 | 23 | -------------------------------------------------------------------------------- /article-22/Article22.dat: -------------------------------------------------------------------------------- 1 | codesnip=Offline viewer for routines from CodeSnip database. Displays source of each unit and can test compile with any supported installed version of Delphi and Free Pascal. 2 | htmlres=Compiles HTML and associated files into RT_HTML resources in 32 bit resource files suitable for use with Internet Explorer's res:// protocol or with TWebBrowser. 3 | unit2ns=Maintains one or more 'mappings' of Delphi Pascal units to the namespaces to which they may belong. Copies the fully qualified namespace / unit name to the clipboard for pasting into Pascal code. 4 | bdiff=BDiff computes differences between two binary files and outputs either a human readable file of a binary patch file. BPatch uses the binary patch files produced by BDiff to patch files. 5 | -------------------------------------------------------------------------------- /article-22/Article22.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | https://delphidabbler.com/articles/article-22 5 | 6 | This is the main project file. 7 | 8 | MIT License: see LICENSE.md 9 | } 10 | 11 | 12 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 13 | 14 | 15 | program Article22; 16 | 17 | 18 | uses 19 | Forms, 20 | Article22_TLB in 'Article22_TLB.pas', 21 | FmDemo in 'FmDemo.pas' {Form1}, 22 | UExternalContainer in 'UExternalContainer.pas', 23 | UMyExternal in 'UMyExternal.pas', 24 | IntfDocHostUIHandler in 'IntfDocHostUIHandler.pas', 25 | UNulContainer in 'UNulContainer.pas'; 26 | 27 | {$R *.tlb} 28 | {$R *.res} 29 | 30 | begin 31 | Application.Initialize; 32 | Application.CreateForm(TForm1, Form1); 33 | Application.Run; 34 | end. 35 | -------------------------------------------------------------------------------- /article-22/Article22.html: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 10 | 11 | DelphiDabbler Articles 12 | 17 | 26 | 27 | 28 |

DelphiDabbler Program Descriptions

29 | 55 |
56 | Click a program name to see its description here. 57 |
58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /article-22/Article22.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-22/Article22.res -------------------------------------------------------------------------------- /article-22/Article22.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-22/Article22.tlb -------------------------------------------------------------------------------- /article-22/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Article #22 Demo Changelog 2 | 3 | ## v1.1.1 of 2022/06/12 4 | 5 | * Changed example DelphiDabbler programs displayed in the demo HTML file. 6 | * Minor changes to modernise the demo HTML file 7 | * Corrected program URLs dislayed in main form. 8 | * Updated README.md and ReadMe.html re changes. 9 | 10 | ## v1.1 of 2006/02/01 11 | 12 | * Renamed `IntfUIHandlers.pas` as `IntfDocHostUIHandler.pas` 13 | * Rewrote `IntfDocHostUIHandler.pas` and `UNulContainer.pas` based on units of the same name in the article "[How to call Delphi code from scripts running in a TWebBrowser](https://delphidabbler.com/articles/article-22)" 14 | * Modified other code to use the renamed and rewritten units. 15 | 16 | ## v1.0 of 2005/05/09 17 | 18 | * Original version 19 | -------------------------------------------------------------------------------- /article-22/FmDemo.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-22/FmDemo.dfm -------------------------------------------------------------------------------- /article-22/FmDemo.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | https://delphidabbler.com/articles/article-22 5 | 6 | This unit defines the main form class. 7 | 8 | MIT License: see LICENSE.md 9 | } 10 | 11 | 12 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 13 | 14 | 15 | unit FmDemo; 16 | 17 | interface 18 | 19 | uses 20 | SysUtils, OleCtrls, SHDocVw, Classes, Controls, ComCtrls, Forms, 21 | UExternalContainer; 22 | 23 | type 24 | TForm1 = class(TForm) 25 | StatusBar1: TStatusBar; 26 | WebBrowser1: TWebBrowser; 27 | procedure FormShow(Sender: TObject); 28 | procedure FormHide(Sender: TObject); 29 | private 30 | fContainer: TExternalContainer; 31 | end; 32 | 33 | var 34 | Form1: TForm1; 35 | 36 | implementation 37 | 38 | 39 | {$R *.dfm} 40 | 41 | procedure TForm1.FormShow(Sender: TObject); 42 | begin 43 | fContainer := TExternalContainer.Create(WebBrowser1); 44 | WebBrowser1.Navigate( 45 | ExtractFilePath(ParamStr(0)) + 'Article22.html' 46 | ); 47 | end; 48 | 49 | procedure TForm1.FormHide(Sender: TObject); 50 | begin 51 | fContainer.Free; 52 | end; 53 | 54 | end. 55 | -------------------------------------------------------------------------------- /article-22/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 22 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-22/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 22 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to call Delphi code from scripts running in a TWebBrowser](https://delphidabbler.com/articles/article-22)". 4 | 5 | The demo was not originally developed under version control. It's last update before being placed under version control was on 1 February 2006. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 24 April 2022. See [CHANGELOG.md](./CHANGELOG.md) for details of known updates. 6 | 7 | ## About the Demo 8 | 9 | The demo includes the following files: 10 | 11 | * `Article22.dat` – data file used by demo program. 12 | * `Article22.dpr` – project file for demo program. 13 | * `Article22.html` – HTML document displayed in _TWebBrowser_ control. 14 | * `Article22.res` – icon etc for demo program. 15 | * `Article22.tlb` – type library used to define external object interface. 16 | * `Article22_TLB.pas` – file generated by type library editor. 17 | * `FmDemo.pas/.dfm` – demo program's main form. 18 | * `IntfDocHostUIHandler.pas` – defines _IDocHostUIHandler_ interface and associated structures. 19 | * `UExternalContainer.pas` – defines _IDocHostUIHandler_ and _IOleClientSite_ implementation that provides external object to _TWebBrowser_. 20 | * `UMyExternal.pas` – implementation of external object. 21 | * `UNulContainer.pas` – defines do nothing implementation of _IDocHostUIHandler_ and _IOleClientSite_ and registers client site with _TWebBrowser_. 22 | 23 | To use the demo start Delphi and load `Article22.dpr`. Compile the program and run it. `Article22.html` is displayed in the browser control. Click on one of the program names displayed in the list and its name and precis will appear in the bordered box at the bottom of the display. 24 | 25 | Once the program has been tested, examine the code in the various units. 26 | 27 | The code has been tested on Windows 11 with Delphi XE and Delphi 11.0 Alexandria. When compiled with Delphi 11.0, both 32 bit and 64 bit targets have been tested to compile and run correctly. 28 | 29 | It is probable, but not guaranteed, that the code will work with compilers back to Delphi 7, but this has not been tested. 30 | 31 | > **Note:** Some versions of Delphi (for example Delphi XE) will complain when opening `Article22.dpr` about the project being in Delphi 2007 format and will offer to back up the project file. Just accept this suggestion and everything should compile properly. 32 | 33 | ## Bug Reports 34 | 35 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 36 | 37 | > **Note:** Any bug that relates to compilation with a compiler earlier than Delphi XE will not be fixed, unless you can provide such a fix. 38 | -------------------------------------------------------------------------------- /article-22/UExternalContainer.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | https://delphidabbler.com/articles/article-22 5 | 6 | This unit defines the IDocHostUIHandler implementation that provides the 7 | external object to the TWebBrowser. 8 | 9 | MIT License: see LICENSE.md 10 | } 11 | 12 | 13 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 14 | 15 | 16 | unit UExternalContainer; 17 | 18 | interface 19 | 20 | uses 21 | // Delphi 22 | ActiveX, SHDocVw, 23 | // Project 24 | IntfDocHostUIHandler, UNulContainer, UMyExternal; 25 | 26 | type 27 | 28 | { 29 | TExternalContainer: 30 | UI handler that extends browser's external object. 31 | } 32 | TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite) 33 | private 34 | fExternalObj: IDispatch; // external object implementation 35 | protected 36 | { Re-implemented IDocHostUIHandler method } 37 | function GetExternal(out ppDispatch: IDispatch): HResult; stdcall; 38 | public 39 | constructor Create(const HostedBrowser: TWebBrowser); 40 | end; 41 | 42 | 43 | implementation 44 | 45 | 46 | { TExternalContainer } 47 | 48 | constructor TExternalContainer.Create(const HostedBrowser: TWebBrowser); 49 | begin 50 | inherited; 51 | fExternalObj := TMyExternal.Create; 52 | end; 53 | 54 | function TExternalContainer.GetExternal(out ppDispatch: IDispatch): HResult; 55 | begin 56 | ppDispatch := fExternalObj; 57 | Result := S_OK; // indicates we've provided script 58 | end; 59 | 60 | end. 61 | 62 | -------------------------------------------------------------------------------- /article-22/UMyExternal.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to call Delphi code from scripts running in a TWebBrowser" at 4 | https://delphidabbler.com/articles/article-22 5 | 6 | This unit defines a class that extends the TWebBrowser's external object. 7 | 8 | MIT License: see LICENSE.md 9 | } 10 | 11 | 12 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 13 | {$WARN UNSAFE_TYPE OFF} 14 | 15 | 16 | unit UMyExternal; 17 | 18 | interface 19 | 20 | uses 21 | Classes, ComObj, Article22_TLB; 22 | 23 | type 24 | 25 | TMyExternal = class(TAutoIntfObject, IMyExternal, IDispatch) 26 | private 27 | fData: TStringList; // info from data file 28 | procedure ShowSBMsg(const Msg: string); // helper method 29 | protected 30 | { IMyExternal methods } 31 | function GetPrecis(const ProgID: WideString): WideString; 32 | safecall; 33 | procedure ShowURL(const ProgID: WideString); safecall; 34 | procedure HideURL; safecall; 35 | public 36 | constructor Create; 37 | destructor Destroy; override; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | SysUtils, ActiveX, StdActns; 44 | 45 | { TMyExternal } 46 | 47 | constructor TMyExternal.Create; 48 | var 49 | TypeLib: ITypeLib; // type library information 50 | ExeName: WideString; // name of our program's exe file 51 | begin 52 | // Get name of application 53 | ExeName := ParamStr(0); 54 | // Load type library from application's resources 55 | OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib)); 56 | // Call inherited constructor 57 | inherited Create(TypeLib, IMyExternal); 58 | // Create and load string list from file 59 | fData := TStringList.Create; 60 | fData.LoadFromFile(ChangeFileExt(ExeName, '.dat')); 61 | end; 62 | 63 | destructor TMyExternal.Destroy; 64 | begin 65 | fData.Free; 66 | inherited; 67 | end; 68 | 69 | function TMyExternal.GetPrecis(const ProgID: WideString): WideString; 70 | begin 71 | Result := fData.Values[ProgId]; 72 | end; 73 | 74 | procedure TMyExternal.HideURL; 75 | begin 76 | ShowSBMsg(''); 77 | end; 78 | 79 | procedure TMyExternal.ShowSBMsg(const Msg: string); 80 | var 81 | HintAct: THintAction; 82 | begin 83 | HintAct := THintAction.Create(nil); 84 | try 85 | HintAct.Hint := Msg; 86 | HintAct.Execute; 87 | finally 88 | HintAct.Free; 89 | end; 90 | end; 91 | 92 | procedure TMyExternal.ShowURL(const ProgID: WideString); 93 | begin 94 | ShowSBMsg( 95 | 'https://delphidabbler.com/software/' + ProgID 96 | ); 97 | end; 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /article-23/Article23.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to get operating system version information" at 4 | https://delphidabbler.com/articles/article-23. 5 | } 6 | 7 | 8 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 9 | 10 | 11 | program Article23; 12 | 13 | uses 14 | Forms, 15 | FmDemo in 'FmDemo.pas' {Form1}, 16 | UOSInfo in 'UOSInfo.pas'; 17 | 18 | {$R *.res} 19 | 20 | begin 21 | Application.Initialize; 22 | Application.Title := 'Article 23 Demo'; 23 | Application.CreateForm(TForm1, Form1); 24 | Application.Run; 25 | end. 26 | -------------------------------------------------------------------------------- /article-23/Article23.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-23/Article23.res -------------------------------------------------------------------------------- /article-23/FmDemo.dfm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-23/FmDemo.dfm -------------------------------------------------------------------------------- /article-23/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 23 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-23/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 23 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to get operating system version information](https://delphidabbler.com/articles/article-23)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 19 February 2006. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 24 April 2022. 6 | 7 | ## About the Demo 8 | 9 | The demo includes the following files: 10 | 11 | * `Article23.dpr` – project file for demo program. 12 | * `Article23.res` – icon etc for demo program. 13 | * `FmDemo.pas/.dfm` – demo program's main form. 14 | * `UOSInfo.pas` – code developed in article. 15 | 16 | To use the demo start Delphi and load `Article23.dpr`. Compile the program and run it. The results of all the public methods of the _TOSInfo_ static class are displayed along with the values of the _Win32XXX_ variables defined by Delphi and in `UOSInfo.pas`. 17 | 18 | Once the program has been tested, examine the code in the various units. 19 | 20 | The code was originally developed using Delphi 7. It should compile with Delphi 4 and later. 21 | 22 | ## Bug Reports 23 | 24 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 25 | -------------------------------------------------------------------------------- /article-24/Article24.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = Article24Eg1.exe Article24Eg2.exe 13 | #------------------------------------------------------------------------------ 14 | default: $(PROJECTS) 15 | #------------------------------------------------------------------------------ 16 | 17 | Article24Eg1.exe: Eg1\Article24Eg1.dpr 18 | $(DCC) 19 | 20 | Article24Eg2.exe: Eg2\Article24Eg2.dpr 21 | $(DCC) 22 | 23 | 24 | -------------------------------------------------------------------------------- /article-24/Eg1/Article24Eg1.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to receive data dragged from other applications" at 4 | https://delphidabbler.com/articles/article-24. 5 | 6 | This is the main project file of example program 1. 7 | } 8 | 9 | 10 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 11 | 12 | 13 | program Article24Eg1; 14 | 15 | uses 16 | Forms, 17 | FmEg1 in 'FmEg1.pas' {Form1}, 18 | UHelper in 'UHelper.pas'; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TForm1, Form1); 25 | Application.Run; 26 | end. 27 | -------------------------------------------------------------------------------- /article-24/Eg1/Article24Eg1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-24/Eg1/Article24Eg1.res -------------------------------------------------------------------------------- /article-24/Eg1/FmEg1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 211 3 | Top = 114 4 | Width = 468 5 | Height = 347 6 | Caption = 'DelphiDabbler.com: Article#24, Example 1' 7 | Color = clBtnFace 8 | Constraints.MinHeight = 200 9 | Constraints.MinWidth = 468 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'MS Sans Serif' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | DesignSize = ( 19 | 460 20 | 313) 21 | PixelsPerInch = 96 22 | TextHeight = 13 23 | object lblDesc: TLabel 24 | Left = 8 25 | Top = 8 26 | Width = 305 27 | Height = 13 28 | Caption = 'Drag and drop any object over this form to see supported formats' 29 | end 30 | object lvDisplay: TListView 31 | Left = 8 32 | Top = 32 33 | Width = 444 34 | Height = 273 35 | Anchors = [akLeft, akTop, akRight, akBottom] 36 | Columns = < 37 | item 38 | Caption = 'Format' 39 | Width = 130 40 | end 41 | item 42 | Caption = 'Storage Medium' 43 | Width = 120 44 | end 45 | item 46 | Caption = 'Aspect' 47 | Width = 140 48 | end 49 | item 50 | Caption = 'lindex' 51 | end> 52 | ReadOnly = True 53 | RowSelect = True 54 | TabOrder = 0 55 | ViewStyle = vsReport 56 | end 57 | end 58 | -------------------------------------------------------------------------------- /article-24/Eg1/FmEg1.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to receive data dragged from other applications" at 4 | https://delphidabbler.com/articles/article-24. 5 | 6 | This unit defines the main form class of example program 1. 7 | } 8 | 9 | 10 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 11 | 12 | 13 | unit FmEg1; 14 | 15 | interface 16 | 17 | uses 18 | ActiveX, Controls, ComCtrls, Classes, StdCtrls, Forms, Windows; 19 | 20 | type 21 | TForm1 = class(TForm, IDropTarget) 22 | lblDesc: TLabel; 23 | lvDisplay: TListView; 24 | procedure FormCreate(Sender: TObject); 25 | procedure FormDestroy(Sender: TObject); 26 | private 27 | procedure DisplayDataInfo(const FmtEtc: TFormatEtc); 28 | protected 29 | { IDropTarget methods } 30 | function IDropTarget.DragEnter = DropTargetDragEnter; 31 | function DropTargetDragEnter(const dataObj: IDataObject; 32 | grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; 33 | stdcall; 34 | function IDropTarget.DragOver = DropTargetDragOver; 35 | function DropTargetDragOver(grfKeyState: Longint; pt: TPoint; 36 | var dwEffect: Longint): HResult; 37 | stdcall; 38 | function IDropTarget.DragLeave = DropTargetDragLeave; 39 | function DropTargetDragLeave: HResult; 40 | stdcall; 41 | function IDropTarget.Drop = DropTargetDrop; 42 | function DropTargetDrop(const dataObj: IDataObject; grfKeyState: 43 | Longint; pt: TPoint; var dwEffect: Longint): HResult; 44 | stdcall; 45 | public 46 | end; 47 | 48 | var 49 | Form1: TForm1; 50 | 51 | implementation 52 | 53 | uses 54 | SysUtils, ComObj, 55 | UHelper; 56 | 57 | {$R *.dfm} 58 | 59 | { TForm1 } 60 | 61 | procedure TForm1.DisplayDataInfo(const FmtEtc: TFormatEtc); 62 | var 63 | LI: TListItem; 64 | begin 65 | LI := lvDisplay.Items.Add; 66 | LI.Caption := CBFormatDesc(FmtEtc.cfFormat); 67 | LI.SubItems.Add(TymedDesc(FmtEtc.tymed)); 68 | LI.SubItems.Add(AspectDesc(FmtEtc.dwAspect)); 69 | LI.SubItems.Add(IntToStr(FmtEtc.lindex)); 70 | end; 71 | 72 | function TForm1.DropTargetDragEnter(const dataObj: IDataObject; 73 | grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 74 | begin 75 | dwEffect := DROPEFFECT_COPY; 76 | Result := S_OK; 77 | end; 78 | 79 | function TForm1.DropTargetDragLeave: HResult; 80 | begin 81 | Result := S_OK; 82 | end; 83 | 84 | function TForm1.DropTargetDragOver(grfKeyState: Integer; pt: TPoint; 85 | var dwEffect: Integer): HResult; 86 | begin 87 | dwEffect := DROPEFFECT_COPY; 88 | Result := S_OK; 89 | end; 90 | 91 | function TForm1.DropTargetDrop(const dataObj: IDataObject; 92 | grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 93 | var 94 | Enum: IEnumFormatEtc; 95 | FormatEtc: TFormatEtc; 96 | begin 97 | dwEffect := DROPEFFECT_COPY; 98 | OleCheck(DataObj.EnumFormatEtc(DATADIR_GET, Enum)); 99 | lvDisplay.Clear; 100 | while Enum.Next(1, FormatEtc, nil) = S_OK do 101 | DisplayDataInfo(FormatEtc); 102 | Result := S_OK; 103 | end; 104 | 105 | procedure TForm1.FormCreate(Sender: TObject); 106 | begin 107 | OleInitialize(nil); 108 | OleCheck(RegisterDragDrop(Handle, Self)); 109 | end; 110 | 111 | procedure TForm1.FormDestroy(Sender: TObject); 112 | begin 113 | RevokeDragDrop(Handle); 114 | OleUninitialize; 115 | end; 116 | 117 | end. 118 | -------------------------------------------------------------------------------- /article-24/Eg1/UHelper.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to receive data dragged from other applications" at 4 | https://delphidabbler.com/articles/article-24. 5 | 6 | This unit defines some utility functions used by example program 1. 7 | } 8 | 9 | 10 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 11 | 12 | 13 | unit UHelper; 14 | 15 | interface 16 | 17 | uses 18 | ActiveX; 19 | 20 | function CBFormatDesc(const Fmt: TClipFormat): string; 21 | 22 | function TymedDesc(const Tymed: Integer): string; 23 | 24 | function AspectDesc(const Aspect: Integer): string; 25 | 26 | implementation 27 | 28 | uses 29 | Windows; 30 | 31 | type 32 | TCodeDescMap = record 33 | Code: Integer; 34 | Desc: string; 35 | end; 36 | 37 | function CodeToDesc(const Code: Integer; 38 | const Map: array of TCodeDescMap): string; 39 | var 40 | Idx: Integer; 41 | begin 42 | Result := ''; 43 | for Idx := Low(Map) to High(Map) do 44 | begin 45 | if Map[Idx].Code = Code then 46 | begin 47 | Result := Map[Idx].Desc; 48 | Break; 49 | end; 50 | end; 51 | end; 52 | 53 | function CBFormatDesc(const Fmt: TClipFormat): string; 54 | const 55 | cStdFmts: array[0..20] of TCodeDescMap = ( 56 | (Code: CF_LOCALE; Desc: 'CF_LOCALE'), 57 | (Code: CF_UNICODETEXT; Desc: 'CF_UNICODETEXT'), 58 | (Code: CF_ENHMETAFILE; Desc: 'CF_ENHMETAFILE'), 59 | (Code: CF_HDROP; Desc: 'CF_HDROP'), 60 | (Code: CF_OWNERDISPLAY; Desc: 'CF_OWNERDISPLAY'), 61 | (Code: CF_BITMAP; Desc: 'CF_BITMAP'), 62 | (Code: CF_DIB; Desc: 'CF_DIB'), 63 | (Code: CF_DIF; Desc: 'CF_DIF'), 64 | (Code: CF_DSPBITMAP; Desc: 'CF_DSPBITMAP'), 65 | (Code: CF_DSPMETAFILEPICT; Desc: 'CF_DSPMETAFILEPICT'), 66 | (Code: CF_DSPTEXT; Desc: 'CF_DSPMETAFILEPICT'), 67 | (Code: CF_METAFILEPICT; Desc: 'CF_DSPMETAFILEPICT'), 68 | (Code: CF_OEMTEXT; Desc: 'CF_OEMTEXT'), 69 | (Code: CF_OWNERDISPLAY; Desc: 'CF_OWNERDISPLAY'), 70 | (Code: CF_PALETTE; Desc: 'CF_PALETTE'), 71 | (Code: CF_PENDATA; Desc: 'CF_PENDATA'), 72 | (Code: CF_RIFF; Desc: 'CF_RIFF'), 73 | (Code: CF_SYLK; Desc: 'CF_SYLK'), 74 | (Code: CF_TEXT; Desc: 'CF_TEXT'), 75 | (Code: CF_TIFF; Desc: 'CF_TIFF'), 76 | (Code: CF_WAVE; Desc: 'CF_WAVE') 77 | ); 78 | var 79 | Buffer: array[0..255] of Char; 80 | begin 81 | Result := CodeToDesc(Fmt, cStdFmts); 82 | if Result = '' then 83 | begin 84 | // Not a standard format - we assume it's a registered format - get name 85 | // from Windows API call (this call doesn't work for standard formats) 86 | if GetClipBoardFormatName(Fmt, Buffer, 255) > 0 then 87 | // Got a name - record it 88 | Result := Buffer; 89 | end; 90 | end; 91 | 92 | function TymedDesc(const Tymed: Integer): string; 93 | const 94 | cTymeds: array[0..7] of TCodeDescMap = ( 95 | (Code: TYMED_HGLOBAL; Desc: 'TYMED_HGLOBAL'), 96 | (Code: TYMED_FILE; Desc: 'TYMED_FILE'), 97 | (Code: TYMED_ISTREAM; Desc: 'TYMED_ISTREAM'), 98 | (Code: TYMED_ISTORAGE; Desc: 'TYMED_ISTORAGE'), 99 | (Code: TYMED_GDI; Desc: 'TYMED_GDI'), 100 | (Code: TYMED_MFPICT; Desc: 'TYMED_MFPICT'), 101 | (Code: TYMED_ENHMF; Desc: 'TYMED_ENHMF'), 102 | (Code: TYMED_NULL; Desc: 'TYMED_NULL') 103 | ); 104 | begin 105 | Result := CodeToDesc(Tymed, cTymeds); 106 | end; 107 | 108 | function AspectDesc(const Aspect: Integer): string; 109 | const 110 | cAspects: array[0..3] of TCodeDescMap = ( 111 | (Code: DVASPECT_CONTENT; Desc: 'DVASPECT_CONTENT'), 112 | (Code: DVASPECT_THUMBNAIL; Desc: 'DVASPECT_THUMBNAIL'), 113 | (Code: DVASPECT_ICON; Desc: 'DVASPECT_ICON'), 114 | (Code: DVASPECT_DOCPRINT; Desc: 'DVASPECT_DOCPRINT') 115 | ); 116 | begin 117 | Result := CodeToDesc(Aspect, cAspects); 118 | end; 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /article-24/Eg2/Article24Eg2.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to receive data dragged from other applications" at 4 | https://delphidabbler.com/articles/article-24. 5 | 6 | This is the main project file of example program 2. 7 | } 8 | 9 | 10 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 11 | 12 | 13 | program Article24Eg2; 14 | 15 | uses 16 | Forms, 17 | FmEg2 in 'FmEg2.pas' {Form1}; 18 | 19 | {$R *.res} 20 | 21 | begin 22 | Application.Initialize; 23 | Application.CreateForm(TForm1, Form1); 24 | Application.Run; 25 | end. 26 | -------------------------------------------------------------------------------- /article-24/Eg2/Article24Eg2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-24/Eg2/Article24Eg2.res -------------------------------------------------------------------------------- /article-24/Eg2/FmEg2.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 211 3 | Top = 114 4 | Width = 465 5 | Height = 467 6 | Caption = 'DelphiDabbler.com: Article#24, Example 2' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | DesignSize = ( 17 | 457 18 | 433) 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object lblText: TLabel 22 | Left = 8 23 | Top = 8 24 | Width = 31 25 | Height = 13 26 | Caption = 'lblText' 27 | end 28 | object lblHTML: TLabel 29 | Left = 8 30 | Top = 224 31 | Width = 40 32 | Height = 13 33 | Caption = 'lblHTML' 34 | end 35 | object edText: TMemo 36 | Left = 8 37 | Top = 24 38 | Width = 441 39 | Height = 185 40 | Anchors = [akLeft, akTop, akRight] 41 | TabOrder = 0 42 | end 43 | object edHTML: TMemo 44 | Left = 8 45 | Top = 240 46 | Width = 441 47 | Height = 185 48 | Anchors = [akLeft, akTop, akRight, akBottom] 49 | TabOrder = 1 50 | end 51 | end 52 | -------------------------------------------------------------------------------- /article-24/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 24 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-24/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 24 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to receive data dragged from other applications](https://delphidabbler.com/articles/article-24)". 4 | 5 | The demo was not originally developed under version control. It's last update was on 10 Dec 2006: this is probably the only version released. The code was added to the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository on 24 April 2022. 6 | 7 | ## About the Demo 8 | 9 | Two example programs are provided. They can be found in subdirectories `Eg1` and `Eg2`. Available files are: 10 | 11 | * `Article24.bpg` – project group file that references both example projects. 12 | * `Eg1\Article24Eg1.dpr` – project file for first example demo program. 13 | * `Eg1\Article24Eg1.res` – icon etc for first example demo program. 14 | * `Eg1\FmEg1.pas/.dfm` – main form for first example demo program. 15 | * `Eg1\UHelper.pas` – helper functions for first example demo program. 16 | * `Eg2\Article24Eg2.dpr` – project file for second example demo program. 17 | * `Eg2\Article24Eg2.res` – icon etc for second example demo program. 18 | * `Eg2\FmEg2.pas/.dfm` – main form for second example demo program. 19 | 20 | To compile the demos start Delphi and load `Article24.bpg`. Build all the projects. 21 | 22 | The code was developed and tested using Delphi 7. 23 | 24 | ### Example 1 25 | 26 | Drag any object from a _drag-drop enabled_ application and drop it on the program's main window. All the data formats supported by the data object will be listed in the display. 27 | 28 | ## Example 2 29 | 30 | The program accepts plain text and HTML dragged and dropped from other applications. Select some text or HTML from a _drag-drop enabled_ application, drag the selection over the program's main window and drop it. Any data object that does not support one of the two supported formats will cause the no-entry cursor to be displayed and dropping will be inhibited. 31 | 32 | Plain text is displayed in the upper text box and HTML (if present) in the lower text box, as source code. 33 | 34 | Pressing _Shift_ while dragging will change the copy cursor to a move cursor if the source application permits moving. Dropping will then delete the text from the host application. 35 | 36 | > **Warning:** Don't try the Move operation with important data since the source text could be lost. 37 | 38 | ## Bug Reports 39 | 40 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 41 | -------------------------------------------------------------------------------- /article-25/1/Article25Demo1.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main project file of example program 1. 7 | } 8 | 9 | 10 | {$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} 11 | 12 | 13 | program Article25Demo1; 14 | 15 | uses 16 | Forms, 17 | FmDemo1 in 'FmDemo1.pas' {DemoForm1}; 18 | 19 | {$R *.res} 20 | 21 | begin 22 | Application.Initialize; 23 | Application.CreateForm(TDemoForm1, DemoForm1); 24 | Application.Run; 25 | end. 26 | -------------------------------------------------------------------------------- /article-25/1/Article25Demo1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-25/1/Article25Demo1.res -------------------------------------------------------------------------------- /article-25/1/FmDemo1.dfm: -------------------------------------------------------------------------------- 1 | object DemoForm1: TDemoForm1 2 | Left = 211 3 | Top = 114 4 | Width = 483 5 | Height = 386 6 | Caption = 'Article#25 Demo 1' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object WebBrowser1: TWebBrowser 17 | Left = 0 18 | Top = 0 19 | Width = 475 20 | Height = 352 21 | Align = alClient 22 | TabOrder = 0 23 | ControlData = { 24 | 4C00000018310000612400000000000000000000000000000000000000000000 25 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 26 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 27 | 8000000000000000000000000000000000000000000000000000000000000000 28 | 00000000000000000100000000000000000000000000000000000000} 29 | end 30 | end 31 | -------------------------------------------------------------------------------- /article-25/1/FmDemo1.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main form file of example program 1. 7 | } 8 | 9 | 10 | unit FmDemo1; 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 16 | Dialogs, OleCtrls, SHDocVw; 17 | 18 | type 19 | TDemoForm1 = class(TForm) 20 | WebBrowser1: TWebBrowser; 21 | end; 22 | 23 | var 24 | DemoForm1: TDemoForm1; 25 | 26 | implementation 27 | 28 | {$R *.dfm} 29 | 30 | end. 31 | -------------------------------------------------------------------------------- /article-25/2/Article25Demo2.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main project file of example program 2. 7 | } 8 | 9 | 10 | program Article25Demo2; 11 | 12 | uses 13 | Forms, 14 | FmDemo2 in 'FmDemo2.pas' {DemoForm2}; 15 | 16 | {$R *.res} 17 | 18 | begin 19 | Application.Initialize; 20 | Application.CreateForm(TDemoForm2, DemoForm2); 21 | Application.Run; 22 | end. 23 | -------------------------------------------------------------------------------- /article-25/2/Article25Demo2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-25/2/Article25Demo2.res -------------------------------------------------------------------------------- /article-25/2/FmDemo2.dfm: -------------------------------------------------------------------------------- 1 | object DemoForm2: TDemoForm2 2 | Left = 211 3 | Top = 114 4 | Width = 483 5 | Height = 386 6 | Caption = 'Article#25 Demo 2' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object WebBrowser1: TWebBrowser 19 | Left = 0 20 | Top = 0 21 | Width = 475 22 | Height = 352 23 | Align = alClient 24 | TabOrder = 0 25 | ControlData = { 26 | 4C00000018310000612400000000000000000000000000000000000000000000 27 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 28 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 29 | 8000000000000000000000000000000000000000000000000000000000000000 30 | 00000000000000000100000000000000000000000000000000000000} 31 | end 32 | end 33 | -------------------------------------------------------------------------------- /article-25/2/FmDemo2.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main form file of example program 2. 7 | } 8 | 9 | 10 | unit FmDemo2; 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 16 | Dialogs, OleCtrls, SHDocVw; 17 | 18 | type 19 | TDemoForm2 = class(TForm) 20 | WebBrowser1: TWebBrowser; 21 | procedure FormCreate(Sender: TObject); 22 | procedure FormDestroy(Sender: TObject); 23 | end; 24 | 25 | var 26 | DemoForm2: TDemoForm2; 27 | 28 | implementation 29 | 30 | uses 31 | ActiveX; 32 | 33 | {$R *.dfm} 34 | 35 | procedure TDemoForm2.FormCreate(Sender: TObject); 36 | begin 37 | OleInitialize(nil); 38 | end; 39 | 40 | procedure TDemoForm2.FormDestroy(Sender: TObject); 41 | begin 42 | OleUninitialize; 43 | end; 44 | 45 | end. 46 | -------------------------------------------------------------------------------- /article-25/3/Article25Demo3.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main project file of example program 3. 7 | } 8 | 9 | 10 | program Article25Demo3; 11 | 12 | uses 13 | Forms, 14 | FmDemo3 in 'FmDemo3.pas' {DemoForm3}, 15 | UWBDragDropContainer in '..\Shared\UWBDragDropContainer.pas', 16 | IntfDocHostUIHandler in '..\Shared\IntfDocHostUIHandler.pas', 17 | UNulContainer in '..\Shared\UNulContainer.pas', 18 | UNulDropTarget in 'UNulDropTarget.pas'; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TDemoForm3, DemoForm3); 25 | Application.Run; 26 | end. 27 | -------------------------------------------------------------------------------- /article-25/3/Article25Demo3.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-25/3/Article25Demo3.res -------------------------------------------------------------------------------- /article-25/3/FmDemo3.dfm: -------------------------------------------------------------------------------- 1 | object DemoForm3: TDemoForm3 2 | Left = 211 3 | Top = 114 4 | Width = 483 5 | Height = 386 6 | Caption = 'Article#25 Demo 3' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object WebBrowser1: TWebBrowser 19 | Left = 0 20 | Top = 0 21 | Width = 475 22 | Height = 352 23 | Align = alClient 24 | TabOrder = 0 25 | ControlData = { 26 | 4C00000018310000612400000000000000000000000000000000000000000000 27 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 28 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 29 | 8000000000000000000000000000000000000000000000000000000000000000 30 | 00000000000000000100000000000000000000000000000000000000} 31 | end 32 | end 33 | -------------------------------------------------------------------------------- /article-25/3/FmDemo3.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main form file of example program 3. 7 | } 8 | 9 | 10 | unit FmDemo3; 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 16 | Dialogs, OleCtrls, SHDocVw, 17 | 18 | UWBDragDropContainer; 19 | 20 | type 21 | TDemoForm3 = class(TForm) 22 | WebBrowser1: TWebBrowser; 23 | procedure FormCreate(Sender: TObject); 24 | procedure FormDestroy(Sender: TObject); 25 | private 26 | fWBContainer: TWBDragDropContainer; 27 | public 28 | { Public declarations } 29 | end; 30 | 31 | var 32 | DemoForm3: TDemoForm3; 33 | 34 | implementation 35 | 36 | uses 37 | ActiveX, UNulDropTarget; 38 | 39 | {$R *.dfm} 40 | 41 | procedure TDemoForm3.FormCreate(Sender: TObject); 42 | begin 43 | OleInitialize(nil); 44 | fWBContainer := TWBDragDropContainer.Create(WebBrowser1); 45 | fWBContainer.DropTarget := TNulDropTarget.Create; 46 | WebBrowser1.Navigate('about:blank'); 47 | end; 48 | 49 | procedure TDemoForm3.FormDestroy(Sender: TObject); 50 | begin 51 | fWBContainer.DropTarget := nil; 52 | OleUninitialize; 53 | FreeAndNil(fWBContainer); 54 | end; 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /article-25/3/UNulDropTarget.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is a do-nothing implementation of IDropTarget from example program 3. 7 | } 8 | 9 | 10 | unit UNulDropTarget; 11 | 12 | interface 13 | 14 | uses 15 | Windows, ActiveX; 16 | 17 | type 18 | 19 | TNulDropTarget = class(TInterfacedObject, IDropTarget) 20 | protected 21 | { IDropTarget methods } 22 | function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; 23 | pt: TPoint; var dwEffect: Longint): HResult; stdcall; 24 | function DragOver(grfKeyState: Longint; pt: TPoint; 25 | var dwEffect: Longint): HResult; stdcall; 26 | function DragLeave: HResult; stdcall; 27 | function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; 28 | var dwEffect: Longint): HResult; stdcall; 29 | end; 30 | 31 | implementation 32 | 33 | { TNulDropTarget } 34 | 35 | function TNulDropTarget.DragEnter(const dataObj: IDataObject; 36 | grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 37 | begin 38 | dwEffect := DROPEFFECT_NONE; 39 | Result := S_OK; 40 | end; 41 | 42 | function TNulDropTarget.DragLeave: HResult; 43 | begin 44 | Result := S_OK; 45 | end; 46 | 47 | function TNulDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; 48 | var dwEffect: Integer): HResult; 49 | begin 50 | dwEffect := DROPEFFECT_NONE; 51 | Result := S_OK; 52 | end; 53 | 54 | function TNulDropTarget.Drop(const dataObj: IDataObject; 55 | grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 56 | begin 57 | dwEffect := DROPEFFECT_NONE; 58 | Result := S_OK; 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /article-25/4/Article25Demo4.dpr: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main project file of example program 4. 7 | } 8 | 9 | 10 | program Article25Demo4; 11 | 12 | uses 13 | Forms, 14 | FmDemo4 in 'FmDemo4.pas' {DemoForm4}, 15 | UWBDragDropContainer in '..\Shared\UWBDragDropContainer.pas', 16 | IntfDocHostUIHandler in '..\Shared\IntfDocHostUIHandler.pas', 17 | UNulContainer in '..\Shared\UNulContainer.pas', 18 | UCustomDropTarget in 'UCustomDropTarget.pas'; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | Application.Initialize; 24 | Application.CreateForm(TDemoForm4, DemoForm4); 25 | Application.Run; 26 | end. 27 | -------------------------------------------------------------------------------- /article-25/4/Article25Demo4.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-25/4/Article25Demo4.res -------------------------------------------------------------------------------- /article-25/4/Demo4.html: -------------------------------------------------------------------------------- 1 | 4 | 11 | 12 | 13 | 14 | Article#25 Demo 4 15 | 16 | 43 | 44 | 45 |

46 | Drag Drop Test 47 |

48 |

49 | Drag and drop one or more files or a text selection on this browser control. 50 |

51 |
52 |
53 | Dragged and dropped text or list of files will be displayed here. 54 |
55 |
56 | 57 | 58 | -------------------------------------------------------------------------------- /article-25/4/FmDemo4.dfm: -------------------------------------------------------------------------------- 1 | object DemoForm4: TDemoForm4 2 | Left = 211 3 | Top = 114 4 | BorderStyle = bsSingle 5 | Caption = 'Article#25 Demo 4' 6 | ClientHeight = 284 7 | ClientWidth = 470 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poDesktopCenter 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | OnShow = FormShow 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object WebBrowser1: TWebBrowser 22 | Left = 0 23 | Top = 0 24 | Width = 470 25 | Height = 284 26 | Align = alClient 27 | TabOrder = 0 28 | ControlData = { 29 | 4C000000933000005A1D00000000000000000000000000000000000000000000 30 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 31 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 32 | 8000000000000000000000000000000000000000000000000000000000000000 33 | 00000000000000000100000000000000000000000000000000000000} 34 | end 35 | end 36 | -------------------------------------------------------------------------------- /article-25/4/FmDemo4.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This is the main form file of example program 4. 7 | } 8 | 9 | 10 | unit FmDemo4; 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 16 | Dialogs, OleCtrls, SHDocVw, 17 | 18 | UWBDragDropContainer, UCustomDropTarget; 19 | 20 | type 21 | TDemoForm4 = class(TForm, IDropHandler) 22 | WebBrowser1: TWebBrowser; 23 | procedure FormCreate(Sender: TObject); 24 | procedure FormDestroy(Sender: TObject); 25 | procedure FormShow(Sender: TObject); 26 | private 27 | fWBContainer: TWBDragDropContainer; 28 | procedure SetBoxInnerHTML(const HTML: string); 29 | protected 30 | { IDropHandler methods } 31 | procedure HandleText(const Text: string); 32 | procedure HandleFiles(const Files: TStrings); 33 | end; 34 | 35 | var 36 | DemoForm4: TDemoForm4; 37 | 38 | implementation 39 | 40 | uses 41 | ActiveX, MSHTML; 42 | 43 | {$R *.dfm} 44 | 45 | function MakeSafeHTMLText(TheText: string): string; 46 | var 47 | Idx: Integer; // loops thru the given text 48 | begin 49 | Result := ''; 50 | for Idx := 1 to Length(TheText) do 51 | case TheText[Idx] of 52 | '<': // opens tags: replace with special char reference 53 | Result := Result + '<'; 54 | '>': // closes tags: replace with special char reference 55 | Result := Result + '>'; 56 | '&': // begins char references: replace with special char reference 57 | Result := Result + '&'; 58 | '"': // quotes (can be a problem in quoted attributes) 59 | Result := Result + '"'; 60 | #0..#31, #127..#255: // control and special chars: replace with encoding 61 | Result := Result + '&#' + SysUtils.IntToStr(Ord(TheText[Idx])) + ';'; 62 | else // compatible text: pass thru 63 | Result := Result + TheText[Idx]; 64 | end; 65 | end; 66 | 67 | procedure TDemoForm4.FormCreate(Sender: TObject); 68 | begin 69 | OleInitialize(nil); 70 | fWBContainer := TWBDragDropContainer.Create(WebBrowser1); 71 | fWBContainer.DropTarget := TCustomDropTarget.Create(Self); 72 | WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + 'Demo4.html'); 73 | end; 74 | 75 | procedure TDemoForm4.FormDestroy(Sender: TObject); 76 | begin 77 | fWBContainer.DropTarget := nil; 78 | OleUninitialize; 79 | FreeAndNil(fWBContainer); 80 | end; 81 | 82 | procedure TDemoForm4.FormShow(Sender: TObject); 83 | begin 84 | while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do 85 | begin 86 | Sleep(5); 87 | Application.ProcessMessages; 88 | end; 89 | end; 90 | 91 | procedure TDemoForm4.HandleFiles(const Files: TStrings); 92 | var 93 | Idx: Integer; 94 | HTML: string; 95 | begin 96 | HTML := ''; 100 | SetBoxInnerHTML(HTML); 101 | end; 102 | 103 | procedure TDemoForm4.HandleText(const Text: string); 104 | begin 105 | SetBoxInnerHTML('
' + MakeSafeHTMLText(Text) + '
'); 106 | end; 107 | 108 | procedure TDemoForm4.SetBoxInnerHTML(const HTML: string); 109 | var 110 | BoxDiv: IHTMLElement; 111 | Doc: IHTMLDocument3; 112 | begin 113 | if Supports(WebBrowser1.Document, IHTMLDocument3, Doc) then 114 | begin 115 | BoxDiv := Doc.getElementById('box'); 116 | if Assigned(BoxDiv) then 117 | BoxDiv.innerHTML := HTML; 118 | end; 119 | end; 120 | 121 | end. 122 | 123 | -------------------------------------------------------------------------------- /article-25/Article25Demos.bpg: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | VERSION = BWS.01 3 | #------------------------------------------------------------------------------ 4 | !ifndef ROOT 5 | ROOT = $(MAKEDIR)\.. 6 | !endif 7 | #------------------------------------------------------------------------------ 8 | MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** 9 | DCC = $(ROOT)\bin\dcc32.exe $** 10 | BRCC = $(ROOT)\bin\brcc32.exe $** 11 | #------------------------------------------------------------------------------ 12 | PROJECTS = Article25Demo1.exe Article25Demo2.exe Article25Demo3.exe \ 13 | Article25Demo4.exe 14 | #------------------------------------------------------------------------------ 15 | default: $(PROJECTS) 16 | #------------------------------------------------------------------------------ 17 | 18 | Article25Demo1.exe: 1\Article25Demo1.dpr 19 | $(DCC) 20 | 21 | Article25Demo2.exe: 2\Article25Demo2.dpr 22 | $(DCC) 23 | 24 | Article25Demo3.exe: 3\Article25Demo3.dpr 25 | $(DCC) 26 | 27 | Article25Demo4.exe: 4\Article25Demo4.dpr 28 | $(DCC) 29 | 30 | 31 | -------------------------------------------------------------------------------- /article-25/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Article #25 Demo Changelog 2 | 3 | ## v1.1 of 2007/05/20 4 | 5 | * Changed implementation of TCustomDropTarget.CanDrop in `./4/UCustomDropTarget.pas`. 6 | 7 | ## v1.0 of 2007/04/22 8 | 9 | * Original version. 10 | -------------------------------------------------------------------------------- /article-25/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 25 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-25/Shared/MainIcon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-25/Shared/MainIcon.ico -------------------------------------------------------------------------------- /article-25/Shared/UWBDragDropContainer.pas: -------------------------------------------------------------------------------- 1 | { 2 | This demo application accompanies the article 3 | "How to handle drag and drop in a TWebBrowser control" at 4 | http://www.delphidabbler.com/articles/article-25. 5 | 6 | This shared file provides web browser container that implements 7 | IOleClientSite, IDocHostUIHandler and exposes a property that can provide a 8 | IDropTarget implementation to the web browser. 9 | } 10 | 11 | 12 | unit UWBDragDropContainer; 13 | 14 | interface 15 | 16 | uses 17 | ActiveX, 18 | IntfDocHostUIHandler, UNulContainer; // from article #18 19 | 20 | type 21 | 22 | TWBDragDropContainer = class(TNulWBContainer, 23 | IUnknown, IOleClientSite, IDocHostUIHandler 24 | ) 25 | private 26 | fDropTarget: IDropTarget; 27 | protected 28 | function GetDropTarget(const pDropTarget: IDropTarget; 29 | out ppDropTarget: IDropTarget): HResult; stdcall; 30 | public 31 | property DropTarget: IDropTarget read fDropTarget write fDropTarget; 32 | end; 33 | 34 | implementation 35 | 36 | { TWBDragDropContainer } 37 | 38 | function TWBDragDropContainer.GetDropTarget(const pDropTarget: IDropTarget; 39 | out ppDropTarget: IDropTarget): HResult; 40 | begin 41 | if Assigned(fDropTarget) then 42 | begin 43 | // We are handling drag-drop: notify browser of drop target object to use 44 | ppDropTarget := fDropTarget; 45 | Result := S_OK; 46 | end 47 | else 48 | // We are not handling drag-drop: use inherited default behaviour 49 | Result := inherited GetDropTarget(pDropTarget, ppDropTarget); 50 | end; 51 | 52 | end. 53 | 54 | -------------------------------------------------------------------------------- /article-27/EnumDelphiInstalls.dpr: -------------------------------------------------------------------------------- 1 | program EnumDelphiInstalls; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /article-27/EnumDelphiInstalls.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/article-demos/a25895688112a33dda50dc481013ea1db0a77fae/article-27/EnumDelphiInstalls.res -------------------------------------------------------------------------------- /article-27/LICENSE.md: -------------------------------------------------------------------------------- 1 | # License for Article 27 demo code 2 | 3 | This demo code is licensed under the [MIT License](https://github.com/delphidabbler/article-demos/blob/master/MIT-License.md). 4 | -------------------------------------------------------------------------------- /article-27/README.md: -------------------------------------------------------------------------------- 1 | # Demo code for Article 27 2 | 3 | This directory contains demo code for DelphiDabbler's article "[How to programatically detect installed versions of Delphi](https://delphidabbler.com/articles/article-27)". 4 | 5 | The demo was created in the [`delphidabbler/article-demos`](https://github.com/delphidabbler/article-demos) GitHub repository, so all its history is there. 6 | 7 | ## Bug Reports 8 | 9 | If you find a bug in the demo code, please report it. See the [main read-me file](https://github.com/delphidabbler/article-demos/blob/master/README.md#bug-reports) for information on how to do so. 10 | -------------------------------------------------------------------------------- /article-27/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 334 6 | ClientWidth = 552 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 | OnCreate = FormCreate 14 | PixelsPerInch = 96 15 | TextHeight = 15 16 | object ListBox1: TListBox 17 | Left = 0 18 | Top = 0 19 | Width = 552 20 | Height = 334 21 | Align = alClient 22 | ItemHeight = 15 23 | TabOrder = 0 24 | ExplicitLeft = 32 25 | ExplicitTop = 24 26 | ExplicitWidth = 441 27 | ExplicitHeight = 369 28 | end 29 | end 30 | --------------------------------------------------------------------------------