├── DevTools ├── BuildAll.bat ├── BuildExe.bat ├── BuildHelp.bat ├── BuildPascal.bat ├── BuildResources.bat ├── BuildSetup.bat ├── Config.bat ├── ReleaseExe.bat ├── ReleaseSrc.bat └── Tidy.bat ├── Docs ├── ChangeLog.txt ├── License.rtf ├── License.txt ├── MPL.txt ├── PreSVNFileChanges.txt ├── PreSVNProjectChanges.txt ├── ReadMe-Src.txt ├── ReadMe.txt ├── SourceCodeLicenses.txt └── SupportedClipFmts.html ├── README.md └── Src ├── 3rdParty └── IDLUtils.pas ├── Build.bat ├── CFS.cfg ├── CFS.dof ├── CFS.dpr ├── CFS.dproj ├── CFS.todo ├── FmAbout.dfm ├── FmAbout.pas ├── FmBase.dfm ├── FmBase.pas ├── FmBaseDlg.dfm ├── FmBaseDlg.pas ├── FmMain.dfm ├── FmMain.pas ├── FmViewer.dfm ├── FmViewer.pas ├── FrBinaryViewer.dfm ├── FrBinaryViewer.pas ├── FrFileGroupDescViewer.dfm ├── FrFileGroupDescViewer.pas ├── FrFileListViewer.dfm ├── FrFileListViewer.pas ├── FrFileNameViewer.dfm ├── FrFileNameViewer.pas ├── FrGraphicViewer.dfm ├── FrGraphicViewer.pas ├── FrHTMLClipViewer.dfm ├── FrHTMLClipViewer.pas ├── FrHTMLViewer.dfm ├── FrHTMLViewer.pas ├── FrLocaleViewer.dfm ├── FrLocaleViewer.pas ├── FrObjDescViewer.dfm ├── FrObjDescViewer.pas ├── FrRTFViewer.dfm ├── FrRTFViewer.pas ├── FrShellNameViewer.dfm ├── FrShellNameViewer.pas ├── FrTextViewer.dfm ├── FrTextViewer.pas ├── FrURLViewer.dfm ├── FrURLViewer.pas ├── Help ├── CFS.hhc ├── CFS.hhp ├── CSS │ └── main.css ├── HTML │ ├── author.htm │ ├── license.htm │ ├── main.htm │ ├── viewer-binary.htm │ ├── viewer-filegroupdesc.htm │ ├── viewer-filelist.htm │ ├── viewer-filename.htm │ ├── viewer-graphic.htm │ ├── viewer-html.htm │ ├── viewer-htmlclip.htm │ ├── viewer-locale.htm │ ├── viewer-nohelp.htm │ ├── viewer-objdesc.htm │ ├── viewer-rtf.htm │ ├── viewer-text.htm │ ├── viewer-url.htm │ └── viewers.htm └── Images │ ├── about.gif │ ├── delete.gif │ ├── exit.gif │ └── help.gif ├── Install.iss ├── IntfUIHandlers.pas ├── IntfViewers.pas ├── Res ├── CFS.ico ├── HTMLViewer.css └── XPnVista.manifest ├── Resources.rc ├── UBaseTextViewer.pas ├── UBinaryViewer.pas ├── UBmpViewer.pas ├── UCBUtils.pas ├── UClipFmt.pas ├── UClipboardLVMgr.pas ├── UDIBViewer.pas ├── UDataBuffer.pas ├── UFileGroupDescAdapter.pas ├── UFileGroupDescViewer.pas ├── UFileLists.pas ├── UFileNameViewer.pas ├── UGlobalMemViewer.pas ├── UGlobals.pas ├── UGraphicViewer.pas ├── UHDROPViewer.pas ├── UHTMLClip.pas ├── UHTMLClipViewer.pas ├── UHTMLDocViewer.pas ├── UHelpManager.pas ├── UIDListViewer.pas ├── UIntfObjects.pas ├── ULocale.pas ├── ULocaleViewer.pas ├── UMessageBox.pas ├── UMetafileViewer.pas ├── UNulDropTarget.pas ├── UNulUIHandler.pas ├── UObjDescAdapter.pas ├── UObjDescViewer.pas ├── UOleClientSite.pas ├── UPlatform.pas ├── UProcessUtils.pas ├── URTFViewer.pas ├── USettings.pas ├── UShellNameViewer.pas ├── UStatusBarMgr.pas ├── UTextViewer.pas ├── UURLViewer.pas ├── UUtils.pas ├── UViewerMenuMgr.pas ├── UViewers.pas ├── UWBController.pas ├── UWindowSettings.pas └── Version.vi /DevTools/BuildAll.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy from source 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build all 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/BuildExe.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy's executable file from source 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build exe 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/BuildHelp.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy's help file from source 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build help 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/BuildPascal.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy's Pascal files 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build pas 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/BuildResources.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy's resource files from source 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build res 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/BuildSetup.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to build Clipboard Format Spy's setup file from source 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | 12 | setlocal 13 | cd ..\Src 14 | Build setup 15 | endlocal 16 | -------------------------------------------------------------------------------- /DevTools/Config.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to create the directories required to build Clipboard Format 3 | @rem Spy. 4 | @rem 5 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2014 6 | @rem 7 | @rem $Rev$ 8 | @rem $Date$ 9 | @rem --------------------------------------------------------------------------- 10 | 11 | @echo off 12 | 13 | setlocal 14 | 15 | cd .. 16 | 17 | rem clear directories if they exist 18 | if exist Bin del /Q Bin\*.* 19 | if exist Exe del /Q Exe\*.* 20 | if exist Release del /Q Release\*.* 21 | 22 | rem create directories if they do not exist 23 | if not exist Bin mkdir Bin 24 | if not exist Exe mkdir Exe 25 | if not exist Release mkdir Release 26 | 27 | endlocal 28 | -------------------------------------------------------------------------------- /DevTools/ReleaseExe.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to create zip file containing binary release of Clipboard 3 | @rem Format Spy. 4 | @rem 5 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 6 | @rem 7 | @rem $Rev$ 8 | @rem $Date$ 9 | @rem --------------------------------------------------------------------------- 10 | 11 | @echo off 12 | setlocal 13 | if exist ..\Release\dd-cfs.zip del ..\Release\dd-cfs.zip 14 | if not exist ..\Release mkdir ..\Release 15 | zip -j -9 ..\Release\dd-cfs.zip ..\Exe\CFS-Setup-*.exe ..\Docs\ReadMe.txt 16 | endlocal 17 | -------------------------------------------------------------------------------- /DevTools/ReleaseSrc.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to create zip file containing source code of Clipboard Format 3 | @rem Spy. 4 | @rem 5 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 6 | @rem 7 | @rem $Rev$ 8 | @rem $Date$ 9 | @rem --------------------------------------------------------------------------- 10 | 11 | @echo off 12 | 13 | setlocal 14 | 15 | cd .. 16 | 17 | set OutFile=Release\dd-cfs-src.zip 18 | 19 | if exist %OutFile% del %OutFile% 20 | if not exist Release mkdir Release 21 | 22 | zip -r -9 %OutFile% Src 23 | zip %OutFile% -d Src\CFS.dsk 24 | zip -r -9 %OutFile% Bin\*.res 25 | zip -j -9 %OutFile% Docs\SourcecodeLicenses.txt 26 | zip -j -9 %OutFile% Docs\ReadMe-src.txt 27 | zip -j -9 %OutFile% Docs\MPL.txt 28 | 29 | endlocal 30 | -------------------------------------------------------------------------------- /DevTools/Tidy.bat: -------------------------------------------------------------------------------- 1 | @rem --------------------------------------------------------------------------- 2 | @rem Script used to delete Clipboard Format Spy's temp and backup source files 3 | @rem 4 | @rem Copyright (C) Peter Johnson (www.delphidabbler.com), 2008-2014 5 | @rem 6 | @rem $Rev$ 7 | @rem $Date$ 8 | @rem --------------------------------------------------------------------------- 9 | 10 | @echo off 11 | setlocal 12 | 13 | echo Tidying 14 | echo ~~~~~~~ 15 | echo. 16 | 17 | cd .. 18 | 19 | del /S *.~* 2>nul 20 | del /S ~* 2>nul 21 | del /S *.dsk 2>nul 22 | del /S *.local 2>nul 23 | del /S *.identcache 2>nul 24 | del /S *.tvsconfig 2>nul 25 | rem remove __history folders 26 | for /F "usebackq" %%i in (`dir /S /B /A:D __history*`) do rmdir /S /Q %%i 27 | 28 | echo. 29 | echo Done. 30 | 31 | endlocal 32 | -------------------------------------------------------------------------------- /Docs/License.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Docs/License.txt -------------------------------------------------------------------------------- /Docs/ReadMe-Src.txt: -------------------------------------------------------------------------------- 1 | Clipboard Format Spy Source Code Readme 2 | ================================================================================ 3 | 4 | Source code for the current version of DelphiDabbler Clipboard Format Spy is 5 | always available from http://www.delphidabbler.com/download?id=cfs&type=src. 6 | 7 | Clipboard Format Spy's source code is provided in a zip file, `dd-cfs-src.zip`. 8 | This file includes all Clipboard Format Spy's original code along with some 3rd 9 | party sources. Files should be extracted from the zip file and the directory 10 | structure should be preserved. 11 | 12 | The directory structure is: 13 | 14 | Bin : Binary resource files (*1) 15 | Src : Pascal & other source code + batch file controlling build (*2) 16 | 3rdParty : Supplied 3rd party source code 17 | Help : Source files for the CFS.chm HTML Help file (*3) 18 | CSS : Cascading style sheet used by HTML Help file 19 | HTML : HTML source documents for HTML help topics 20 | Images : GIF files used by HTML help file 21 | Res : Contains assets that are compiled into resources 22 | 23 | Notes: 24 | 25 | 1. See below for details of how to recompile these files. 26 | 2. Build batch file described below. 27 | 3. Files generated by Microsoft HTML Help Workshop. 28 | 29 | In order to compile the program you also need to create a `Exe` directory at the 30 | same level as the `Bin` and `Src` directories. 31 | 32 | Additional libraries / components are required to compile Clipboard Format Spy 33 | successfully. They are: 34 | 35 | * From DelphiDabbler.com: 36 | * Version Information Component (v3.3 or later) 37 | * Window State Components (v5.3.1 or later) 38 | * Clipboard Viewer Component (v1.4 or later) 39 | * Hot Label Component (v2.1.1 or later) 40 | * The Delphi 2010 VCL. 41 | 42 | All the libraries need to be available on Delphi's library path. 43 | 44 | All components must be installed in the Delphi Component Palette if the program 45 | is to be compiled from the IDE. 46 | 47 | The program also requires two binary files in order to compile (provided): 48 | 49 | * `Version.res` - The program's version information. 50 | * `Resources.res` - All other resources including main program icon, default CSS 51 | for HTML viewer and manifest for XP and Vista. 52 | 53 | 54 | Build Tools 55 | -------------------------------------------------------------------------------- 56 | 57 | A batch file - `Build.bat` - is provided in the `Src` directory. It can be used 58 | to automate full or partial builds. It must be called with a command line 59 | switch. Switches are: 60 | 61 | * `all` - Builds everything. 62 | * `res` - Builds binary resource files only. Requires VIEd and BRCC32. Creates 63 | `Version.res` and `Resources.res` from `Version.vi` and `Resources.rc` 64 | respectively. 65 | * `pas` - Builds the Delphi Pascal project. Requires DCC32. 66 | * `exe` - Builds program executable from resource and Pascal files. Same as 67 | `Build res` followed by `Build pas`. 68 | * `help` - Builds the HTML help file. Requires HHC. 69 | * `setup` - Builds the install program. Requires ISC. Creates installer from 70 | `Install.iss`. 71 | 72 | The programs required by the build process are: 73 | 74 | * `VIEd` - DelphiDabbler Version Information Editor, available from 75 | www.delphidabbler.com. Requires v2.11 or later. 76 | * `BRCC32` - Borland Resource Compiler, supplied with Delphi 2010. 77 | * `DCC32` - Delphi Command Line Compiler, supplied with Delphi 2010. 78 | * `HHC`- Microsoft HTML Help Compiler, supplied with Microsoft HTML Help 79 | Workshop. 80 | * `ISC` - Inno Setup command line compiler, supplied with Inno Setup v5. Also 81 | requires the ISPP pre-processor v5. The Unicode version of Inno Setup is 82 | required. 83 | 84 | 85 | Licensing 86 | -------------------------------------------------------------------------------- 87 | 88 | Please see `SourceCodeLicenses.txt` in the Docs directory for information about 89 | source code licenses. 90 | 91 | 92 | Earlier Versions 93 | -------------------------------------------------------------------------------- 94 | 95 | If you would like the source code of earlier, publicly released, versions of 96 | Clipboard Format Spy, please contact me via http://delphidabbler.com/contact 97 | specifying the version you would like source code for. See the change log at 98 | http://delphidabbler.com/software/cfs/changelog for details of available 99 | versions. 100 | 101 | Please note: source code for versions before v4.0.0 are no longer available. 102 | 103 | -------------------------------------------------------------------------------- 104 | 105 | $Rev$ 106 | $Date$ 107 | 108 | -------------------------------------------------------------------------------- /Docs/ReadMe.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Docs/ReadMe.txt -------------------------------------------------------------------------------- /Docs/SourceCodeLicenses.txt: -------------------------------------------------------------------------------- 1 | Source Code Licensing 2 | ================================================================================ 3 | 4 | This document discusses and presents the relevant licenses governing the 5 | Clipboard Format Spy source code available from DelphiDabbler.com as part of the 6 | program's source code download. 7 | 8 | The download includes: 9 | 10 | + Original Source Code written by Peter Johnson (DelphiDabbler). 11 | + Code auto-generated by compilers and other tools. 12 | + Some third party source. 13 | + Some binary resource files that may be difficult to recompile from source. 14 | + Various image files. 15 | 16 | The download does not include all the source code required to rebuild Clipboard 17 | Format Spy. Explicitly it doesn't include: 18 | 19 | + Source files from the Delphi 2010 VCL. You must have Delphi 2010 in order to 20 | access these files. 21 | + DelphiDabbler library components and units. These are all available from 22 | http://www.delphidabbler.com/software/cfs/download 23 | 24 | 25 | Original Source Code 26 | -------------------------------------------------------------------------------- 27 | 28 | Original source files are stored in the the following directories: 29 | 30 | + Src 31 | + Src\Help 32 | + Src\Help\CSS 33 | + Src\Help\HTML 34 | + Src\Res 35 | 36 | Any original source code file that is governed by a license has a comment to 37 | that effect in the source. The exception is that `.dfm files` are considered to 38 | be governed by the same license as their associated `.pas` file. 39 | 40 | Where files are auto-generated, and there are no copyright or license comments 41 | in the files, the licensing of the file depends on how it was generated. If the 42 | file was generated from another source file then the generated file is covered 43 | by the same license as the originating source file. Otherwise the file is placed 44 | in the public domain. 45 | 46 | Any other source code files that contain no copyright or license information are 47 | public domain. 48 | 49 | Many files are licensed under the Mozilla Public License. A full copy of that 50 | license can be found in `MPL.txt`. 51 | 52 | 53 | Third Party Source Code 54 | -------------------------------------------------------------------------------- 55 | 56 | All third party code is stored in the `Src\3rdParty` directory. At present there 57 | is just one such unit: `IDLUtils.pas`. 58 | 59 | ### IDLUtils.pas 60 | 61 | These routines are by Grahame Marsh for the manipulation of ItemIDList variables 62 | that are used extensively by the Windows Shell. 63 | 64 | They are based on routines written by Brad Stowers in his SystemTreeView 65 | component. 66 | 67 | The code is freeware and is provided without warranty. 68 | 69 | 70 | Binary Resource Files 71 | -------------------------------------------------------------------------------- 72 | 73 | The following binary files are provided in the Bin directory. Governing licenses 74 | are those that apply to their source files. 75 | 76 | + `Resources.res` - compiled from `Resources.rc` 77 | + `Version.res` - compiled from `Verson.vi` 78 | 79 | 80 | Image Files (.ico, .gif) 81 | -------------------------------------------------------------------------------- 82 | 83 | Several images are used in the program. They are stored in the `Src\Res` and 84 | `Src\Help\Images` directories. Images are also embedded in forms by various VCL 85 | controls. Original images are not provided in the latter case. 86 | 87 | All images are either original or have been copied or adapted from various 88 | sources. As far as the author is aware, all the images are public domain. 89 | 90 | -------------------------------------------------------------------------------- 91 | 92 | $Rev$ 93 | $Date$ 94 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Clipboard Format Spy (CFS) 2 | ========================= 3 | 4 | A windows program to list the Windows clipboard formats that are currently available and to display the contents in numerous supported formats. 5 | 6 | > ### ***NOTE: This project is no longer being updated and has been archived.*** 7 | > ***There were 6 open issues when archived.*** 8 | 9 | Overview 10 | -------- 11 | 12 | This program lists the available formats for any data that is currently stored on the Windows clipboard. It automatically updates the information displayed as the contents of the clipboard change. 13 | 14 | For several formats CFS can also display the clipboard contents. For formats where CFS does not have a suitable custom viewer the contents are displayed in a hex viewer. 15 | 16 | The clipboard can also be cleared. 17 | 18 | For further information see the [program's web page](http://delphidabbler.com/software/cfs). 19 | CFS should run on Windows 2000 to Windows 10. Not tested on later Windows versions. 20 | 21 | Installation 22 | ------------ 23 | 24 | CFS is installed and removed using a standard Windows installer. Administrator rights are required for installation. 25 | 26 | Full installation instructions are contained in [`ReadMe.txt`](Docs/ReadMe.txt) in the project's `Docs` directory. 27 | 28 | Source Code 29 | ----------- 30 | 31 | Up to and including release 4.1.1 the project's source code was maintained in a private Subversion repository. The Subversion repo was converted to Git on 21 July 2014, imported to GitHub and releases were tagged. 32 | 33 | Consequently all changes up to release v4.1.1 were made to `master`. A `develop` branch was created at that point with the idea of leaving leaving `master` in a production ready state. However `develop` only received two commits before the project was archived. 34 | 35 | Anyone wanting to take the project on can simply fork the repo. 36 | 37 | Change Log 38 | ---------- 39 | 40 | The program's change log is recorded in [`ChangeLog.txt`](Docs/ChangeLog.txt) in the `Docs` directory. 41 | 42 | License 43 | ------- 44 | 45 | The program's EULA can be found in [`License.txt`](Docs/License.txt) in the `Docs` directory. 46 | 47 | Much of the source code is released under the [Mozilla Public License v1.1](https://www.mozilla.org/MPL/1.1/). 48 | 49 | > If anyone decides to take on this project and would like to change the license, please contact me via [Twitter](https://twitter.com/delphidabbler). 50 | -------------------------------------------------------------------------------- /Src/3rdParty/IDLUtils.pas: -------------------------------------------------------------------------------- 1 | 2 | //--- ItemIDList manipulation -------------------------------------------------- 3 | // 4 | // These routines are for the manipulation of ItemIDList variables that 5 | // are used extensively by the Windows Shell. 6 | // 7 | // They are based on routines written by Brad Stowers in his SystemTreeView 8 | // component. 9 | // 10 | // Freeware - you get it for nothing - I make no promises 11 | // 12 | // Version 1.0 4-8-98 Grahame Marsh - poached from Brad's work 13 | // PIDLSize, CreateEmptyPIDL, ConcatPIDL, CopyPIDL, 14 | // CreateSimplePIDL, NextPIDL 15 | // 16 | // Version 1.1 26-12-2010 Peter Johnson (www.delphidabbler.com) - fixed to work 17 | // with Unicode Delphis where PChar = PWideChar. 18 | // 19 | //------------------------------------------------------------------------------ 20 | 21 | unit IDLUtils; 22 | 23 | interface 24 | 25 | uses 26 | Windows, ActiveX, ShlObj; 27 | 28 | // Our interface to the shell memory allocator, obtained and released automatically. 29 | // available for use during the lifetime of this unit. 30 | var 31 | ShellMalloc : IMalloc = nil; 32 | 33 | // Returns the length of the PIDL or 0 for a nil or empty PIDL 34 | function PIDLSize (PIDL: PItemIDList) : integer; 35 | 36 | // Creates a PIDL of a given size, all bytes set to zero 37 | // returns nil if memory allocation fails 38 | function CreateEmptyPIDL (Size : uint): PItemIDList; 39 | 40 | // Create a new PIDL given two PIDLS by concatation. PIDL1 may be nil in 41 | // which case a new PIDL is created containing PIDL2 only; copy in effect. 42 | function ConcatPIDLs (PIDL1, PIDL2: PItemIDList) : PItemIDList; 43 | // not rocket science given the above 44 | function CopyPIDL (PIDL : PItemIDList) : PItemIDList; 45 | 46 | // Scan a PIDL for the next element of the given PIDL, returns a pointer 47 | // to the position or nil if already at the end 48 | function NextPIDL (PIDL: PItemIDList): PItemIDList; 49 | 50 | // Extract the current element of the given PIDL and return it as a new PIDL, 51 | // returns nil if memory allocation fails 52 | function CreateSimplePIDL (PIDL : PItemIDList): PItemIDList; 53 | 54 | implementation 55 | 56 | function PIDLSize (PIDL: PItemIDList) : integer; 57 | begin 58 | Result := 0; 59 | if Assigned (PIDL) then 60 | begin 61 | inc (Result, SizeOf (PIDL^.mkid.cb)); 62 | while PIDL^.mkid.cb <> 0 do 63 | begin 64 | inc (Result, pidl^.mkid.cb); 65 | inc (longint(PIDL), PIDL^.mkid.cb) 66 | end 67 | end 68 | end; 69 | 70 | function CreateEmptyPIDL (Size : uint): PItemIDList; 71 | begin 72 | Result := ShellMalloc.Alloc (Size); 73 | if Assigned (Result) then 74 | ZeroMemory (Result, Size) 75 | end; 76 | 77 | function ConcatPIDLs (PIDL1, PIDL2: PItemIDList) : PItemIDList; 78 | var 79 | Size1, 80 | Size2: integer; 81 | begin 82 | if Assigned (PIDL1) then 83 | Size1 := PIDLSize (PIDL1) - SizeOf (PIDL1.mkid.cb) 84 | else 85 | Size1 := 0; 86 | Size2 := PIDLSize (PIDL2); 87 | Result := CreateEmptyPIDL (Size1 + Size2); 88 | if Assigned (Result) then 89 | begin 90 | if Assigned (PIDL1) then 91 | Move (PIDL1^, Result^, Size1); 92 | // PJ 26-12-2010 - replaced use of PChar with PByte (use of PChar breaks code 93 | // when PChar = PWideChar as on Unicode Delphis - use PByte 94 | // instead which should work on all Delphis 95 | // Move (PIDL2^, PChar(Result)[Size1], Size2) 96 | Move (PIDL2^, PByte(Result)[Size1], Size2) 97 | end 98 | end; 99 | 100 | function CopyPIDL (PIDL: PItemIDList): PItemIDList; 101 | begin 102 | Result := ConcatPIDLs (nil, PIDL) 103 | end; 104 | 105 | function NextPIDL (PIDL: PItemIDList): PItemIDList; 106 | begin 107 | if PIDL.mkid.cb > 0 then 108 | Result := PItemIDList (Longint(PIDL) + PIDL.mkid.cb) 109 | else 110 | Result := nil 111 | end; 112 | 113 | function CreateSimplePIDL (PIDL : PItemIDList): PItemIDList; 114 | var 115 | Size: integer; 116 | begin 117 | Size := PIDL.mkid.cb + SizeOf (PIDL.mkid.cb); 118 | Result := CreateEmptyPIDL (Size); 119 | if Assigned (Result) then 120 | Move (PIDL^, Result^, PIDL.mkid.cb) 121 | end; 122 | 123 | initialization 124 | SHGetMalloc (ShellMalloc) 125 | finalization 126 | ShellMalloc := nil 127 | end. 128 | 129 | -------------------------------------------------------------------------------- /Src/CFS.cfg: -------------------------------------------------------------------------------- 1 | -$A8 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 | -H+ 29 | -W+ 30 | -M 31 | -$M16384,1048576 32 | -K$00400000 33 | -E"..\Exe" 34 | -N0"..\Bin" 35 | -U"..\Bin" 36 | -O"..\Bin" 37 | -I"..\Bin" 38 | -R"..\Bin" 39 | -w-SYMBOL_PLATFORM 40 | -w+EXPLICIT_STRING_CAST_LOSS 41 | -w+CVT_WIDENING_STRING_LOST 42 | -w+CVT_ACHAR_TO_WCHAR 43 | -------------------------------------------------------------------------------- /Src/CFS.dof: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/CFS.dof -------------------------------------------------------------------------------- /Src/CFS.dpr: -------------------------------------------------------------------------------- 1 | { 2 | * CFS.dpr 3 | * 4 | * Main project file for Clipboard Format Spy. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is CFS.dpr. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 1997-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | program CFS; 36 | 37 | 38 | uses 39 | Forms, 40 | FmAbout in 'FmAbout.pas' {AboutBox}, 41 | FmBase in 'FmBase.pas' {BaseForm}, 42 | FmBaseDlg in 'FmBaseDlg.pas' {BaseDlgForm}, 43 | FmMain in 'FmMain.pas' {MainForm}, 44 | FmViewer in 'FmViewer.pas' {ViewerDlg}, 45 | FrBinaryViewer in 'FrBinaryViewer.pas' {BinaryViewerFrame: TFrame}, 46 | FrFileGroupDescViewer in 'FrFileGroupDescViewer.pas' {FileGroupDescViewerFrame: TFrame}, 47 | FrFileListViewer in 'FrFileListViewer.pas' {FileListViewerFrame: TFrame}, 48 | FrFileNameViewer in 'FrFileNameViewer.pas' {FileNameViewerFrame: TFrame}, 49 | FrGraphicViewer in 'FrGraphicViewer.pas' {GraphicViewerFrame: TFrame}, 50 | FrHTMLClipViewer in 'FrHTMLClipViewer.pas' {HTMLClipViewerFrame: TFrame}, 51 | FrHTMLViewer in 'FrHTMLViewer.pas' {HTMLViewerFrame: TFrame}, 52 | FrLocaleViewer in 'FrLocaleViewer.pas' {LocaleViewerFrame: TFrame}, 53 | FrObjDescViewer in 'FrObjDescViewer.pas' {ObjDescViewerFrame: TFrame}, 54 | FrRTFViewer in 'FrRTFViewer.pas' {RTFViewerFrame: TFrame}, 55 | FrShellNameViewer in 'FrShellNameViewer.pas' {ShellNameViewerFrame: TFrame}, 56 | FrTextViewer in 'FrTextViewer.pas' {TextViewerFrame: TFrame}, 57 | FrURLViewer in 'FrURLViewer.pas' {URLViewerFrame: TFrame}, 58 | IDLUtils in '3rdParty\IDLUtils.pas', 59 | IntfUIHandlers in 'IntfUIHandlers.pas', 60 | IntfViewers in 'IntfViewers.pas', 61 | UBaseTextViewer in 'UBaseTextViewer.pas', 62 | UBinaryViewer in 'UBinaryViewer.pas', 63 | UBmpViewer in 'UBmpViewer.pas', 64 | UCBUtils in 'UCBUtils.pas', 65 | UClipboardLVMgr in 'UClipboardLVMgr.pas', 66 | UClipFmt in 'UClipFmt.pas', 67 | UDataBuffer in 'UDataBuffer.pas', 68 | UDIBViewer in 'UDIBViewer.pas', 69 | UFileGroupDescAdapter in 'UFileGroupDescAdapter.pas', 70 | UFileGroupDescViewer in 'UFileGroupDescViewer.pas', 71 | UFileLists in 'UFileLists.pas', 72 | UFileNameViewer in 'UFileNameViewer.pas', 73 | UGlobalMemViewer in 'UGlobalMemViewer.pas', 74 | UGlobals in 'UGlobals.pas', 75 | UGraphicViewer in 'UGraphicViewer.pas', 76 | UHDROPViewer in 'UHDROPViewer.pas', 77 | UHelpManager in 'UHelpManager.pas', 78 | UHTMLClip in 'UHTMLClip.pas', 79 | UHTMLClipViewer in 'UHTMLClipViewer.pas', 80 | UHTMLDocViewer in 'UHTMLDocViewer.pas', 81 | UIDListViewer in 'UIDListViewer.pas', 82 | UIntfObjects in 'UIntfObjects.pas', 83 | ULocale in 'ULocale.pas', 84 | ULocaleViewer in 'ULocaleViewer.pas', 85 | UMessageBox in 'UMessageBox.pas', 86 | UMetafileViewer in 'UMetafileViewer.pas', 87 | UNulDropTarget in 'UNulDropTarget.pas', 88 | UNulUIHandler in 'UNulUIHandler.pas', 89 | UObjDescAdapter in 'UObjDescAdapter.pas', 90 | UObjDescViewer in 'UObjDescViewer.pas', 91 | UOleClientSite in 'UOleClientSite.pas', 92 | UPlatform in 'UPlatform.pas', 93 | UProcessUtils in 'UProcessUtils.pas', 94 | URTFViewer in 'URTFViewer.pas', 95 | USettings in 'USettings.pas', 96 | UShellNameViewer in 'UShellNameViewer.pas', 97 | UStatusBarMgr in 'UStatusBarMgr.pas', 98 | UTextViewer in 'UTextViewer.pas', 99 | UURLViewer in 'UURLViewer.pas', 100 | UUtils in 'UUtils.pas', 101 | UViewerMenuMgr in 'UViewerMenuMgr.pas', 102 | UViewers in 'UViewers.pas', 103 | UWBController in 'UWBController.pas', 104 | UWindowSettings in 'UWindowSettings.pas'; 105 | 106 | {$RESOURCE Resources.res} 107 | {$RESOURCE Version.res} 108 | 109 | begin 110 | ReportMemoryLeaksOnShutdown := DebugHook <> 0; 111 | Application.MainFormOnTaskBar := True; 112 | Application.ModalPopupMode := pmAuto; 113 | Application.Title := 'Clipboard Format Spy'; 114 | Application.CreateForm(TMainForm, MainForm); 115 | Application.Run; 116 | end. 117 | 118 | -------------------------------------------------------------------------------- /Src/CFS.todo: -------------------------------------------------------------------------------- 1 | {TODO : Add "text/_moz_htmlcontext" format and display using HTML viewer.} 2 | {TODO : Add "WorksRTF" format and display using RTF viewer.} 3 | {TODO : Change project to use OLE clipboard and IDataObject (and list TYMED in list view)} 4 | {DONE : Correct error in Version.vi - Uses instead of for Internal Name} 5 | {DONE : Correct error in main.css - h1 style has font-weight spelled wrongly} 6 | {TODO : Add sort indicators to list view header} 7 | {TODO : Add help for standard and any other known format types} 8 | {DONE : Spurious line in Build.bat that sets MS SDK info} 9 | -------------------------------------------------------------------------------- /Src/FmAbout.dfm: -------------------------------------------------------------------------------- 1 | inherited AboutBox: TAboutBox 2 | Left = 212 3 | Top = 108 4 | ActiveControl = btnButton 5 | BorderStyle = bsDialog 6 | Caption = 'About' 7 | ClientHeight = 183 8 | ClientWidth = 293 9 | OldCreateOrder = True 10 | Position = poOwnerFormCenter 11 | ExplicitWidth = 299 12 | ExplicitHeight = 211 13 | PixelsPerInch = 96 14 | TextHeight = 13 15 | object pnlMain: TPanel 16 | Left = 8 17 | Top = 8 18 | Width = 277 19 | Height = 134 20 | BevelInner = bvRaised 21 | BevelOuter = bvLowered 22 | ParentColor = True 23 | TabOrder = 0 24 | object imgIcon: TImage 25 | Left = 8 26 | Top = 8 27 | Width = 32 28 | Height = 32 29 | Picture.Data = { 30 | 055449636F6E0000010001002020100000000000E80200001600000028000000 31 | 2000000040000000010004000000000080020000000000000000000000000000 32 | 0000000000000000000080000080000000808000800000008000800080800000 33 | C0C0C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000 34 | FFFFFF0000000000000000000000000000000000000000000000000000000000 35 | 000100000000000000000000000000000011100000000F7F7F7F7F7F7F7F0000 36 | 01110000000007F7F7F7F7F7F7F700001110000000000F000F000F7001111101 37 | 11000000000007F7F7F7F7F7111111111000000000000F0000700F0111FF0111 38 | 00000000000007F7F7F7F7111FFF0B111000000000000F7F7F7F7F11FFFF0BB1 39 | 10000000000007FCCCF7F711FFFF0BB11000000000000F7CCC7F7F11FFFF0BB1 40 | 10000000000007FCCCF7F2111AFF0B111000000000000F7F7F7F7F2111FF0111 41 | 00000000000007F7F7F997F2111111100000000000000F7F7F99997F71111100 42 | 00000000000007F7F7F997F7F7F700000000000000000F7F7F7F7F7F7F7F0000 43 | 00000000000007F7F7F7F7F7F7F700000000000000000F00007F0000700F0000 44 | 00000000000007F7F7F7F7F7F7F700000000000000000F000F7000007F7F0000 45 | 00000000000007F7F7F7F7F7F7F700000000000000000F007000000F000F0000 46 | 00000000000007F7F7F7F7F7F7F700000000000000000F7F700000007F7F0000 47 | 0000000000000000000000000000000000000000000000000000000000000000 48 | 00000000000000000000F0000000000000000000000000000000000000000000 49 | 0000000000000000000000000000000000000000000000000000000000000000 50 | 00000000FFFFFFFFFFFFFFEFF00007C7F000078FF000071FF000023FF000007F 51 | F00000FFF000007FF000007FF000007FF000007FF000007FF00000FFF00001FF 52 | F00003FFF00007FFF00007FFF00007FFF00007FFF00007FFF00007FFF00007FF 53 | F00007FFF00007FFF00007FFF00007FFFF007FFFFF007FFFFFE3FFFFFFE3FFFF 54 | FFFFFFFF} 55 | Stretch = True 56 | IsControl = True 57 | end 58 | object lblProductName: TLabel 59 | Left = 48 60 | Top = 8 61 | Width = 100 62 | Height = 16 63 | Caption = 'lblProductName' 64 | Font.Charset = DEFAULT_CHARSET 65 | Font.Color = clWindowText 66 | Font.Height = -13 67 | Font.Name = 'Tahoma' 68 | Font.Style = [fsBold] 69 | ParentFont = False 70 | IsControl = True 71 | end 72 | object lblVersion: TLabel 73 | Left = 48 74 | Top = 27 75 | Width = 45 76 | Height = 13 77 | Caption = 'lblVersion' 78 | IsControl = True 79 | end 80 | object lblCopyright: TLabel 81 | Left = 8 82 | Top = 56 83 | Width = 57 84 | Height = 13 85 | Caption = 'lblCopyright' 86 | IsControl = True 87 | end 88 | object lblComments: TLabel 89 | Left = 8 90 | Top = 80 91 | Width = 230 92 | Height = 13 93 | Caption = 'This software is released under an open source ' 94 | IsControl = True 95 | end 96 | object hlblWebsite: TPJHotLabel 97 | Left = 157 98 | Top = 113 99 | Width = 115 100 | Height = 13 101 | Caption = 'www.delphidabbler.com' 102 | Font.Charset = DEFAULT_CHARSET 103 | Font.Color = clNavy 104 | Font.Height = -11 105 | Font.Name = 'Tahoma' 106 | Font.Style = [fsUnderline] 107 | CaptionIsURL = False 108 | VisitedFont.Charset = DEFAULT_CHARSET 109 | VisitedFont.Color = clBlue 110 | VisitedFont.Height = -11 111 | VisitedFont.Name = 'Tahoma' 112 | VisitedFont.Style = [fsUnderline] 113 | HighlightFont.Charset = DEFAULT_CHARSET 114 | HighlightFont.Color = clRed 115 | HighlightFont.Height = -11 116 | HighlightFont.Name = 'MS Sans Serif' 117 | HighlightFont.Style = [fsUnderline] 118 | URL = 'http://www.delphidabbler.com/' 119 | end 120 | object lblLicense: TLabel 121 | Left = 8 122 | Top = 95 123 | Width = 32 124 | Height = 13 125 | Cursor = crHandPoint 126 | Caption = 'license' 127 | Font.Charset = DEFAULT_CHARSET 128 | Font.Color = clGreen 129 | Font.Height = -11 130 | Font.Name = 'Tahoma' 131 | Font.Style = [fsUnderline] 132 | ParentFont = False 133 | OnClick = lblLicenseClick 134 | end 135 | object lblCommentsEnd: TLabel 136 | Left = 41 137 | Top = 95 138 | Width = 4 139 | Height = 13 140 | Caption = '.' 141 | end 142 | end 143 | object btnButton: TButton 144 | Left = 111 145 | Top = 150 146 | Width = 75 147 | Height = 25 148 | Cancel = True 149 | Caption = 'OK' 150 | Default = True 151 | ModalResult = 1 152 | TabOrder = 1 153 | end 154 | object viMain: TPJVersionInfo 155 | Left = 8 156 | Top = 152 157 | end 158 | end 159 | -------------------------------------------------------------------------------- /Src/FmAbout.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FmAbout.pas 3 | * 4 | * Main Clipboard Format Spy window handling and program logic. 5 | * 6 | * This unit requires the following DelphiDabbler components: 7 | * - TPJVersionInfo Release 3.1.1 or later. 8 | * - TPJHotLabel Release 2.1 or later. 9 | * 10 | * $Rev$ 11 | * $Date$ 12 | * 13 | * ***** BEGIN LICENSE BLOCK ***** 14 | * 15 | * Version: MPL 1.1 16 | * 17 | * The contents of this file are subject to the Mozilla Public License Version 18 | * 1.1 (the "License"); you may not use this file except in compliance with the 19 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 20 | * 21 | * Software distributed under the License is distributed on an "AS IS" basis, 22 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 23 | * the specific language governing rights and limitations under the License. 24 | * 25 | * The Original Code is FmAboutpas. 26 | * 27 | * The Initial Developer of the Original Code is Peter Johnson 28 | * (http://www.delphidabbler.com/). 29 | * 30 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 31 | * Johnson. All Rights Reserved. 32 | * 33 | * Contributor(s): None. 34 | * 35 | * ***** END LICENSE BLOCK ***** 36 | } 37 | 38 | 39 | unit FmAbout; 40 | 41 | 42 | interface 43 | 44 | 45 | uses 46 | // Delphi 47 | StdCtrls, Graphics, Controls, ExtCtrls, Classes, Forms, 48 | // DelphiDabbler library 49 | PJHotLabel, PJVersionInfo, 50 | // Project 51 | FmBaseDlg; 52 | 53 | type 54 | TAboutBox = class(TBaseDlgForm) 55 | pnlMain: TPanel; 56 | imgIcon: TImage; 57 | lblProductName: TLabel; 58 | lblVersion: TLabel; 59 | lblCopyright: TLabel; 60 | lblComments: TLabel; 61 | btnButton: TButton; 62 | hlblWebsite: TPJHotLabel; 63 | viMain: TPJVersionInfo; 64 | lblLicense: TLabel; 65 | lblCommentsEnd: TLabel; 66 | procedure FormCreate(Sender: TObject); 67 | procedure lblLicenseClick(Sender: TObject); 68 | public 69 | class procedure Execute(const AOwner: TComponent); 70 | {Displays About Box. 71 | @param AOwner [in] Owning control. 72 | } 73 | end; 74 | 75 | 76 | implementation 77 | 78 | 79 | uses 80 | // Project 81 | UHelpManager; 82 | 83 | {$R *.dfm} 84 | 85 | 86 | { TAboutBox } 87 | 88 | class procedure TAboutBox.Execute(const AOwner: TComponent); 89 | {Displays About Box. 90 | @param AOwner [in] Owning control. 91 | } 92 | begin 93 | with TAboutBox.Create(AOwner) do 94 | try 95 | ShowModal 96 | finally 97 | Free; 98 | end; 99 | end; 100 | 101 | procedure TAboutBox.FormCreate(Sender: TObject); 102 | {Displays required application title and version information in dialog box. 103 | } 104 | begin 105 | inherited; 106 | // Use application tile for form caption and product name 107 | Caption := Caption + ' ' + Application.Title; 108 | lblProductName.Caption := Application.Title; 109 | // Get release number and copyright from version information 110 | lblVersion.Caption := viMain.ProductVersion; 111 | lblCopyright.Caption := viMain.LegalCopyright; 112 | end; 113 | 114 | procedure TAboutBox.lblLicenseClick(Sender: TObject); 115 | {Displays license in help window when license label is clicked. 116 | @param Sender [in] Not used. 117 | } 118 | begin 119 | THelpManager.ShowTopic(cLicenseTopic); 120 | end; 121 | 122 | end. 123 | 124 | -------------------------------------------------------------------------------- /Src/FmBase.dfm: -------------------------------------------------------------------------------- 1 | object BaseForm: TBaseForm 2 | Left = 300 3 | Top = 122 4 | Caption = 'BaseForm' 5 | ClientHeight = 475 6 | ClientWidth = 700 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 | Scaled = False 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | end 20 | -------------------------------------------------------------------------------- /Src/FmBase.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FmBase.pas 3 | * 4 | * Implements a form that provides the ancestor of all forms in the application. 5 | * Provides default names for form window classes along with various operations 6 | * that are common to all forms in application. 7 | * 8 | * $Rev$ 9 | * $Date$ 10 | * 11 | * ***** BEGIN LICENSE BLOCK ***** 12 | * 13 | * Version: MPL 1.1 14 | * 15 | * The contents of this file are subject to the Mozilla Public License Version 16 | * 1.1 (the "License"); you may not use this file except in compliance with the 17 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 18 | * 19 | * Software distributed under the License is distributed on an "AS IS" basis, 20 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 21 | * the specific language governing rights and limitations under the License. 22 | * 23 | * The Original Code is FmBase.pas 24 | * 25 | * The Initial Developer of the Original Code is Peter Johnson 26 | * (http://www.delphidabbler.com/). 27 | * 28 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 29 | * Johnson. All Rights Reserved. 30 | * 31 | * Contributor(s): None 32 | * 33 | * ***** END LICENSE BLOCK ***** 34 | } 35 | 36 | 37 | unit FmBase; 38 | 39 | 40 | interface 41 | 42 | 43 | uses 44 | // Delphi 45 | Forms, Controls, Messages; 46 | 47 | 48 | type 49 | { 50 | TBaseForm: 51 | Base class for all forms in application. Sets a unique window class name for 52 | all derived forms and provides various operations that are common to all 53 | forms in application. 54 | } 55 | TBaseForm = class(TForm) 56 | procedure FormCreate(Sender: TObject); 57 | procedure FormDestroy(Sender: TObject); 58 | private 59 | procedure CMWinIniChange(var Msg: TMessage); message CM_WININICHANGE; 60 | {Handles CM_WININICHANGE message by updating themes. 61 | @param Msg [in/out] CM_WININICHANGE message. Unchanged. 62 | } 63 | protected 64 | procedure CreateParams(var Params: TCreateParams); override; 65 | {Sets window class name. 66 | @param Params [in/out] Parameters used in underlying call to 67 | CreateWindowEx API function. Window class name member field is set. 68 | } 69 | end; 70 | 71 | 72 | implementation 73 | 74 | 75 | uses 76 | // Delphi 77 | SysUtils, StrUtils, Themes; 78 | 79 | 80 | {$R *.dfm} 81 | 82 | procedure TBaseForm.CMWinIniChange(var Msg: TMessage); 83 | {Handles CM_WININICHANGE message by updating themes. 84 | @param Msg [in/out] CM_WININICHANGE message. Unchanged. 85 | } 86 | begin 87 | ThemeServices.ApplyThemeChange; 88 | inherited; 89 | end; 90 | 91 | procedure TBaseForm.CreateParams(var Params: TCreateParams); 92 | {Sets window class name. 93 | @param Params [in/out] Parameters used in underlying call to 94 | CreateWindowEx API function. Window class name member field is set. 95 | } 96 | var 97 | WindowClassName: string; // name of window class 98 | begin 99 | inherited; 100 | Assert(Name <> '', // ** do not localise 101 | 'TBaseForm.CreateParams: Name is empty string'); 102 | WindowClassName := 'DelphiDabbler.CFS.' + Name; 103 | StrLCopy( 104 | Params.WinClassName, 105 | PChar(WindowClassName), 106 | SizeOf(Params.WinClassName) div SizeOf(Char) - 1 107 | ); 108 | end; 109 | 110 | procedure TBaseForm.FormCreate(Sender: TObject); 111 | {Do-nothing handler of form's OnCreate event. 112 | @param Sender [in] Not used. 113 | } 114 | begin 115 | // For reasons I don't understand this do-nothing event handler must be 116 | // present otherwise OnCreate handlers of descendant forms won't get called!! 117 | end; 118 | 119 | procedure TBaseForm.FormDestroy(Sender: TObject); 120 | {Do-nothing handler of form's OnDestroy event. 121 | @param Sender [in] Not used. 122 | } 123 | begin 124 | // For reasons I don't understand this do-nothing event handler must be 125 | // present otherwise OnDestroy handlers of descendant forms won't get called!! 126 | end; 127 | 128 | end. 129 | 130 | -------------------------------------------------------------------------------- /Src/FmBaseDlg.dfm: -------------------------------------------------------------------------------- 1 | inherited BaseDlgForm: TBaseDlgForm 2 | Caption = 'BaseDlgForm' 3 | PixelsPerInch = 96 4 | TextHeight = 13 5 | end 6 | -------------------------------------------------------------------------------- /Src/FmBaseDlg.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FmBaseDlg.pas 3 | * 4 | * Implements a form that provides the ancestor of all forms that act as dialog 5 | * boxes in the application. Ensures that dialog boxes have the owner form as a 6 | * parent window. 7 | * 8 | * $Rev$ 9 | * $Date$ 10 | * 11 | * ***** BEGIN LICENSE BLOCK ***** 12 | * 13 | * Version: MPL 1.1 14 | * 15 | * The contents of this file are subject to the Mozilla Public License Version 16 | * 1.1 (the "License"); you may not use this file except in compliance with the 17 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 18 | * 19 | * Software distributed under the License is distributed on an "AS IS" basis, 20 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 21 | * the specific language governing rights and limitations under the License. 22 | * 23 | * The Original Code is FmBaseDlg.pas 24 | * 25 | * The Initial Developer of the Original Code is Peter Johnson 26 | * (http://www.delphidabbler.com/). 27 | * 28 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 29 | * Johnson. All Rights Reserved. 30 | * 31 | * Contributor(s): None 32 | * 33 | * ***** END LICENSE BLOCK ***** 34 | } 35 | 36 | 37 | unit FmBaseDlg; 38 | 39 | 40 | interface 41 | 42 | 43 | uses 44 | // Project 45 | FmBase; 46 | 47 | 48 | type 49 | { 50 | TBaseDlgForm: 51 | Base class for forms that provides the ancestor of all forms that act as 52 | dialog boxes in the application. Ensures that dialog boxes have the owner 53 | form as a parent window. 54 | } 55 | TBaseDlgForm = class(TBaseForm) 56 | procedure FormCreate(Sender: TObject); 57 | private 58 | procedure SetParentToOwner; 59 | {Sets handle of form's owner as parent of this form's window. If owner has 60 | no handle, or is nil either active form or application's main form is used 61 | as parent. 62 | } 63 | end; 64 | 65 | 66 | implementation 67 | 68 | 69 | uses 70 | // Delphi 71 | Controls, Forms, Windows; 72 | 73 | 74 | {$R *.dfm} 75 | 76 | procedure TBaseDlgForm.FormCreate(Sender: TObject); 77 | {Handles form's OnCreate event. Ensures that any owner form's handle is this 78 | form's parent. 79 | @param Sender [in] Not used. 80 | } 81 | begin 82 | inherited; 83 | SetParentToOwner; 84 | end; 85 | 86 | procedure TBaseDlgForm.SetParentToOwner; 87 | {Sets handle of form's owner as parent of this form's window. If owner has no 88 | handle, or is nil either active form or application's main form is used as 89 | parent. 90 | } 91 | var 92 | ParentWnd: THandle; // window handle of parent control 93 | begin 94 | // Get parent handle 95 | if Assigned(Owner) and (Owner is TWinControl) then 96 | ParentWnd := (Owner as TWinControl).Handle 97 | else if Assigned(Screen.ActiveCustomForm) then 98 | ParentWnd := Screen.ActiveCustomForm.Handle 99 | else if Assigned(Application.MainForm) then 100 | ParentWnd := Application.MainForm.Handle 101 | else 102 | ParentWnd := Application.Handle; 103 | Assert(ParentWnd <> 0, // ** do not localise 104 | 'TBaseDlgForm.SetParentToOwner: Can''t get parent window'); 105 | // Set form's window handle 106 | SetWindowLong(Handle, GWL_HWNDPARENT, ParentWnd); 107 | end; 108 | 109 | end. 110 | 111 | -------------------------------------------------------------------------------- /Src/FmViewer.dfm: -------------------------------------------------------------------------------- 1 | inherited ViewerDlg: TViewerDlg 2 | Left = 360 3 | Top = 207 4 | Width = 721 5 | Height = 447 6 | Caption = 'Clipboard Viewer' 7 | OnClose = FormClose 8 | PixelsPerInch = 96 9 | TextHeight = 13 10 | object pnlView: TPanel 11 | Left = 0 12 | Top = 0 13 | Width = 705 14 | Height = 378 15 | Align = alClient 16 | BevelOuter = bvNone 17 | Color = clAppWorkSpace 18 | TabOrder = 0 19 | end 20 | object pnlBottom: TPanel 21 | Left = 0 22 | Top = 378 23 | Width = 705 24 | Height = 33 25 | Align = alBottom 26 | TabOrder = 1 27 | DesignSize = ( 28 | 705 29 | 33) 30 | object btnClose: TButton 31 | Left = 626 32 | Top = 5 33 | Width = 75 34 | Height = 25 35 | Action = actClose 36 | Anchors = [akTop, akRight] 37 | Cancel = True 38 | TabOrder = 1 39 | end 40 | object btnHelp: TButton 41 | Left = 543 42 | Top = 5 43 | Width = 75 44 | Height = 25 45 | Action = actHelp 46 | Anchors = [akTop, akRight] 47 | TabOrder = 0 48 | end 49 | end 50 | object alMain: TActionList 51 | Left = 8 52 | Top = 8 53 | object actHelp: TAction 54 | Caption = '&Help' 55 | ShortCut = 112 56 | OnExecute = actHelpExecute 57 | end 58 | object actClose: TAction 59 | Caption = 'Close' 60 | ShortCut = 27 61 | OnExecute = actCloseExecute 62 | end 63 | end 64 | object wsViewer: TPJUserWdwState 65 | AutoSaveRestore = True 66 | Options = [woFitWorkArea] 67 | OnReadData = wsViewerReadData 68 | OnSaveData = wsViewerSaveData 69 | Left = 37 70 | Top = 8 71 | end 72 | end 73 | -------------------------------------------------------------------------------- /Src/FrBinaryViewer.dfm: -------------------------------------------------------------------------------- 1 | object BinaryViewerFrame: TBinaryViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 342 5 | Height = 264 6 | TabOrder = 0 7 | object sbView: TScrollBox 8 | Left = 0 9 | Top = 0 10 | Width = 342 11 | Height = 264 12 | HorzScrollBar.Tracking = True 13 | VertScrollBar.Tracking = True 14 | Align = alClient 15 | BorderStyle = bsNone 16 | Color = clWindow 17 | ParentColor = False 18 | TabOrder = 0 19 | TabStop = True 20 | OnResize = sbViewResize 21 | object pbView: TPaintBox 22 | Left = 0 23 | Top = 0 24 | Width = 600 25 | Height = 264 26 | Font.Charset = ANSI_CHARSET 27 | Font.Color = clWindowText 28 | Font.Height = -12 29 | Font.Name = 'Courier New' 30 | Font.Style = [] 31 | ParentFont = False 32 | OnPaint = pbViewPaint 33 | end 34 | end 35 | object alView: TActionList 36 | Left = 56 37 | Top = 32 38 | object actPgUp: TAction 39 | Caption = 'actPgUp' 40 | ShortCut = 33 41 | OnExecute = actPgUpExecute 42 | end 43 | object actPgDn: TAction 44 | Caption = 'actPgDn' 45 | ShortCut = 34 46 | OnExecute = actPgDnExecute 47 | end 48 | object actUp: TAction 49 | Caption = 'actUp' 50 | ShortCut = 38 51 | OnExecute = actUpExecute 52 | end 53 | object actDown: TAction 54 | Caption = 'actDown' 55 | ShortCut = 40 56 | OnExecute = actDownExecute 57 | end 58 | object actDocHome: TAction 59 | Caption = 'actDocHome' 60 | ShortCut = 16420 61 | OnExecute = actDocHomeExecute 62 | end 63 | object actDocEnd: TAction 64 | Caption = 'actDocEnd' 65 | ShortCut = 16419 66 | OnExecute = actDocEndExecute 67 | end 68 | object actLineHome: TAction 69 | Caption = 'actLineHome' 70 | ShortCut = 36 71 | OnExecute = actLineHomeExecute 72 | end 73 | object actLineEnd: TAction 74 | Caption = 'actLineEnd' 75 | ShortCut = 35 76 | OnExecute = actLineEndExecute 77 | end 78 | object actRight: TAction 79 | Caption = 'actRight' 80 | ShortCut = 39 81 | OnExecute = actRightExecute 82 | end 83 | object actLeft: TAction 84 | Caption = 'actLeft' 85 | ShortCut = 37 86 | OnExecute = actLeftExecute 87 | end 88 | end 89 | end 90 | -------------------------------------------------------------------------------- /Src/FrFileGroupDescViewer.dfm: -------------------------------------------------------------------------------- 1 | object FileGroupDescViewerFrame: TFileGroupDescViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | object tvView: TTreeView 8 | Left = 0 9 | Top = 0 10 | Width = 320 11 | Height = 240 12 | Align = alClient 13 | BorderStyle = bsNone 14 | Indent = 19 15 | PopupMenu = mnuView 16 | ReadOnly = True 17 | TabOrder = 0 18 | TabStop = False 19 | end 20 | object mnuView: TPopupMenu 21 | AutoHotkeys = maManual 22 | Left = 56 23 | Top = 24 24 | object miCopy: TMenuItem 25 | Action = actCopy 26 | end 27 | end 28 | object alView: TActionList 29 | Left = 88 30 | Top = 24 31 | object actCopy: TAction 32 | Caption = 'Copy File Names' 33 | ShortCut = 16451 34 | OnExecute = actCopyExecute 35 | OnUpdate = actCopyUpdate 36 | end 37 | end 38 | end 39 | -------------------------------------------------------------------------------- /Src/FrFileNameViewer.dfm: -------------------------------------------------------------------------------- 1 | inherited FileNameViewerFrame: TFileNameViewerFrame 2 | inherited pnlView: TPanel 3 | inherited lblName: TLabel 4 | Width = 50 5 | Caption = 'File Name:' 6 | end 7 | end 8 | inherited alView: TActionList 9 | inherited actExec: TAction 10 | OnExecute = actExecExecute 11 | end 12 | end 13 | end 14 | -------------------------------------------------------------------------------- /Src/FrFileNameViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrFileNameViewer.pas 3 | * 4 | * Implements a viewer frame that can display file and folder names specified as 5 | * text. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is FrFileNameViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit FrFileNameViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Menus, StdActns, Classes, ActnList, StdCtrls, Controls, ExtCtrls, 45 | // Project 46 | FrShellNameViewer; 47 | 48 | 49 | type 50 | { 51 | TFileNameViewerFrame: 52 | Viewer frame that can display file names specified as text. Executes 53 | applications and file with associated applications. Displays folders in 54 | Explorer. Supports selection of file name and copying of file name to 55 | clipboard as text. 56 | } 57 | TFileNameViewerFrame = class(TShellNameViewerFrame) 58 | procedure actExecUpdate(Sender: TObject); 59 | procedure actExecExecute(Sender: TObject); 60 | end; 61 | 62 | 63 | implementation 64 | 65 | 66 | uses 67 | // Delphi 68 | SysUtils, 69 | // Project 70 | UFileLists, UMessageBox, UProcessUtils; 71 | 72 | 73 | {$R *.dfm} 74 | 75 | procedure TFileNameViewerFrame.actExecExecute(Sender: TObject); 76 | {Attempts the open the named file, or display contents in explorer if it is a 77 | folder. 78 | @param Sender [in] Not used. 79 | } 80 | resourcestring 81 | // Error messages 82 | sCantExplore = 'Can''t explore this folder:'#10#10'%s'; 83 | sCantOpen = 'Don''t know how to open this file:'#10#10'%s'; 84 | var 85 | FI: TFileInfo; // object providing info about the file 86 | begin 87 | if actExec.Enabled then 88 | begin 89 | // get file info 90 | FI := TFileInfo.Create(edName.Text); 91 | try 92 | if FI.IsDirectory then 93 | begin 94 | // directory: open explorer 95 | if not ExploreFolder(FI.Name) then 96 | TMessageBox.Error(Self, Format(sCantExplore, [FI.Name])); 97 | end 98 | else 99 | begin 100 | // file: try to open 101 | if not OpenFile(FI.Name) then 102 | TMessageBox.Error(Self, Format(sCantOpen, [FI.Name])); 103 | end; 104 | finally 105 | FreeAndNil(FI); 106 | end; 107 | end; 108 | end; 109 | 110 | procedure TFileNameViewerFrame.actExecUpdate(Sender: TObject); 111 | {Sets the caption of the execute action depending on if file is true file or 112 | directory. 113 | @param Sender [in] Not used. 114 | } 115 | resourcestring 116 | // Alternative action captions 117 | sOpen = '&Open'; 118 | sExplore = '&Explore'; 119 | var 120 | FI: TFileInfo; 121 | begin 122 | inherited; // this sets Enabled property 123 | if actExec.Enabled then 124 | begin 125 | // get file info 126 | FI := TFileInfo.Create(edName.Text); 127 | try 128 | if FI.IsDirectory then 129 | actExec.Caption := sExplore 130 | else 131 | actExec.Caption := sOpen; 132 | finally 133 | FreeAndNil(FI); 134 | end; 135 | end; 136 | end; 137 | 138 | end. 139 | 140 | -------------------------------------------------------------------------------- /Src/FrGraphicViewer.dfm: -------------------------------------------------------------------------------- 1 | object GraphicViewerFrame: TGraphicViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | OnResize = FrameResize 8 | object sbView: TScrollBox 9 | Left = 0 10 | Top = 0 11 | Width = 320 12 | Height = 240 13 | AutoSize = True 14 | BorderStyle = bsNone 15 | TabOrder = 0 16 | object imgView: TImage 17 | Left = 0 18 | Top = 0 19 | Width = 320 20 | Height = 240 21 | PopupMenu = mnuView 22 | end 23 | end 24 | object alView: TActionList 25 | Left = 24 26 | Top = 24 27 | object actCopy: TAction 28 | Caption = 'Copy' 29 | ShortCut = 16451 30 | OnExecute = actCopyExecute 31 | end 32 | end 33 | object mnuView: TPopupMenu 34 | Left = 64 35 | Top = 24 36 | object miCopy: TMenuItem 37 | Action = actCopy 38 | end 39 | end 40 | end 41 | -------------------------------------------------------------------------------- /Src/FrGraphicViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrGraphicViewer.pas 3 | * 4 | * Implements a viewer frame that displays a TGraphic descendant. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is FrGraphicViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit FrGraphicViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Forms, Menus, Classes, ActnList, Controls, ExtCtrls, Graphics; 44 | 45 | 46 | type 47 | 48 | { 49 | TGraphicViewerFrame: 50 | Viewer frame that displays a TGraphic descendant. Supports copying of the 51 | graphic to the clipboard. 52 | } 53 | TGraphicViewerFrame = class(TFrame) 54 | actCopy: TAction; 55 | alView: TActionList; 56 | imgView: TImage; 57 | miCopy: TMenuItem; 58 | mnuView: TPopupMenu; 59 | sbView: TScrollBox; 60 | procedure actCopyExecute(Sender: TObject); 61 | procedure FrameResize(Sender: TObject); 62 | private 63 | procedure ArrangeControls; 64 | {Aligns image within display. If image is smaller than display it is centred. 65 | } 66 | public 67 | procedure Display(const Graphic: TGraphic); 68 | {Displays a graphic. 69 | @param Graphic [in] Graphic to be displayed. 70 | } 71 | end; 72 | 73 | 74 | implementation 75 | 76 | 77 | uses 78 | // Delphi 79 | Windows, Clipbrd, 80 | // Project 81 | UClipFmt; 82 | 83 | 84 | {$R *.dfm} 85 | 86 | { TGraphicViewerFrame } 87 | 88 | procedure TGraphicViewerFrame.actCopyExecute(Sender: TObject); 89 | {Copies the displayed graphic object to the clipboard. Clipboard format 90 | depends on type of graphic. If a palette is used it is also copied. 91 | @param Sender [in] Not used. 92 | @except Raises exception if displayed graphic does not support clipboard. 93 | } 94 | var 95 | ImgFmt: Word; // image format to be used 96 | ImgHandle: THandle; // handle to image being copied 97 | PaletteHandle: HPALETTE; // handle to palette (0 if no palette) 98 | begin 99 | // Get clipboard format for image (supported by TBitmap and TMetafile) 100 | imgView.Picture.SaveToClipboardFormat(ImgFmt, ImgHandle, PaletteHandle); 101 | Clipboard.Open; 102 | try 103 | // Store image on clipboard 104 | Clipboard.SetAsHandle(ImgFmt, ImgHandle); 105 | if PaletteHandle <> 0 then 106 | // We also have a palette: store this on clipboard 107 | Clipboard.SetAsHandle(CF_PALETTE, PaletteHandle); 108 | finally 109 | Clipboard.Close; 110 | end; 111 | end; 112 | 113 | procedure TGraphicViewerFrame.ArrangeControls; 114 | {Aligns image within display. If image is smaller than display it is centred. 115 | } 116 | begin 117 | if sbView.Width < ClientWidth then 118 | sbView.Left := (ClientWidth - sbView.Width) div 2 119 | else 120 | sbView.Left := 0; 121 | if sbView.Height < ClientHeight then 122 | sbView.Top := (ClientHeight - sbView.Height) div 2 123 | else 124 | sbView.Top := 0; 125 | end; 126 | 127 | procedure TGraphicViewerFrame.Display(const Graphic: TGraphic); 128 | {Displays a graphic. 129 | @param Graphic [in] Graphic to be displayed. 130 | } 131 | begin 132 | // store graphic in image control and make image control same size as image 133 | imgView.Picture.Assign(Graphic); 134 | imgView.Width := Graphic.Width; 135 | imgView.Height := Graphic.Height; 136 | // make scroll box same size as image 137 | sbView.Width := imgView.Width; 138 | sbView.Height := imgView.Height; 139 | // align image within frame 140 | ArrangeControls; 141 | end; 142 | 143 | procedure TGraphicViewerFrame.FrameResize(Sender: TObject); 144 | {Called when frame is resized. Re-aligns image within frame. 145 | @param Sender [in] Not used. 146 | } 147 | begin 148 | ArrangeControls; 149 | end; 150 | 151 | end. 152 | 153 | -------------------------------------------------------------------------------- /Src/FrHTMLClipViewer.dfm: -------------------------------------------------------------------------------- 1 | inherited HTMLClipViewerFrame: THTMLClipViewerFrame 2 | Width = 338 3 | inherited pnlHost: TPanel 4 | Top = 97 5 | Width = 338 6 | Height = 143 7 | inherited wbView: TWebBrowser 8 | Width = 338 9 | Height = 143 10 | ControlData = { 11 | 4C00000013210000CE1800000000000000000000000000000000000000000000 12 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 13 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 14 | 8000000000000000000000000000000000000000000000000000000000000000 15 | 00000000000000000100000000000000000000000000000000000000} 16 | end 17 | end 18 | object pnlProperties: TPanel [1] 19 | Left = 0 20 | Top = 0 21 | Width = 338 22 | Height = 97 23 | Align = alTop 24 | TabOrder = 1 25 | DesignSize = ( 26 | 338 27 | 97) 28 | object lblVersionCaption: TLabel 29 | Left = 8 30 | Top = 8 31 | Width = 55 32 | Height = 13 33 | Caption = 'Clip Version' 34 | end 35 | object lblContextCaption: TLabel 36 | Left = 8 37 | Top = 24 38 | Width = 36 39 | Height = 13 40 | Caption = 'Context' 41 | end 42 | object lblFragment: TLabel 43 | Left = 104 44 | Top = 40 45 | Width = 227 46 | Height = 13 47 | Anchors = [akLeft, akTop, akRight] 48 | AutoSize = False 49 | end 50 | object lblVersion: TLabel 51 | Left = 104 52 | Top = 8 53 | Width = 227 54 | Height = 13 55 | Anchors = [akLeft, akTop, akRight] 56 | AutoSize = False 57 | end 58 | object lblContext: TLabel 59 | Left = 104 60 | Top = 24 61 | Width = 227 62 | Height = 13 63 | Anchors = [akLeft, akTop, akRight] 64 | AutoSize = False 65 | end 66 | object lblFragmentCaption: TLabel 67 | Left = 8 68 | Top = 40 69 | Width = 44 70 | Height = 13 71 | Caption = 'Fragment' 72 | end 73 | object lblSelection: TLabel 74 | Left = 104 75 | Top = 56 76 | Width = 227 77 | Height = 13 78 | Anchors = [akLeft, akTop, akRight] 79 | AutoSize = False 80 | end 81 | object lblSelectionCaption: TLabel 82 | Left = 8 83 | Top = 56 84 | Width = 44 85 | Height = 13 86 | Caption = 'Selection' 87 | end 88 | object lblURLCaption: TLabel 89 | Left = 8 90 | Top = 72 91 | Width = 59 92 | Height = 13 93 | Caption = 'Source URL' 94 | end 95 | object lblURL: TLabel 96 | Left = 104 97 | Top = 72 98 | Width = 227 99 | Height = 13 100 | Anchors = [akLeft, akTop, akRight] 101 | AutoSize = False 102 | end 103 | end 104 | inherited mnuView: TPopupMenu 105 | Left = 128 106 | end 107 | end 108 | -------------------------------------------------------------------------------- /Src/FrHTMLClipViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrHTMLClipViewer.pas 3 | * 4 | * Implements a viewer frame that displays HTML clips, including information 5 | * about the clip and the clip's properties. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is FrHTMLClipViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit FrHTMLClipViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Controls, StdCtrls, Classes, ActnList, Menus, OleCtrls, SHDocVw, ExtCtrls, 45 | // Project 46 | FrHTMLViewer, UHTMLClip; 47 | 48 | 49 | type 50 | 51 | { 52 | THTMLClipViewerFrame: 53 | Viewer frame that displays HTML clips, including information about the clip 54 | and the clip's properties. Uses a default style sheet loaded from resources 55 | when displaying HTML. Supports selecting and copying of selections of 56 | HTML document to clipboard as text, HTML and rich text. 57 | } 58 | THTMLClipViewerFrame = class(THTMLViewerFrame) 59 | pnlProperties: TPanel; 60 | lblVersionCaption: TLabel; 61 | lblContextCaption: TLabel; 62 | lblFragment: TLabel; 63 | lblVersion: TLabel; 64 | lblContext: TLabel; 65 | lblFragmentCaption: TLabel; 66 | lblSelection: TLabel; 67 | lblSelectionCaption: TLabel; 68 | lblURLCaption: TLabel; 69 | lblURL: TLabel; 70 | public 71 | procedure Display(const Clip: THTMLClip); 72 | {Displays information about an HTML clip, including the clip's properties 73 | and contained HTML. 74 | @param Clip [in] Object containing details of the clip's properties and 75 | HTML. 76 | } 77 | end; 78 | 79 | 80 | implementation 81 | 82 | 83 | uses 84 | // Project 85 | SysUtils; 86 | 87 | 88 | {$R *.dfm} 89 | 90 | { THTMLClipViewerFrame } 91 | 92 | procedure THTMLClipViewerFrame.Display(const Clip: THTMLClip); 93 | {Displays information about an HTML clip, including the clip's properties and 94 | contained HTML. 95 | @param Clip [in] Object containing details of the clip's properties and 96 | HTML. 97 | } 98 | resourcestring 99 | // Messages displayed in properties pane 100 | sNoProperty = 'Not specified'; 101 | sSectionInfo = 'Offset %0:d, Length %0.d'; 102 | begin 103 | // Display clip properties 104 | // version: always present 105 | lblVersion.Caption := Clip.Version; 106 | // context: may be missing 107 | if Clip.Context.IsPresent then 108 | lblContext.Caption := Format( 109 | sSectionInfo, [Clip.Context.StartPos, Clip.Context.Size] 110 | ) 111 | else 112 | lblContext.Caption := sNoProperty; 113 | // fragment: always present 114 | lblFragment.Caption := Format( 115 | sSectionInfo, [Clip.Fragment.StartPos, Clip.Fragment.Size] 116 | ); 117 | // selection: may be missing 118 | if Clip.Selection.IsPresent then 119 | lblSelection.Caption := Format( 120 | sSectionInfo, [Clip.Selection.StartPos, Clip.Selection.Size] 121 | ) 122 | else 123 | lblSelection.Caption := sNoProperty; 124 | // source url: may be missing 125 | if Clip.SourceURL <> '' then 126 | lblURL.Caption := Clip.SourceURL 127 | else 128 | lblURL.Caption := sNoProperty; 129 | // Display HTML 130 | inherited Display(Clip.DisplayHTML); 131 | end; 132 | 133 | end. 134 | 135 | -------------------------------------------------------------------------------- /Src/FrHTMLViewer.dfm: -------------------------------------------------------------------------------- 1 | object HTMLViewerFrame: THTMLViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | HelpContext = 4 7 | TabOrder = 0 8 | object pnlHost: TPanel 9 | Left = 0 10 | Top = 0 11 | Width = 320 12 | Height = 240 13 | Align = alClient 14 | BevelOuter = bvNone 15 | TabOrder = 0 16 | object wbView: TWebBrowser 17 | Left = 0 18 | Top = 0 19 | Width = 320 20 | Height = 240 21 | TabStop = False 22 | Align = alClient 23 | TabOrder = 0 24 | ControlData = { 25 | 4C00000013210000CE1800000000000000000000000000000000000000000000 26 | 000000004C000000000000000000000001000000E0D057007335CF11AE690800 27 | 2B2E126208000000000000004C0000000114020000000000C000000000000046 28 | 8000000000000000000000000000000000000000000000000000000000000000 29 | 00000000000000000100000000000000000000000000000000000000} 30 | end 31 | end 32 | object mnuView: TPopupMenu 33 | AutoHotkeys = maManual 34 | AutoPopup = False 35 | Left = 16 36 | Top = 16 37 | object miCopy: TMenuItem 38 | Action = actCopy 39 | end 40 | object miSelectAll: TMenuItem 41 | Action = actSelectAll 42 | end 43 | end 44 | object alView: TActionList 45 | Left = 96 46 | Top = 16 47 | object actCopy: TAction 48 | Caption = 'Copy' 49 | ShortCut = 16451 50 | OnExecute = actCopyExecute 51 | OnUpdate = actCopyUpdate 52 | end 53 | object actSelectAll: TAction 54 | Caption = 'Select All' 55 | ShortCut = 16449 56 | OnExecute = actSelectAllExecute 57 | OnUpdate = actSelectAllUpdate 58 | end 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /Src/FrLocaleViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrLocaleViewer.pas 3 | * 4 | * Implements a viewer frame that displays selected information about a locale. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is FrLocaleViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit FrLocaleViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Forms, Menus, StdActns, Classes, ActnList, StdCtrls, Controls, ExtCtrls, 44 | Windows; 45 | 46 | 47 | type 48 | { 49 | TLocaleViewerFrame: 50 | Viewer frame that displays selected information about a locale in read only 51 | edit controls. Supports selecting and copying text from each edit control. 52 | } 53 | TLocaleViewerFrame = class(TFrame) 54 | actCopy: TEditCopy; 55 | actSelectAll: TEditSelectAll; 56 | alView: TActionList; 57 | edAbbrevCountryName: TEdit; 58 | edAbbrevLangName: TEdit; 59 | edCountryCode: TEdit; 60 | edCountryName: TEdit; 61 | edDefCodePage: TEdit; 62 | edEngCountryName: TEdit; 63 | edISOLangName: TEdit; 64 | edLangID: TEdit; 65 | edLangName: TEdit; 66 | lblAbbrevCountryName: TLabel; 67 | lblAbbrevLangName: TLabel; 68 | lblCountry: TLabel; 69 | lblCountryCode: TLabel; 70 | lblCountryName: TLabel; 71 | lblDefCodePage: TLabel; 72 | lblEngCountryName: TLabel; 73 | lblEngLangName: TLabel; 74 | lblLangID: TLabel; 75 | lblLangName: TLabel; 76 | lblLanguage: TLabel; 77 | miCopy: TMenuItem; 78 | miSelectAll: TMenuItem; 79 | mnuView: TPopupMenu; 80 | pnlView: TPanel; 81 | sbView: TScrollBox; 82 | public 83 | procedure Display(const Locale: LCID); 84 | {Displays information about a specified locale. 85 | @param Locale [in] Locale identifier for which info is to be displayed. 86 | } 87 | end; 88 | 89 | 90 | implementation 91 | 92 | 93 | uses 94 | // Delphi 95 | SysUtils, 96 | // Project 97 | ULocale; 98 | 99 | 100 | {$R *.dfm} 101 | 102 | 103 | { TLocaleViewerFrame } 104 | 105 | procedure TLocaleViewerFrame.Display(const Locale: LCID); 106 | {Displays information about a specified locale. 107 | @param Locale [in] Locale identifier for which info is to be displayed. 108 | } 109 | 110 | // --------------------------------------------------------------------------- 111 | function LocaleInfo(const InfoType: LCTYPE): string; 112 | {Gets a specified piece of information from Locale. 113 | @param InfoType [in] Type of information required. Must be one of LOCALE_ 114 | LCTYPE flags. 115 | @return Required information as string. 116 | @except Exception raised if can't get locale info. 117 | } 118 | begin 119 | GetLocaleData(Locale, InfoType, Result); 120 | end; 121 | // --------------------------------------------------------------------------- 122 | 123 | begin 124 | // We need to refresh scroll box to ensure labels display properly 125 | sbView.Refresh; 126 | // Store required locale information in edit controls 127 | edLangID.Text := LocaleInfo(LOCALE_ILANGUAGE); 128 | edLangName.Text := LocaleInfo(LOCALE_SLANGUAGE); 129 | edISOLangName.Text := LocaleInfo(LOCALE_SENGLANGUAGE); 130 | edAbbrevLangName.Text := LocaleInfo(LOCALE_SABBREVLANGNAME); 131 | edCountryCode.Text := LocaleInfo(LOCALE_ICOUNTRY); 132 | edCountryName.Text := LocaleInfo(LOCALE_SCOUNTRY); 133 | edEngCountryName.Text := LocaleInfo(LOCALE_SENGCOUNTRY); 134 | edAbbrevCountryName.Text := LocaleInfo(LOCALE_SABBREVCTRYNAME); 135 | edDefCodePage.Text := LocaleInfo(LOCALE_IDEFAULTCODEPAGE); 136 | end; 137 | 138 | end. 139 | 140 | -------------------------------------------------------------------------------- /Src/FrObjDescViewer.dfm: -------------------------------------------------------------------------------- 1 | object ObjDescViewerFrame: TObjDescViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 463 5 | Height = 161 6 | TabOrder = 0 7 | object pnlView: TPanel 8 | Left = 0 9 | Top = 0 10 | Width = 463 11 | Height = 161 12 | Align = alClient 13 | BevelOuter = bvNone 14 | TabOrder = 0 15 | object sbView: TScrollBox 16 | Left = 0 17 | Top = 0 18 | Width = 463 19 | Height = 161 20 | Align = alClient 21 | BorderStyle = bsNone 22 | TabOrder = 0 23 | DesignSize = ( 24 | 463 25 | 161) 26 | object lblClassID: TLabel 27 | Left = 8 28 | Top = 12 29 | Width = 31 30 | Height = 13 31 | Caption = 'CLSID' 32 | end 33 | object lblDrawAspect: TLabel 34 | Left = 8 35 | Top = 36 36 | Width = 61 37 | Height = 13 38 | Caption = 'Draw Aspect' 39 | end 40 | object lblSize: TLabel 41 | Left = 8 42 | Top = 60 43 | Width = 54 44 | Height = 13 45 | Caption = 'Object Size' 46 | end 47 | object lblStatus: TLabel 48 | Left = 8 49 | Top = 84 50 | Width = 58 51 | Height = 13 52 | Caption = 'Status Flags' 53 | end 54 | object lblFullUserTypeName: TLabel 55 | Left = 8 56 | Top = 108 57 | Width = 99 58 | Height = 13 59 | Caption = 'Full User Type Name' 60 | end 61 | object lblSrcOfCopy: TLabel 62 | Left = 8 63 | Top = 132 64 | Width = 75 65 | Height = 13 66 | Caption = 'Source Of Copy' 67 | end 68 | object edCLSID: TEdit 69 | Left = 116 70 | Top = 8 71 | Width = 237 72 | Height = 21 73 | TabStop = False 74 | ParentColor = True 75 | PopupMenu = mnuView 76 | ReadOnly = True 77 | TabOrder = 0 78 | end 79 | object edDrawAspect: TEdit 80 | Left = 116 81 | Top = 32 82 | Width = 237 83 | Height = 21 84 | TabStop = False 85 | ParentColor = True 86 | PopupMenu = mnuView 87 | ReadOnly = True 88 | TabOrder = 1 89 | end 90 | object edSize: TEdit 91 | Left = 116 92 | Top = 56 93 | Width = 237 94 | Height = 21 95 | TabStop = False 96 | ParentColor = True 97 | PopupMenu = mnuView 98 | ReadOnly = True 99 | TabOrder = 2 100 | end 101 | object edStatus: TEdit 102 | Left = 116 103 | Top = 80 104 | Width = 37 105 | Height = 21 106 | TabStop = False 107 | ParentColor = True 108 | PopupMenu = mnuView 109 | ReadOnly = True 110 | TabOrder = 3 111 | end 112 | object edFullUserTypeName: TEdit 113 | Left = 116 114 | Top = 104 115 | Width = 341 116 | Height = 21 117 | TabStop = False 118 | Anchors = [akLeft, akTop, akRight] 119 | ParentColor = True 120 | PopupMenu = mnuView 121 | ReadOnly = True 122 | TabOrder = 4 123 | end 124 | object edSrcOfCopy: TEdit 125 | Left = 116 126 | Top = 128 127 | Width = 341 128 | Height = 21 129 | TabStop = False 130 | Anchors = [akLeft, akTop, akRight] 131 | ParentColor = True 132 | PopupMenu = mnuView 133 | ReadOnly = True 134 | TabOrder = 5 135 | end 136 | end 137 | end 138 | object alView: TActionList 139 | Left = 368 140 | Top = 8 141 | object actCopy: TEditCopy 142 | Category = 'Edit' 143 | Caption = 'Copy' 144 | ShortCut = 16451 145 | end 146 | object actSelectAll: TEditSelectAll 147 | Category = 'Edit' 148 | Caption = 'Select All' 149 | ShortCut = 16449 150 | end 151 | end 152 | object mnuView: TPopupMenu 153 | Left = 400 154 | Top = 8 155 | object miCopy: TMenuItem 156 | Action = actCopy 157 | end 158 | object miSelectAll: TMenuItem 159 | Action = actSelectAll 160 | end 161 | end 162 | end 163 | -------------------------------------------------------------------------------- /Src/FrObjDescViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrObjDescViewer.pas 3 | * 4 | * Implements a viewer frame that information about displays object and link 5 | * source descriptors. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is FrObjDescViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit FrObjDescViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Menus, StdActns, Classes, ActnList, StdCtrls, Controls, ExtCtrls, Forms, 45 | // Project 46 | UObjDescAdapter; 47 | 48 | 49 | type 50 | 51 | { 52 | TObjDescViewerFrame: 53 | Viewer frame that displays information about object and link source 54 | descriptors in read-only edit controls. Supports selecting and copying of 55 | text in edit controls as text. 56 | } 57 | TObjDescViewerFrame = class(TFrame) 58 | actCopy: TEditCopy; 59 | actSelectAll: TEditSelectAll; 60 | alView: TActionList; 61 | edCLSID: TEdit; 62 | edDrawAspect: TEdit; 63 | edFullUserTypeName: TEdit; 64 | edSize: TEdit; 65 | edSrcOfCopy: TEdit; 66 | edStatus: TEdit; 67 | lblClassID: TLabel; 68 | lblDrawAspect: TLabel; 69 | lblFullUserTypeName: TLabel; 70 | lblSize: TLabel; 71 | lblSrcOfCopy: TLabel; 72 | lblStatus: TLabel; 73 | miCopy: TMenuItem; 74 | miSelectAll: TMenuItem; 75 | mnuView: TPopupMenu; 76 | pnlView: TPanel; 77 | sbView: TScrollBox; 78 | public 79 | procedure Display(const ObjDesc: TObjDescAdapter); 80 | {Displays information about an object or link source descriptor. 81 | @param ObjDesc [in] Object that contains information about the 82 | descriptor. 83 | } 84 | end; 85 | 86 | 87 | implementation 88 | 89 | 90 | uses 91 | // Delphi 92 | SysUtils, ActiveX; 93 | 94 | 95 | {$R *.dfm} 96 | 97 | 98 | { TObjDescViewerFrame } 99 | 100 | procedure TObjDescViewerFrame.Display(const ObjDesc: TObjDescAdapter); 101 | {Displays information about an object or link source descriptor. 102 | @param ObjDesc [in] Object that contains information about the descriptor. 103 | } 104 | resourcestring 105 | // Display text 106 | sBadDrawAspect = 'Unknown'; 107 | sNonSourceAspect = 'Source did not draw'; 108 | sNotSpecified = 'Not specified'; 109 | sExtent = 'Width: %0:d, Height: %1:d'; 110 | begin 111 | // We need to refresh scroll box to ensure labels display properly 112 | sbView.Refresh; 113 | // Store required object descriptions in edit controls 114 | edCLSID.Text := GUIDToString(ObjDesc.CLSID); 115 | case ObjDesc.DrawAspect of 116 | 0: edDrawAspect.Text := sNonSourceAspect; 117 | DVASPECT_CONTENT: edDrawAspect.Text := 'DVASPECT_CONTENT'; 118 | DVASPECT_THUMBNAIL: edDrawAspect.Text := 'DVASPECT_THUMBNAIL'; 119 | DVASPECT_ICON: edDrawAspect.Text := 'DVASPECT_ICON'; 120 | DVASPECT_DOCPRINT: edDrawAspect.Text := 'DVASPECT_DOCPRINT'; 121 | else edDrawAspect.Text := sBadDrawAspect; 122 | end; 123 | if (ObjDesc.Extent.cx = 0) and (ObjDesc.Extent.cy = 0) then 124 | edSize.Text := sNotSpecified 125 | else 126 | edSize.Text := Format(sExtent, [ObjDesc.Extent.cx, ObjDesc.Extent.cy]); 127 | edStatus.Text := Format('%0.4X', [ObjDesc.Status]); 128 | edFullUserTypeName.Text := ObjDesc.FullUserTypeName; 129 | edSrcOfCopy.Text := ObjDesc.SrcOfCopy; 130 | end; 131 | 132 | end. 133 | 134 | -------------------------------------------------------------------------------- /Src/FrRTFViewer.dfm: -------------------------------------------------------------------------------- 1 | object RTFViewerFrame: TRTFViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | object reView: TRichEdit 8 | Left = 0 9 | Top = 0 10 | Width = 320 11 | Height = 240 12 | TabStop = False 13 | Align = alClient 14 | BorderStyle = bsNone 15 | ParentFont = False 16 | PopupMenu = mnuView 17 | ReadOnly = True 18 | ScrollBars = ssBoth 19 | TabOrder = 0 20 | end 21 | object mnuView: TPopupMenu 22 | AutoHotkeys = maManual 23 | Left = 40 24 | Top = 16 25 | object miCopy: TMenuItem 26 | Action = actCopy 27 | end 28 | object miSelectAll: TMenuItem 29 | Action = actSelectAll 30 | end 31 | end 32 | object alView: TActionList 33 | Left = 72 34 | Top = 16 35 | object actCopy: TEditCopy 36 | Category = 'Edit' 37 | Caption = 'Copy' 38 | ImageIndex = 1 39 | ShortCut = 16451 40 | end 41 | object actSelectAll: TEditSelectAll 42 | Category = 'Edit' 43 | Caption = 'Select All' 44 | ShortCut = 16449 45 | end 46 | end 47 | end 48 | -------------------------------------------------------------------------------- /Src/FrRTFViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrRTFViewer.pas 3 | * 4 | * Implements a viewer frame that displays rich text format documents. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is FrRTFViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2010 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit FrRTFViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | SysUtils, Forms, StdActns, Classes, ActnList, Menus, Controls, StdCtrls, 44 | ComCtrls; 45 | 46 | 47 | type 48 | 49 | { 50 | TRTFViewerFrame: 51 | Viewer frame that displays rich text format documents using provided ASCII 52 | encoded RTF source. Supports selecting and copying of selections to 53 | clipboard as text and rich text. 54 | } 55 | TRTFViewerFrame = class(TFrame) 56 | reView: TRichEdit; 57 | mnuView: TPopupMenu; 58 | miCopy: TMenuItem; 59 | miSelectAll: TMenuItem; 60 | alView: TActionList; 61 | actCopy: TEditCopy; 62 | actSelectAll: TEditSelectAll; 63 | private 64 | procedure SetMargins; 65 | {Sets left and right margins in rich edit control. 66 | } 67 | public 68 | procedure Display(const RTF: TBytes); 69 | {Displays RTF in rich edit control. 70 | @param RTF [in] Byte array containing ASCII encoded RTF code to be 71 | displayed. 72 | } 73 | end; 74 | 75 | 76 | implementation 77 | 78 | 79 | uses 80 | // Delphi 81 | Messages, Windows; 82 | 83 | 84 | {$R *.dfm} 85 | 86 | { TRTFViewerFrame } 87 | 88 | procedure TRTFViewerFrame.Display(const RTF: TBytes); 89 | {Displays RTF in rich edit control. 90 | @param RTF [in] Byte array containing ASCII encoded RTF code to be 91 | displayed. 92 | } 93 | var 94 | Stm: TBytesStream; // used to load RTF bytes into rich edit control 95 | begin 96 | reView.MaxLength := Length(RTF); // ensures control has large enough capacity 97 | reView.PlainText := False; 98 | Stm := TBytesStream.Create(RTF); 99 | try 100 | reView.Lines.LoadFromStream(Stm, TEncoding.ASCII); 101 | finally 102 | Stm.Free; 103 | end; 104 | SetMargins; 105 | end; 106 | 107 | procedure TRTFViewerFrame.SetMargins; 108 | {Sets left and right margins in rich edit control. 109 | } 110 | var 111 | Rect: TRect; // client rectangle of richedit control used to set margins 112 | begin 113 | // get client rect 114 | Rect := reView.ClientRect; 115 | // adjust for new margins 116 | Rect.Left := Rect.Left + 4; 117 | Rect.Right := Rect.Right - 4; 118 | // set the margins 119 | reView.Perform(EM_SETRECT, 0, LParam(@Rect)); 120 | end; 121 | 122 | end. 123 | 124 | -------------------------------------------------------------------------------- /Src/FrShellNameViewer.dfm: -------------------------------------------------------------------------------- 1 | object ShellNameViewerFrame: TShellNameViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | object pnlView: TPanel 8 | Left = 0 9 | Top = 0 10 | Width = 320 11 | Height = 240 12 | Align = alClient 13 | BevelOuter = bvNone 14 | TabOrder = 0 15 | DesignSize = ( 16 | 320 17 | 240) 18 | object lblName: TLabel 19 | Left = 8 20 | Top = 20 21 | Width = 3 22 | Height = 13 23 | end 24 | object edName: TEdit 25 | Left = 72 26 | Top = 16 27 | Width = 241 28 | Height = 21 29 | TabStop = False 30 | Anchors = [akLeft, akTop, akRight] 31 | ParentColor = True 32 | PopupMenu = mnuView 33 | ReadOnly = True 34 | TabOrder = 0 35 | end 36 | object btnGo: TButton 37 | Left = 72 38 | Top = 48 39 | Width = 75 40 | Height = 25 41 | Action = actExec 42 | TabOrder = 1 43 | end 44 | end 45 | object alView: TActionList 46 | Left = 8 47 | Top = 80 48 | object actCopy: TEditCopy 49 | Category = 'Edit' 50 | Caption = 'Copy' 51 | ShortCut = 16451 52 | end 53 | object actSelectAll: TEditSelectAll 54 | Category = 'Edit' 55 | Caption = 'Select All' 56 | ShortCut = 16449 57 | end 58 | object actExec: TAction 59 | Caption = 'actExec' 60 | OnUpdate = actExecUpdate 61 | end 62 | end 63 | object mnuView: TPopupMenu 64 | Left = 40 65 | Top = 80 66 | object miCopy: TMenuItem 67 | Action = actCopy 68 | end 69 | object miSelectAll: TMenuItem 70 | Action = actSelectAll 71 | end 72 | end 73 | end 74 | -------------------------------------------------------------------------------- /Src/FrShellNameViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrShellNameViewer.pas 3 | * 4 | * Implements a base class for viewer frames that display shell names that are 5 | * provided as text. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is FrShellNameViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit FrShellNameViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Forms, Menus, StdActns, Classes, ActnList, StdCtrls, Controls, ExtCtrls; 45 | 46 | 47 | type 48 | 49 | { 50 | TShellNameViewerFrame: 51 | Base class for viewer frames that display shell names (files and urls) that 52 | are provided as text. Supports selecting of shell name and copying to 53 | clipboard as text. 54 | } 55 | TShellNameViewerFrame = class(TFrame) 56 | pnlView: TPanel; 57 | lblName: TLabel; 58 | edName: TEdit; 59 | btnGo: TButton; 60 | alView: TActionList; 61 | actCopy: TEditCopy; 62 | actSelectAll: TEditSelectAll; 63 | mnuView: TPopupMenu; 64 | miCopy: TMenuItem; 65 | miSelectAll: TMenuItem; 66 | actExec: TAction; 67 | procedure actExecUpdate(Sender: TObject); 68 | public 69 | procedure Display(const Name: string); 70 | {Displays the shell name in an edit box. 71 | @param Name [in] Name to display. 72 | } 73 | end; 74 | 75 | 76 | implementation 77 | 78 | 79 | {$R *.dfm} 80 | 81 | { TShellNameViewerFrame } 82 | 83 | procedure TShellNameViewerFrame.actExecUpdate(Sender: TObject); 84 | {Enables execute action if and only if if a shell name is provided in edit 85 | control. 86 | @param Sender [in] Not used. 87 | } 88 | begin 89 | actExec.Enabled := edName.Text <> ''; // enable action if have shell name 90 | end; 91 | 92 | procedure TShellNameViewerFrame.Display(const Name: string); 93 | {Displays the shell name in an edit box. 94 | @param Name [in] Name to display. 95 | } 96 | begin 97 | edName.Text := Name; 98 | end; 99 | 100 | end. 101 | 102 | -------------------------------------------------------------------------------- /Src/FrTextViewer.dfm: -------------------------------------------------------------------------------- 1 | object TextViewerFrame: TTextViewerFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | object edView: TMemo 8 | Left = 0 9 | Top = 0 10 | Width = 320 11 | Height = 207 12 | TabStop = False 13 | Align = alClient 14 | BorderStyle = bsNone 15 | Font.Charset = DEFAULT_CHARSET 16 | Font.Color = clWindowText 17 | Font.Height = -12 18 | Font.Name = 'Courier New' 19 | Font.Style = [] 20 | ParentFont = False 21 | PopupMenu = mnuView 22 | ReadOnly = True 23 | ScrollBars = ssBoth 24 | TabOrder = 0 25 | WordWrap = False 26 | end 27 | object pnlControl: TPanel 28 | Left = 0 29 | Top = 207 30 | Width = 320 31 | Height = 33 32 | Align = alBottom 33 | BevelOuter = bvNone 34 | TabOrder = 1 35 | object chkWordWrap: TCheckBox 36 | Left = 8 37 | Top = 8 38 | Width = 97 39 | Height = 17 40 | Caption = '&Word Wrap' 41 | TabOrder = 0 42 | OnClick = chkWordWrapClick 43 | end 44 | end 45 | object mnuView: TPopupMenu 46 | AutoHotkeys = maManual 47 | Left = 40 48 | Top = 16 49 | object miCopy: TMenuItem 50 | Action = actCopy 51 | end 52 | object miSelectAll: TMenuItem 53 | Action = actSelectAll 54 | end 55 | end 56 | object alView: TActionList 57 | Left = 72 58 | Top = 16 59 | object actCopy: TEditCopy 60 | Category = 'Edit' 61 | Caption = 'Copy' 62 | ImageIndex = 1 63 | ShortCut = 16451 64 | end 65 | object actSelectAll: TEditSelectAll 66 | Category = 'Edit' 67 | Caption = 'Select All' 68 | ShortCut = 16449 69 | end 70 | end 71 | end 72 | -------------------------------------------------------------------------------- /Src/FrTextViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrTextViewer.pas 3 | * 4 | * Implements a viewer frame that displays plain text documents. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is FrTextViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2010 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit FrTextViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | StdCtrls, Controls, ExtCtrls, StdActns, Classes, ActnList, Menus, Forms; 44 | 45 | 46 | type 47 | { 48 | TTextViewerFrame: 49 | Viewer frame that displays plain text documents. Can display either Ansi or 50 | OEM text. Can also display Unicode text that has been converted Ansi. 51 | Supports selecting and copying of text to clipboard. Displayed text can 52 | optionally be word wrapped. 53 | } 54 | TTextViewerFrame = class(TFrame) 55 | edView: TMemo; 56 | mnuView: TPopupMenu; 57 | alView: TActionList; 58 | actCopy: TEditCopy; 59 | actSelectAll: TEditSelectAll; 60 | miCopy: TMenuItem; 61 | miSelectAll: TMenuItem; 62 | pnlControl: TPanel; 63 | chkWordWrap: TCheckBox; 64 | procedure chkWordWrapClick(Sender: TObject); 65 | private 66 | procedure SetMargins; 67 | {Sets left and right margins in edit control. 68 | } 69 | procedure SetWordWrap(const Flag: Boolean); 70 | {Switches word wrapping on and off. 71 | @param Flag [in] Indicates whether word wrapping is required. 72 | } 73 | public 74 | constructor Create(AOwner: TComponent); override; 75 | {Class constructor. Sets up frame and reads display preferences from 76 | settings. 77 | @param AOwner [in] Component that owns the frame. 78 | } 79 | destructor Destroy; override; 80 | {Class destructor. Tears down frame and stores current preferences. 81 | } 82 | procedure Display(const Text: UnicodeString); 83 | {Displays required text. 84 | @param Text [in] Text to be displayed. 85 | } 86 | end; 87 | 88 | 89 | implementation 90 | 91 | 92 | uses 93 | // Delphi 94 | Messages, Windows, 95 | // Project 96 | USettings; 97 | 98 | 99 | {$R *.dfm} 100 | 101 | { TTextViewerFrame } 102 | 103 | procedure TTextViewerFrame.chkWordWrapClick(Sender: TObject); 104 | {Handles click on "word wrap" check box. Toggles whether text is displayed 105 | word wrapped. 106 | @param Sender [in] Not used. 107 | } 108 | begin 109 | SetWordWrap(chkWordWrap.Checked); 110 | end; 111 | 112 | constructor TTextViewerFrame.Create(AOwner: TComponent); 113 | {Class constructor. Sets up frame and reads display preferences from settings. 114 | @param AOwner [in] Component that owns the frame. 115 | } 116 | var 117 | SettingSection: ISettingsSection; // provides access to settings 118 | begin 119 | inherited Create(AOwner); 120 | SettingSection := Settings.OpenSection(Name); 121 | SetWordWrap(SettingSection.ReadBool('WordWrap', True)); 122 | end; 123 | 124 | destructor TTextViewerFrame.Destroy; 125 | {Class destructor. Tears down frame and stores current preferences. 126 | } 127 | var 128 | SettingSection: ISettingsSection; // provides access to settings 129 | begin 130 | SettingSection := Settings.OpenSection(Name); 131 | SettingSection.WriteBool('WordWrap', edView.WordWrap); 132 | inherited; 133 | end; 134 | 135 | procedure TTextViewerFrame.Display(const Text: UnicodeString); 136 | {Displays required text. 137 | @param Text [in] Text to be displayed. 138 | } 139 | begin 140 | edView.Lines.BeginUpdate; 141 | try 142 | edView.Text := Text; 143 | SetMargins; 144 | finally 145 | edView.Lines.EndUpdate 146 | end; 147 | end; 148 | 149 | procedure TTextViewerFrame.SetMargins; 150 | {Sets left and right margins in edit control. 151 | } 152 | begin 153 | edView.Perform(EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 4); 154 | end; 155 | 156 | procedure TTextViewerFrame.SetWordWrap(const Flag: Boolean); 157 | {Switches word wrapping on and off. 158 | @param Flag [in] Indicates whether word wrapping is required. 159 | } 160 | begin 161 | chkWordWrap.Checked := Flag; 162 | edView.WordWrap := Flag; 163 | if Flag then 164 | edView.ScrollBars := ssVertical 165 | else 166 | edView.ScrollBars := ssBoth; 167 | SetMargins; // need to reset margins when word wrapping changes 168 | end; 169 | 170 | end. 171 | 172 | -------------------------------------------------------------------------------- /Src/FrURLViewer.dfm: -------------------------------------------------------------------------------- 1 | inherited URLViewerFrame: TURLViewerFrame 2 | inherited pnlView: TPanel 3 | inherited lblName: TLabel 4 | Width = 22 5 | Caption = 'URL' 6 | end 7 | end 8 | inherited alView: TActionList 9 | inherited actExec: TAction 10 | Caption = 'Go to &URL' 11 | OnExecute = actExecExecute 12 | end 13 | end 14 | end 15 | -------------------------------------------------------------------------------- /Src/FrURLViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * FrURLViewer.pas 3 | * 4 | * Implements a viewer frame that can display URLs specified as text. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is FrURLViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit FrURLViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Menus, StdActns, Classes, ActnList, StdCtrls, Controls, ExtCtrls, 44 | // Project 45 | FrShellNameViewer; 46 | 47 | 48 | type 49 | { 50 | TURLViewerFrame: 51 | Viewer frame that can display URLs specified as text. URLs are displayed in 52 | default browser or application. Suppoorts election of URL and copying of URL 53 | to clipboard as text. 54 | } 55 | TURLViewerFrame = class(TShellNameViewerFrame) 56 | procedure actExecExecute(Sender: TObject); 57 | end; 58 | 59 | 60 | implementation 61 | 62 | 63 | uses 64 | // Delphi 65 | SysUtils, 66 | // Project 67 | UMessageBox, UProcessUtils; 68 | 69 | 70 | {$R *.dfm} 71 | 72 | procedure TURLViewerFrame.actExecExecute(Sender: TObject); 73 | {Handles Execute action by attempting to display URL in default browser. 74 | Displays error on failure 75 | @param Sender [in] Not used. 76 | } 77 | resourcestring 78 | // Error message 79 | sCantOpen = 'Can''t open URL'#10#10'%s'; 80 | begin 81 | if not OpenFile(edName.Text) then 82 | TMessageBox.Error(Self, Format(sCantOpen, [edName.Text])); 83 | end; 84 | 85 | end. 86 | 87 | -------------------------------------------------------------------------------- /Src/Help/CFS.hhc: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 83 | 84 | -------------------------------------------------------------------------------- /Src/Help/CFS.hhp: -------------------------------------------------------------------------------- 1 | [OPTIONS] 2 | Compatibility=1.1 3 | Compiled file=..\..\Exe\CFS.chm 4 | Contents file=CFS.hhc 5 | Default topic=HTML\main.htm 6 | Display compile progress=No 7 | Language=0x809 English (United Kingdom) 8 | Title=Clipboard Format Spy Help 9 | 10 | 11 | [FILES] 12 | HTML\author.htm 13 | HTML\license.htm 14 | HTML\main.htm 15 | HTML\viewer-binary.htm 16 | HTML\viewer-filegroupdesc.htm 17 | HTML\viewer-filelist.htm 18 | HTML\viewer-filename.htm 19 | HTML\viewer-graphic.htm 20 | HTML\viewer-html.htm 21 | HTML\viewer-htmlclip.htm 22 | HTML\viewer-locale.htm 23 | HTML\viewer-nohelp.htm 24 | HTML\viewer-objdesc.htm 25 | HTML\viewer-rtf.htm 26 | HTML\viewer-text.htm 27 | HTML\viewer-url.htm 28 | HTML\viewers.htm 29 | 30 | -------------------------------------------------------------------------------- /Src/Help/CSS/main.css: -------------------------------------------------------------------------------- 1 | /* 2 | * main.css 3 | * 4 | * Style sheet for use by HTML Help file. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is main.css 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | */ 33 | 34 | 35 | body { 36 | font-family: Arial; 37 | font-size: 9pt; 38 | margin: 0.5em; 39 | background-color: white; 40 | color: black; 41 | } 42 | 43 | h1 { 44 | font-size: 12pt; 45 | font-weight: bold; 46 | color: navy; 47 | margin: 0 0 0.5em 0; 48 | padding-bottom: 2px; 49 | border-bottom: 1px silver solid; 50 | } 51 | 52 | h2 { 53 | font-size: 10pt; 54 | font-weight: bold; 55 | margin: 0.8em 0 0 0; 56 | } 57 | 58 | p { 59 | margin: 0.5em 0 0 0; 60 | padding: 0; 61 | } 62 | 63 | ul, ol { 64 | margin: 0.5em 0 0 2em; 65 | padding: 0; 66 | } 67 | 68 | ol { 69 | list-style-type: decimal; 70 | } 71 | 72 | ul { 73 | list-style-type: square; 74 | } 75 | 76 | li { 77 | margin-top: 0.5em; 78 | } 79 | 80 | a:link, 81 | a:active, 82 | a:visited, 83 | a:hover { 84 | color: green; 85 | text-decoration: underline; 86 | } 87 | 88 | a:link.weblink, 89 | a:active.weblink, 90 | a:visited.weblink, 91 | a:hover.weblink { 92 | color: blue; 93 | text-decoration: underline; 94 | } 95 | 96 | table { 97 | font-family: Arial; 98 | font-size: 9pt; 99 | margin: 0.5em 0 0 0; 100 | padding: 0; 101 | } 102 | 103 | tr { 104 | vertical-align: top; 105 | padding: 0; 106 | margin: 0; 107 | } 108 | 109 | td { 110 | padding: 0.25em; 111 | margin: 1px; 112 | } 113 | 114 | table.menu { 115 | background-color: #ccc; 116 | margin-left: 1em; 117 | } 118 | 119 | table.menu td { 120 | background-color: white; 121 | } 122 | 123 | .keys { 124 | font-variant: small-caps; 125 | } 126 | 127 | -------------------------------------------------------------------------------- /Src/Help/HTML/author.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | About the Author 42 | 47 | 48 | 49 |

50 | About the Author 51 |

52 |

53 | I'm Peter Johnson – a hobbyist programmer living in Ceredigion in 54 | West Wales, UK, writing mainly in Delphi. My programs and Delphi 55 | components are available for download on my web-site at 56 | http://www.delphidabbler.com/. The site also contains some 60 | programming hints and tips and snippets of useful code. 61 |

62 |

63 | I can be contacted via the website's 64 | contact page. 68 |

69 | 70 | 71 | -------------------------------------------------------------------------------- /Src/Help/HTML/main.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Overview 42 | 47 | 48 | 49 |

50 | Overview 51 |

52 |

53 | This program displays the formats currently recorded on the clipboard. 54 | It automatically updates the information displayed as the contents of 55 | the clipboard change. For certain supported formats you can also view 56 | the clipboard contents. The contents of the clipboard can be deleted. 57 |

58 |

59 | For each format displayed on the clipboard, the following information is 60 | displayed in the main window: 61 |

62 | 78 |

79 | The display can be sorted in ascending or descending order on any 80 | column. Simply click a column header to sort by that column. Clicking 81 | twice reverses the sort order. The display columns can be resized by 82 | dragging the edge of the column headers. 83 |

84 |

85 | To view a clipboard format select it in the display and right-click to 86 | display a pop-up menu. Select the required viewer from the menu. If the 87 | format can't be viewed "no viewer" will be displayed in the 88 | menu. More info. 89 |

90 |

91 | The file name of the process that owns the clipboard is displayed in the 92 | status bar. This is the process that last copied data to, or cleared, 93 | the clipboard. 94 |

95 |

96 | The window can be resized and the program remembers the size and 97 | position information between executions. 98 |

99 |

100 | There is a a toolbar which provides the following functions: 101 |

102 | 103 | 104 | 111 | 114 | 115 | 116 | 123 | 126 | 127 | 128 | 135 | 139 | 140 | 141 | 148 | 151 | 152 |
105 | delete image 110 | 112 | Clear the clipboard. 113 |
117 | help image 122 | 124 | Display this help file. 125 |
129 | about image 134 | 136 | Display an about box containing copyright and version 137 | information. 138 |
142 | exit image 147 | 149 | Exit the program. 150 |
153 |

154 | If your have any comments on the program or find any bugs, please 155 | contact the 156 | author. 157 |

158 | 159 | 160 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-binary.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Binary Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | Binary Viewer 56 |

57 |

58 | This window displays binary information about any clipboard format that 59 | is represented in global memory. Supported formats will have a size 60 | entry in the main window. This binary viewer is always a secondary 61 | viewer. 62 |

63 |

64 | The viewer shows 16 bytes of data per line, with each line divided into 65 | three sections: 66 |

81 |

82 | The display can be scrolled up and down and left to right using the 83 | scroll bars or by using the following keys: 84 |

85 | 86 | 87 | 90 | 93 | 94 | 95 | 98 | 101 | 102 | 103 | 106 | 109 | 110 | 111 | 114 | 117 | 118 | 119 | 122 | 125 | 126 | 127 | 130 | 133 | 134 | 135 | 138 | 141 | 142 | 143 | 146 | 149 | 150 | 151 | 154 | 157 | 158 | 159 | 162 | 165 | 166 | 167 | 170 | 173 | 174 |
88 | Key 89 | 91 | Action 92 |
96 | End 97 | 99 | Scrolls right to display the end of the line. 100 |
104 | Ctrl+End 105 | 107 | Moves to the end of the document. 108 |
112 | Home 113 | 115 | Scrolls left to display the start of the line. 116 |
120 | Ctrl+Home 121 | 123 | Moved to the start of the document. 124 |
128 | Left 129 | 131 | Scrolls left. 132 |
136 | Right 137 | 139 | Scrolls right. 140 |
144 | Down 145 | 147 | Scrolls down one line. 148 |
152 | PgDn 153 | 155 | Scrolls down one screen. 156 |
160 | Up 161 | 163 | Scrolls up one line. 164 |
168 | PgUp 169 | 171 | Scrolls up one screen. 172 |
175 |

176 | There is no context menu available in this window. 177 |

178 | 179 | 180 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-filegroupdesc.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | File Group Descriptor Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | File Group Descriptor Viewer 56 |

57 |

58 | This window displays information about a group of (one or more) files 59 | copied using the "FileGroupDescriptor" and 60 | "FileGroupDescriptorW" clipboard formats. Supported 61 | information types are: 62 |

63 | 80 |

81 | Not all types of information may be provided. When absent the 82 | information is omitted from the list. 83 |

84 |

85 | A context menu is provided to enable a list of the file names in the 86 | group to be copied to the clipboard as CF_TEXT. Each file name is 87 | separated by a CRLF pair. 88 |

89 | 90 | 91 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-filelist.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | File List Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | File List Viewer 56 |

57 |

58 | This window displays lists of files that have been provided via the 59 | CF_HDROP and "Shell IDList Array" clipboard formats. 60 |

61 |

62 | In the case of CF_HDROP the display lists files that have been copied 63 | to the clipboard whilst for "Shell IDList Array" the display 64 | shows both a root folder and a list of contained files. The display 65 | distinguishes between files and folders – different icons are 66 | used. 67 |

68 |

69 | Right clicking in the main window displays a popup menu. The items on 70 | the menu depend on the context. 71 |

72 | 90 | 91 | 92 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-filename.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | File Name Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | File Name Viewer 56 |

57 |

58 | This window displays a file or folder name that has been provided via 59 | the "FileName" or the "FileNameW" clipboard formats. 60 |

61 |

62 | Applications or data files with associated applications can be opened 63 | by clicking the displayed Open button. An error message is 64 | displayed if a data file has no associated application. 65 |

66 |

67 | Folders can be opened in Explorer by clicking the displayed 68 | Explore button. 69 |

70 |

71 | The file or folder name can be selected and copied to the clipboard as 72 | text. 73 |

74 | 75 | 76 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-graphic.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Graphic Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | Graphic Viewer 56 |

57 |

58 | This window displays bitmap and metafile clipboard formats such as 59 | CF_BITMAP, CF_DIB, CF_ENHMETAFILE and CF_METAFILEPICT. 60 |

61 |

62 | The graphic is displayed in its default size. 63 |

64 |

65 | There is a context menu that appears when the graphic is right clicked 66 | that enables the graphic to be copied back to the clipboard. Metafiles 67 | are copied as CF_ENHMETAFILE and CF_METAFILEPICT while bitmaps are 68 | copied as CF_BITMAP, CF_DIB and CF_DIBV5. If the image has an associated 69 | palette then the palette is also placed on the clipboard in CF_PALETTE 70 | format. 71 |

72 | 73 | 74 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-html.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | HTML Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | HTML Viewer 56 |

57 |

58 | This window renders HTML that has been copied to the clipboard using 59 | the "text/html" format used by Firefox and the "HTML 60 | (HyperText Markup Language)" format used by OpenOffice. 61 |

62 |

63 | Clipboard Format Spy provides its own default cascading style 64 | sheet to style the HTML, so the rendered HTML may have a different 65 | appearance to the original. 66 |

67 |

68 | Note: 69 | this is not the viewer used for the "HTML Format" 70 | clipboard format – this specialised format provides further 71 | information alongside the HTML. This format is displayed in the 72 | HTML Clip Viewer. 73 |

74 |

75 | A context menu is provided to enable the content of the view to be 76 | selected and copied to the clipboard. 77 |

78 | 79 | 80 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-htmlclip.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | HTML Clip Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | HTML Clip Viewer 56 |

57 |

58 | This window displays information about the "HTML Format" 59 | clipboard format. 60 |

61 |

62 | The "HTML Format" format is often used when content is copied 63 | from a web browser to the clipboard. The format is text based and 64 | not only supplies the copied HTML but also provides some data about the 65 | copied HTML. The information provided includes the context of the copied 66 | HTML containing all required surrounding tags, the fragment actually 67 | copied, information about the selection (optional) and the source URL. 68 | The version of the clip format is also displayed. 69 |

70 |

71 | Details of the various pieces of provided information are displayed at 72 | the top of the window and the HTML is rendered in the lower half of the 73 | window. 74 |

75 |

76 | To view the underlying data right click "HTML Format" in the 77 | main display and select View As Text from the popup menu. 78 |

79 |

80 | A context menu is provided to enable the content of the view to be 81 | selected and copied to the clipboard. 82 |

83 |

84 | Note: 85 | Raw HTML, with no additional clip data, is not displayed in this viewer 86 | – see the related HTML Viewer. 87 |

88 | 89 | 90 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-locale.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Locale Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | Locale Viewer 56 |

57 |

58 | This window displays information about the locale specified by the 59 | CF_LOCALE clipboard format. 60 |

61 |

62 | A subset of the locale information is displayed, as follows: 63 |

64 | 95 |

96 | There is a context menu that appears when any of the text boxes that 97 | contain locale information is right-clicked. This menu gives the option 98 | to select and copy the text in CF_TEXT format. 99 |

100 | 101 | 102 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-nohelp.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | No Viewer Help 42 | 47 | 48 | 49 |

50 | No Help Available 51 |

52 |

53 | Sorry there is no help available for this viewer. 54 |

55 |

56 | See the main viewers topic. 57 |

58 | 59 | 60 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-objdesc.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Object and Link Source Descriptor Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | Object & Link Source Descriptor Viewer 56 |

57 |

58 | This window displays information about a link source descriptor or an 59 | object descriptor described by the "Object Descriptor" and 60 | "Link Source Descriptor" clipboard formats. The following 61 | information is displayed: 62 |

63 | 86 |

87 | There is a context menu that appears when any of the text boxes that 88 | contain the provided information is right-clicked. This menu gives the 89 | option to select and copy the text in CF_TEXT format. 90 |

91 | 92 | 93 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-rtf.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | RTF Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | RTF Viewer 56 |

57 |

58 | This window renders Rich Text Format code that has been copied to the 59 | clipboard using the "Rich Text Format" and "Rich Text 60 | Format Without Objects" formats. 61 |

62 |

63 | Note: the "RTF As Text" format is displayed 64 | in the text viewer since this format 65 | appears to be designed for viewing the RTF source code rather than 66 | rendered text. 67 |

68 |

69 | A context menu is provided to enable the content of the view to be 70 | selected and copied to the clipboard. 71 |

72 | 73 | 74 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-text.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Text Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | Text Viewer 56 |

57 |

58 | This window displays ANSI and Unicode plain text clipboard 59 | formats such as CF_TEXT, CF_OEMTEXT, CF_UNICODETEXT. 60 |

61 |

62 | The viewer as also available as a secondary viewer for some clipboard 63 | formats such as "Rich Text Format" that are composed of 64 | structured text. In this case the underlying "source 65 | code" is displayed, while any primary viewer will render the 66 | source code. 67 |

68 |

69 | Text can optionally be word wrapped by checking the Word Wrap 70 | check box that appears below the text display. This setting is 71 | remembered by the program. 72 |

73 |

74 | There is a context menu that enables text to be selected and copied to 75 | the clipboard. 76 |

77 | 78 | 79 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewer-url.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | URL Viewer 42 | 47 | 48 | 49 | 52 | 53 | 54 |

55 | URL Viewer 56 |

57 |

58 | This window displays a URL name that has been provided via 59 | the "UniformResourceLocator" or the 60 | "UniformResourceLocatorW" clipboard formats. 61 |

62 |

63 | The URL can be opened in the default browser, or other suitable viewing 64 | application, by clicking the displayed Go to URL button. 65 |

66 |

67 | The URL name can be selected and copied to the clipboard as text. 68 |

69 | 70 | 71 | -------------------------------------------------------------------------------- /Src/Help/HTML/viewers.htm: -------------------------------------------------------------------------------- 1 | 2 | 34 | 35 | 36 | 37 | 41 | Viewers 42 | 47 | 48 | 49 |

50 | Viewers 51 |

52 |

53 | Various clipboard formats can be displayed by Clipboard Format 54 | Spy. To display a clipboard format right click the desired format 55 | in the main window to display the viewer pop-up menu. The desired viewer 56 | can then be selected. 57 |

58 | Some formats have dedicated primary 59 | viewers that can also be displayed by double clicking the format in the 60 | main display. The binary data of all memory based formats can be viewed 61 | in a hex viewer. Formats that are based on plain text can also be viewed 62 | as text. 63 |

64 |

65 | Available viewers are: 66 |

67 | 125 | 126 | -------------------------------------------------------------------------------- /Src/Help/Images/about.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Help/Images/about.gif -------------------------------------------------------------------------------- /Src/Help/Images/delete.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Help/Images/delete.gif -------------------------------------------------------------------------------- /Src/Help/Images/exit.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Help/Images/exit.gif -------------------------------------------------------------------------------- /Src/Help/Images/help.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Help/Images/help.gif -------------------------------------------------------------------------------- /Src/Res/CFS.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Res/CFS.ico -------------------------------------------------------------------------------- /Src/Res/HTMLViewer.css: -------------------------------------------------------------------------------- 1 | /* 2 | * HTMLViewer.css 3 | * 4 | * Default cascading style sheet used by viewers that display HTML. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is HTMLViewer.css. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None. 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | */ 33 | 34 | 35 | body { 36 | margin: 4px; 37 | font-family: Arial; 38 | font-size: 9pt; 39 | } 40 | 41 | table { 42 | font-size: 9pt; 43 | } 44 | 45 | h1 { 46 | font-size: 15pt; 47 | font-weight: bold; 48 | font-style: none; 49 | } 50 | 51 | h2 { 52 | font-size: 13pt; 53 | font-weight: bold; 54 | font-style: none; 55 | } 56 | 57 | h3 { 58 | font-size: 11pt; 59 | font-weight: bold; 60 | font-style: none; 61 | } 62 | 63 | h4 { 64 | font-size: 9pt; 65 | font-weight: bold; 66 | font-style: none; 67 | } 68 | 69 | h5 { 70 | font-size: 9pt; 71 | font-weight: normal; 72 | font-style: italic; 73 | } 74 | 75 | img { 76 | border: 0; 77 | } 78 | 79 | a:link { 80 | color: navy; 81 | text-decoration: underline; 82 | } 83 | 84 | a:visited { 85 | color: blue; 86 | text-decoration: underline; 87 | } 88 | 89 | a:hover { 90 | text-decoration: underline; 91 | } 92 | 93 | a:active { 94 | color: lightblue; 95 | text-decoration: underline; 96 | } 97 | 98 | -------------------------------------------------------------------------------- /Src/Res/XPnVista.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 17 | 18 | 19 | 25 | 26 | 27 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /Src/Resources.rc: -------------------------------------------------------------------------------- 1 | /* 2 | * Resources.rc 3 | * 4 | * General resource file for Clipboard Format Spy. Includes main icon, default 5 | * style sheet for HTML displays and program's manifest. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is Resources.rc. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None. 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | */ 34 | 35 | 36 | /* 37 | Program's main icon 38 | */ 39 | MAINICON ICON "Res\CFS.ico" 40 | 41 | /* 42 | Default CSS style sheet used in HTML viewers 43 | */ 44 | CSS RCDATA "Res\HTMLViewer.css" 45 | 46 | /* 47 | Program manifest that specifies XP look and feel for XP and Vista execution 48 | level 49 | */ 50 | 1 24 "Res\XPnVista.manifest" 51 | 52 | -------------------------------------------------------------------------------- /Src/UBaseTextViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UBaseTextViewer.pas 3 | * 4 | * Implements a base class for all viewers that read text from the clipboard. 5 | * Provides access to text on clipboard. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UBaseTextViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2010 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UBaseTextViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | SysUtils, 45 | // Project 46 | UGlobalMemViewer; 47 | 48 | 49 | type 50 | 51 | /// 52 | /// Base class for all viewers that read text from the clipboard. 53 | /// 54 | TBaseTextViewer = class(TGlobalMemViewer) 55 | protected 56 | function GetAsAnsiBytes(const FmtID: Word): TBytes; 57 | {Copies clipboard data from global memory into byte array of ANSI 58 | character codes with trailing zero bytes removed. 59 | @param FmtID [in] ID of required clipboard format. 60 | @return Required byte array of ANSI character values. 61 | } 62 | function GetAsUnicodeBytes(const FmtID: Word): TBytes; 63 | {Copies clipboard data from global memory into byte array of Unicode 64 | character codes with trailing WideChar zero bytes removed. 65 | @param FmtID [in] ID of required clipboard format. 66 | @return Required byte array of Unicode character values. 67 | } 68 | end; 69 | 70 | 71 | implementation 72 | 73 | 74 | uses 75 | // Project 76 | UDataBuffer; 77 | 78 | 79 | { TBaseTextViewer } 80 | 81 | function TBaseTextViewer.GetAsAnsiBytes(const FmtID: Word): TBytes; 82 | {Copies clipboard data from global memory into byte array of ANSI character 83 | codes with trailing zero bytes removed. 84 | @param FmtID [in] ID of required clipboard format. 85 | @return Required byte array of ANSI character values. 86 | } 87 | var 88 | Data: IDataBuffer; // data buffer containing copy of clipboard data 89 | Buffer: Pointer; // pointer into data buffer 90 | Len: Integer; // length of "string" from data buffer 91 | begin 92 | // We make assumption here that an ANSI character is 1 byte 93 | Assert(SizeOf(AnsiChar) = 1); 94 | // Take copy of clipboard data 95 | Data := CopyClipboardMemData(FmtID); 96 | // Get data in correct format 97 | Buffer := Data.Lock; 98 | try 99 | // copy clipboard data into byte array: format must have ASCII text 100 | SetLength(Result, Data.Size); 101 | Move(Buffer^, Pointer(Result)^, Data.Size); 102 | // remove all trailing zeros - we don't want these in final string 103 | Len := Length(Result); 104 | while (Len > 0) and (Result[Len - 1] = 0) do 105 | Dec(Len); 106 | SetLength(Result, Len); 107 | finally 108 | Data.Unlock; 109 | end; 110 | end; 111 | 112 | function TBaseTextViewer.GetAsUnicodeBytes(const FmtID: Word): TBytes; 113 | {Copies clipboard data from global memory into byte array of Unicode character 114 | codes with trailing WideChar zero bytes removed. 115 | @param FmtID [in] ID of required clipboard format. 116 | @return Required byte array of Unicode character values. 117 | } 118 | var 119 | Data: IDataBuffer; // data buffer containing copy of clipboard data 120 | Buffer: Pointer; // pointer into data buffer 121 | Len: Integer; // length of "string" from data buffer 122 | begin 123 | // We make assumption here that a Unicode character is 2 bytes 124 | Assert(SizeOf(WideChar) = 2); 125 | // Take copy of clipboard data 126 | Data := CopyClipboardMemData(FmtID); 127 | // Get data in correct format 128 | Buffer := Data.Lock; 129 | try 130 | // copy clipboard data into byte array: format must have Unicode text 131 | SetLength(Result, Data.Size); 132 | Move(Buffer^, Pointer(Result)^, Data.Size); 133 | // ensure correct length (multiple of 2) 134 | Len := Length(Result); 135 | if Odd(Len) then 136 | Dec(Len); 137 | // remove all trailing WideChar zeros - we don't want these in final string 138 | while (Len >= 2) and (Result[Len - 1] = 0) and (Result[Len - 2] = 0) do 139 | Dec(Len, 2); 140 | SetLength(Result, Len); 141 | finally 142 | Data.Unlock; 143 | end; 144 | end; 145 | 146 | end. 147 | 148 | -------------------------------------------------------------------------------- /Src/UBmpViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UBmpViewer.pas 3 | * 4 | * Provides a viewer for bitmap handles stored on clipboard. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is UBmpViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit UBmpViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Graphics, 44 | // Project 45 | IntfViewers, UGraphicViewer; 46 | 47 | 48 | type 49 | 50 | { 51 | TBmpViewer: 52 | Provides a viewer for bitmap handles stored on clipboard. 53 | } 54 | TBmpViewer = class(TGraphicViewer, 55 | IViewer 56 | ) 57 | protected 58 | function GetGraphicClass: TGraphicClass; override; 59 | {Provides class to enable base class to create graphic object. 60 | @return TBitmap class. 61 | } 62 | { IViewer } 63 | function SupportsFormat(const FmtID: Word): Boolean; 64 | {Checks whether viewer supports a clipboard format. 65 | @param FmtID [in] ID of required clipboard format. 66 | @return True if format is supported, False if not. 67 | } 68 | function IsPrimaryViewer(const FmtID: Word): Boolean; 69 | {Checks if the viewer is the "primary" viewer for a clipboard format. 70 | @param FmtID [in] ID of required clipboard format. 71 | @return True. This viewer is always a primary viewer. 72 | } 73 | function MenuText(const FmtID: Word): string; 74 | {Gets text to display in viewer menu. 75 | @param FmtID [in] ID of required clipboard format. 76 | @return Required menu text. 77 | } 78 | end; 79 | 80 | 81 | implementation 82 | 83 | 84 | uses 85 | // Project 86 | UClipFmt, UViewers; 87 | 88 | 89 | { TBmpViewer } 90 | 91 | function TBmpViewer.GetGraphicClass: TGraphicClass; 92 | {Provides class to enable base class to create graphic object. 93 | @return TBitmap class. 94 | } 95 | begin 96 | Result := TBitmap; 97 | end; 98 | 99 | function TBmpViewer.IsPrimaryViewer(const FmtID: Word): Boolean; 100 | {Checks if the viewer is the "primary" viewer for a clipboard format. 101 | @param FmtID [in] ID of required clipboard format. 102 | @return True. This viewer is always a primary viewer. 103 | } 104 | begin 105 | Result := True; 106 | end; 107 | 108 | function TBmpViewer.MenuText(const FmtID: Word): string; 109 | {Gets text to display in viewer menu. 110 | @param FmtID [in] ID of required clipboard format. 111 | @return Required menu text. 112 | } 113 | resourcestring 114 | sMenuText = 'View Bitmap'; // same menu text always used 115 | begin 116 | Result := sMenuText; 117 | end; 118 | 119 | function TBmpViewer.SupportsFormat(const FmtID: Word): Boolean; 120 | {Checks whether viewer supports a clipboard format. 121 | @param FmtID [in] ID of required clipboard format. 122 | @return True if format is supported, False if not. 123 | } 124 | begin 125 | Result := FmtID = CF_BITMAP; 126 | end; 127 | 128 | 129 | initialization 130 | 131 | // Register viewer 132 | ViewerRegistrar.RegisterViewer(TBmpViewer.Create); 133 | 134 | end. 135 | 136 | -------------------------------------------------------------------------------- /Src/UGlobalMemViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UGlobalMemViewer.pas 3 | * 4 | * Base class of all clipboard viewers that read clipboard data from HGLOBAL 5 | * memory. Provides access to a copy of data on clipboard. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UGlobalMemViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UGlobalMemViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Project 44 | UDataBuffer; 45 | 46 | 47 | type 48 | 49 | { 50 | TGlobalMemViewer: 51 | Base class of all clipboard viewers that read clipboard data from HGLOBAL 52 | memory. Provides access to a copy of data on clipboard. 53 | } 54 | TGlobalMemViewer = class(TInterfacedObject) 55 | protected 56 | function CopyClipboardMemData(const FmtID: Word): IDataBuffer; 57 | {Makes a copy of data on clipboard in a buffer object. 58 | @param FmtID [in] Required clipboard format. 59 | @return Data buffer instance containing a copy of clipboard data in 60 | required format. 61 | } 62 | end; 63 | 64 | 65 | implementation 66 | 67 | 68 | uses 69 | // Delphi 70 | Clipbrd, Windows, 71 | // Project 72 | IntfViewers; 73 | 74 | 75 | resourcestring 76 | // Error message 77 | sReadError = 'Can''t read global data from clipboard'; 78 | 79 | 80 | { TGlobalMemViewer } 81 | 82 | function TGlobalMemViewer.CopyClipboardMemData(const FmtID: Word): IDataBuffer; 83 | {Makes a copy of data on clipboard in a buffer object. 84 | @param FmtID [in] Required clipboard format. 85 | @return Data buffer instance containing a copy of clipboard data in required 86 | format. 87 | } 88 | var 89 | DataHandle: THandle; // handle to clipboard data in required format 90 | DataSize: Integer; // size of clipboard data 91 | Data: Pointer; // pointer to clipboard data 92 | begin 93 | Clipboard.Open; 94 | try 95 | // We make a *copy* of the clipboard data so that clipboard can be closed 96 | // ASAP. Note that any handles to clipboard data after clipboard has closed 97 | // are not valid. This can be inefficient when clipboard contains a lot of 98 | // data. 99 | DataHandle := Clipboard.GetAsHandle(FmtID); 100 | if DataHandle = 0 then 101 | raise EViewer.Create(sReadError); // raise exception if handle not valid 102 | DataSize := GlobalSize(DataHandle); // returns 0 if invalid handle 103 | try 104 | Data := GlobalLock(DataHandle); // returns nil if invalid handle 105 | // create data buffer: params (nil, 0) flag an invalid buffer 106 | Result := TDataBuffer.Create(Data, DataSize) 107 | finally 108 | GlobalUnlock(DataHandle); 109 | end; 110 | finally 111 | Clipboard.Close; 112 | end; 113 | end; 114 | 115 | end. 116 | 117 | -------------------------------------------------------------------------------- /Src/UGlobals.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UGlobals.pas 3 | * 4 | * Defines constants used throughout the application. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is UGlobals.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit UGlobals; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Windows; 44 | 45 | 46 | const 47 | // DelphiDabbler web address 48 | cWebAddress = 'http://www.delphidabbler.com/'; 49 | 50 | // Registry keys 51 | // root key for settings 52 | cRegRootKey = HKEY_CURRENT_USER; 53 | // sub key under which all settings are recorded 54 | cRegKey = '\Software\DelphiDabbler\CFS\4'; 55 | // relative key under which window states are saved 56 | cWdwStateRegSubKey = 'WindowSettings'; 57 | 58 | 59 | implementation 60 | 61 | end. 62 | 63 | -------------------------------------------------------------------------------- /Src/UGraphicViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UGraphicViewer.pas 3 | * 4 | * Base class for viewers that render image clipboard formats that are stored as 5 | * GDI handles. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UGraphicViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UGraphicViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Forms, Graphics, 45 | // Project 46 | IntfViewers; 47 | 48 | 49 | type 50 | 51 | { 52 | TGraphicViewer: 53 | Base class for viewers that render image clipboard formats that are stored 54 | as GDI handles. 55 | } 56 | TGraphicViewer = class(TInterfacedObject) 57 | private 58 | fGraphic: TGraphic; 59 | {Reference to graphic object created from clipboard data} 60 | protected 61 | function GetGraphicClass: TGraphicClass; virtual; abstract; 62 | {Gets class of graphic to be created in RenderView method. 63 | @return Required graphics class. 64 | } 65 | { IViewer } 66 | procedure RenderClipData(const FmtID: Word); 67 | {Reads data for a specified format from the clipboard and renders it into 68 | a format suitable for display. 69 | @param FmtID [in] ID of clipboard format to be rendered. 70 | } 71 | procedure ReleaseClipData; 72 | {Frees the data rendered when RenderClipData was last called. 73 | } 74 | procedure RenderView(const Frame: TFrame); 75 | {Displays the rendered clipboard data in viewer frame. 76 | @param Frame [in] Frame in which to display the data. 77 | } 78 | function UIFrameClass: TFrameClass; 79 | {Gets the class type of the viewer frame. 80 | @return Required frame class. 81 | } 82 | public 83 | destructor Destroy; override; 84 | {Class destructor. Ensures any remaining clipboard data is released. 85 | } 86 | end; 87 | 88 | 89 | implementation 90 | 91 | 92 | uses 93 | // Delphi 94 | SysUtils, Clipbrd, 95 | // Project 96 | FrGraphicViewer; 97 | 98 | 99 | { TGraphicViewer } 100 | 101 | destructor TGraphicViewer.Destroy; 102 | {Class destructor. Ensures any remaining clipboard data is released. 103 | } 104 | begin 105 | ReleaseClipData; // do this in case caller doesn't release 106 | inherited; 107 | end; 108 | 109 | procedure TGraphicViewer.ReleaseClipData; 110 | {Frees the data rendered when RenderClipData was last called. 111 | } 112 | begin 113 | FreeAndNil(fGraphic); 114 | end; 115 | 116 | procedure TGraphicViewer.RenderClipData(const FmtID: Word); 117 | {Reads data for a specified format from the clipboard and renders it into a 118 | format suitable for display. 119 | @param FmtID [in] ID of clipboard format to be rendered. 120 | } 121 | begin 122 | ReleaseClipData; // make sure data rendered last is freed 123 | fGraphic := GetGraphicClass.Create; // create requierd type of graphic object 124 | Clipboard.Open; 125 | try 126 | fGraphic.LoadFromClipboardFormat(FmtID, Clipboard.GetAsHandle(FmtID), 0); 127 | finally 128 | Clipboard.Close; 129 | end; 130 | end; 131 | 132 | procedure TGraphicViewer.RenderView(const Frame: TFrame); 133 | {Displays the rendered clipboard data in viewer frame. 134 | @param Frame [in] Frame in which to display the data. 135 | } 136 | begin 137 | (Frame as TGraphicViewerFrame).Display(fGraphic); 138 | end; 139 | 140 | function TGraphicViewer.UIFrameClass: TFrameClass; 141 | {Gets the class type of the viewer frame. 142 | @return Required frame class. 143 | } 144 | begin 145 | Result := TGraphicViewerFrame; 146 | end; 147 | 148 | end. 149 | 150 | -------------------------------------------------------------------------------- /Src/UMetafileViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UMetafileViewer.pas 3 | * 4 | * Provides a viewer for metafile handles stored on clipboard. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is UMetafileViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit UMetafileViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | Graphics, 44 | // Project 45 | IntfViewers, UGraphicViewer; 46 | 47 | 48 | type 49 | 50 | { 51 | TMetafileViewer: 52 | Provides a viewer for metafile handles stored on clipboard. 53 | } 54 | TMetafileViewer = class(TGraphicViewer, 55 | IViewer 56 | ) 57 | protected 58 | function GetGraphicClass: TGraphicClass; override; 59 | {Provides class to enable base class to create graphic object. 60 | @return TMetafile class. 61 | } 62 | { IViewer } 63 | function SupportsFormat(const FmtID: Word): Boolean; 64 | {Checks whether viewer supports a clipboard format. 65 | @param FmtID [in] ID of required clipboard format. 66 | @return True if format is supported, False if not. 67 | } 68 | function IsPrimaryViewer(const FmtID: Word): Boolean; 69 | {Checks if the viewer is the "primary" viewer for a clipboard format. 70 | @param FmtID [in] ID of required clipboard format. 71 | @return True. This viewer is always a primary viewer. 72 | } 73 | function MenuText(const FmtID: Word): string; 74 | {Gets text to display in viewer menu. 75 | @param FmtID [in] ID of required clipboard format. 76 | @return Required menu text. 77 | } 78 | end; 79 | 80 | 81 | implementation 82 | 83 | 84 | uses 85 | // Project 86 | UClipFmt, UViewers; 87 | 88 | 89 | { TMetafileViewer } 90 | 91 | function TMetafileViewer.GetGraphicClass: TGraphicClass; 92 | {Provides class to enable base class to create graphic object. 93 | @return TMetafile class. 94 | } 95 | begin 96 | Result := TMetafile; 97 | end; 98 | 99 | function TMetafileViewer.IsPrimaryViewer(const FmtID: Word): Boolean; 100 | {Checks if the viewer is the "primary" viewer for a clipboard format. 101 | @param FmtID [in] ID of required clipboard format. 102 | @return True. This viewer is always a primary viewer. 103 | } 104 | begin 105 | Result := True; 106 | end; 107 | 108 | function TMetafileViewer.MenuText(const FmtID: Word): string; 109 | {Gets text to display in viewer menu. 110 | @param FmtID [in] ID of required clipboard format. 111 | @return Required menu text. 112 | } 113 | resourcestring 114 | sMenuText = 'View metafile'; // same menu text always used 115 | begin 116 | Result := sMenuText; 117 | end; 118 | 119 | function TMetafileViewer.SupportsFormat(const FmtID: Word): Boolean; 120 | {Checks whether viewer supports a clipboard format. 121 | @param FmtID [in] ID of required clipboard format. 122 | @return True if format is supported, False if not. 123 | } 124 | begin 125 | Result := (FmtID = CF_ENHMETAFILE) or (FmtID = CF_METAFILEPICT); 126 | end; 127 | 128 | initialization 129 | 130 | // Register viewer 131 | ViewerRegistrar.RegisterViewer(TMetafileViewer.Create); 132 | 133 | end. 134 | 135 | -------------------------------------------------------------------------------- /Src/UObjDescAdapter.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UObjDescAdapter.pas 3 | * 4 | * Implements a that provides an alternative interface to Object descriptors 5 | * and Link Source descriptors. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UObjDescAdapter.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UObjDescAdapter; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | ActiveX, Windows; 45 | 46 | 47 | type 48 | /// 49 | /// Class that provides an alternative interface to Object descriptors and 50 | /// Link Source descriptors as represented by the TObjectDescriptor 51 | /// (OBJECTDESCRIPTOR) structure. 52 | /// 53 | /// 54 | /// These formats provide user interface information during data 55 | /// transfer operations. 56 | /// See http://tinyurl.com/34jbglt (MSDN). 57 | /// 58 | TObjDescAdapter = class(TObject) 59 | private 60 | fStatus: DWORD; 61 | {Value of status property} 62 | fDrawAspect: DWORD; 63 | {Value of DrawAspect property} 64 | fFullUserTypeName: UnicodeString; 65 | {Value of FullUserTypeName property} 66 | fSrcOfCopy: UnicodeString; 67 | {Value of SrcOfCopy property} 68 | fCLSID: TGUID; 69 | {Value of CLSID property} 70 | fExtent: TSize; 71 | {Value of Extent property} 72 | function GetStringFromOffset(const OD: TObjectDescriptor; 73 | const Offset: Integer): UnicodeString; 74 | {Fetches Unicode string located at a specified byte offset from the start 75 | of a TObjectDescriptor record. 76 | @param OD [in] Object descriptor record beyond which string is located. 77 | @param Offset [in] Offset from start of OD at which string is located. 78 | @return Required Unicode string. 79 | } 80 | public 81 | constructor Create(const OD: TObjectDescriptor); 82 | {Class constructor. Populates fields from an object descriptor or link 83 | source descriptor. 84 | @param OD [in] Record providing information about descriptor. 85 | } 86 | property CLSID: TGUID read fCLSID; 87 | {CLSID of the object being transferred. May be CLSID_NULL} 88 | property DrawAspect: DWORD read fDrawAspect; 89 | {Display aspect of the object. May be 0 if source application did not 90 | draw the object} 91 | property Extent: TSize read fExtent; 92 | {Specifies the extent of the object without cropping or scaling. May be 93 | (0,0) if source application did not draw the object} 94 | property Status: DWORD read fStatus; 95 | {Status flags for the object defined by OLEMISC structure} 96 | property FullUserTypeName: UnicodeString read fFullUserTypeName; 97 | {Full user type name of the object. May be ''} 98 | property SrcOfCopy: UnicodeString read fSrcOfCopy; 99 | {Specifies the source of the transfer. May be '' for an unknown source} 100 | end; 101 | 102 | 103 | implementation 104 | 105 | 106 | { TObjDescAdapter } 107 | 108 | constructor TObjDescAdapter.Create(const OD: TObjectDescriptor); 109 | {Class constructor. Populates fields from an object descriptor or link source 110 | descriptor. 111 | @param OD [in] Record providing information about descriptor. 112 | } 113 | begin 114 | // Set property values 115 | // OD.pointl field ignored since only relevant to drag-drop 116 | fCLSID := OD.clsid; 117 | fDrawAspect := OD.dwDrawAspect; 118 | fExtent.cx := OD.size.X; 119 | fExtent.cy := OD.size.Y; 120 | fStatus := OD.dwStatus; 121 | if OD.dwFullUserTypeName <> 0 then 122 | // we have user type name: get it 123 | fFullUserTypeName := GetStringFromOffset(OD, OD.dwFullUserTypeName); 124 | if OD.dwSrcOfCopy <> 0 then 125 | // we have source of copy: get it 126 | fSrcOfCopy := GetStringFromOffset(OD, OD.dwSrcOfCopy); 127 | end; 128 | 129 | function TObjDescAdapter.GetStringFromOffset(const OD: TObjectDescriptor; 130 | const Offset: Integer): UnicodeString; 131 | {Fetches Unicode string located at a specified byte offset from the start of a 132 | TObjectDescriptor record. 133 | @param OD [in] Object descriptor record beyond which string is located. 134 | @param Offset [in] Offset from start of OD at which string is located. 135 | @return Required Unicode string. 136 | } 137 | begin 138 | Result := PWideChar(Pointer(Integer(@OD) + Offset)); 139 | end; 140 | 141 | end. 142 | 143 | -------------------------------------------------------------------------------- /Src/UOleClientSite.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UOleClientSite.pas 3 | * 4 | * Contains a class that provides a minimal implementation of the 5 | * IOleClientSite interface that is sufficient to record the application as a 6 | * host for the IE web browser control. 7 | * 8 | * $Rev$ 9 | * $Date$ 10 | * 11 | * ***** BEGIN LICENSE BLOCK ***** 12 | * 13 | * Version: MPL 1.1 14 | * 15 | * The contents of this file are subject to the Mozilla Public License Version 16 | * 1.1 (the "License"); you may not use this file except in compliance with the 17 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 18 | * 19 | * Software distributed under the License is distributed on an "AS IS" basis, 20 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 21 | * the specific language governing rights and limitations under the License. 22 | * 23 | * The Original Code is UOleClientSite.pas 24 | * 25 | * The Initial Developer of the Original Code is Peter Johnson 26 | * (http://www.delphidabbler.com/). 27 | * 28 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 29 | * Johnson. All Rights Reserved. 30 | * 31 | * Contributor(s): None 32 | * 33 | * ***** END LICENSE BLOCK ***** 34 | } 35 | 36 | 37 | unit UOleClientSite; 38 | 39 | 40 | interface 41 | 42 | 43 | uses 44 | // Delphi 45 | Windows, ActiveX, 46 | // Project 47 | UIntfObjects; 48 | 49 | type 50 | 51 | { 52 | TOleClientSite: 53 | Minimal implementation of the IOleClientSite interface that provides a host 54 | container for the web browser control. This implementation is needed so that 55 | the web browser control can call QueryInterface on it to get hold of our 56 | IDocHostUIHandler implementation. 57 | } 58 | TOleClientSite = class(TAggregatedOrLoneObject, 59 | IUnknown, IOleClientSite 60 | ) 61 | protected 62 | { IOleClientSite methods } 63 | function SaveObject: HResult; stdcall; 64 | {Saves the object associated with the client site. No action taken. 65 | @return S_OK to inform we have responded. 66 | } 67 | function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; 68 | out mk: IMoniker): HResult; stdcall; 69 | {Returns a moniker to an object's client site. We don't implement 70 | monikers. 71 | @param dwAssign [in] Not used. 72 | @param dwWhichMoniker [in] Not used. 73 | @param mk [out] Set to nil. 74 | @return E_NOTIMPL to indicate method is not implemented. 75 | } 76 | function GetContainer(out container: IOleContainer): HResult; stdcall; 77 | {Returns a pointer to the container's IOleContainer interface if 78 | supported. We don't support the interface. 79 | @param container [out] Set to nil. 80 | @return E_NOINTERFACE to indicate we don't support IOleContainer. 81 | } 82 | function ShowObject: HResult; stdcall; 83 | {Tells the container to position the object so it is visible to the user. 84 | No action taken. 85 | @return S_OK to inform we have responded. 86 | } 87 | function OnShowWindow(fShow: BOOL): HResult; stdcall; 88 | {Notifies a container when an embedded object's window is about to become 89 | visible or invisible. No action taken. 90 | @param fShow [in] Not used. 91 | @return S_OK to inform we have responded. 92 | } 93 | function RequestNewObjectLayout: HResult; stdcall; 94 | {Asks container to allocate more or less space for displaying an embedded 95 | object. We don't support layout requests. 96 | @return E_NOTIMPL to indicate layout requests not implemented. 97 | } 98 | end; 99 | 100 | 101 | implementation 102 | 103 | 104 | { TOleClientSite } 105 | 106 | function TOleClientSite.GetContainer(out container: IOleContainer): HResult; 107 | {Returns a pointer to the container's IOleContainer interface if supported. We 108 | don't support the interface. 109 | @param container [out] Set to nil. 110 | @return E_NOINTERFACE to indicate we don't support IOleContainer. 111 | } 112 | begin 113 | container := nil; 114 | Result := E_NOINTERFACE; 115 | end; 116 | 117 | function TOleClientSite.GetMoniker(dwAssign, dwWhichMoniker: Integer; 118 | out mk: IMoniker): HResult; 119 | {Returns a moniker to an object's client site. We don't implement monikers. 120 | @param dwAssign [in] Not used. 121 | @param dwWhichMoniker [in] Not used. 122 | @param mk [out] Set to nil. 123 | @return E_NOTIMPL to indicate method is not implemented. 124 | } 125 | begin 126 | mk := nil; 127 | Result := E_NOTIMPL; 128 | end; 129 | 130 | function TOleClientSite.OnShowWindow(fShow: BOOL): HResult; 131 | {Notifies a container when an embedded object's window is about to become 132 | visible or invisible. No action taken. 133 | @param fShow [in] Not used. 134 | @return S_OK to inform we have responded. 135 | } 136 | begin 137 | Result := S_OK; 138 | end; 139 | 140 | function TOleClientSite.RequestNewObjectLayout: HResult; 141 | {Asks container to allocate more or less space for displaying an embedded 142 | object. We don't support layout requests. 143 | @return E_NOTIMPL to indicate layout requests not implemented. 144 | } 145 | begin 146 | Result := E_NOTIMPL; 147 | end; 148 | 149 | function TOleClientSite.SaveObject: HResult; 150 | {Saves the object associated with the client site. No action taken. 151 | @return S_OK to inform we have responded. 152 | } 153 | begin 154 | Result := S_OK; 155 | end; 156 | 157 | function TOleClientSite.ShowObject: HResult; 158 | {Tells the container to position the object so it is visible to the user. No 159 | action taken. 160 | @return S_OK to inform we have responded. 161 | } 162 | begin 163 | Result := S_OK; 164 | end; 165 | 166 | end. 167 | 168 | -------------------------------------------------------------------------------- /Src/UPlatform.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UPlatform.pas 3 | * 4 | * Provides OS platform specific information and customisations. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is UPlatform.pas 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit UPlatform; 36 | 37 | 38 | interface 39 | 40 | 41 | function IsVistaOrLater: Boolean; 42 | {Checks if the underlying operating system is Windows Vista or later. Ignores 43 | any OS emulation. 44 | @return True if OS is Vista or later or False if not. 45 | } 46 | 47 | function IsXPOrLater: Boolean; 48 | {Checks if the underlying operating system is Windows XP or later. Ignores 49 | any OS emulation. 50 | @return True if OS is XP or later or False if not. 51 | } 52 | 53 | implementation 54 | 55 | 56 | uses 57 | // Delphi 58 | Windows; 59 | 60 | 61 | function CheckForKernelFn(const FnName: string): Boolean; 62 | {Checks if a specified function exists in OSs kernel. 63 | @param FnName [in] Name of required function. 64 | @return True if function is present in kernel, false if not. 65 | } 66 | const 67 | cKernelDLL = 'kernel32.dll'; // name of kernel DLL 68 | var 69 | PFunction: Pointer; // pointer to required function if exists 70 | begin 71 | // Try to load GetProductInfo func from Kernel32: present if Vista 72 | PFunction := GetProcAddress(GetModuleHandle(cKernelDLL), PChar(FnName)); 73 | Result := Assigned(PFunction); 74 | end; 75 | 76 | function IsVistaOrLater: Boolean; 77 | {Checks if the underlying operating system is Windows Vista or later. Ignores 78 | any OS emulation. 79 | @return True if OS is Vista or later or False if not. 80 | } 81 | begin 82 | // The "GetProductInfo" API function only exists in the kernel of Vista and 83 | // Win 2008 server and later 84 | Result := CheckForKernelFn('GetProductInfo'); 85 | end; 86 | 87 | function IsXPOrLater: Boolean; 88 | {Checks if the underlying operating system is Windows XP or later. Ignores 89 | any OS emulation. 90 | @return True if OS is XP or later or False if not. 91 | } 92 | begin 93 | // The "ActivateActCtx" API function only exists in the kernel of XP and Win 94 | // 2003 server and later 95 | Result := CheckForKernelFn('ActivateActCtx'); 96 | end; 97 | 98 | end. 99 | 100 | -------------------------------------------------------------------------------- /Src/UProcessUtils.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UProcessUtils.pas 3 | * 4 | * Utility routines that call into the operating system to display files or 5 | * interrogate processes. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UProcessUtils.pas 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UProcessUtils; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Windows; 45 | 46 | 47 | function GetProcessName(const PID: DWORD): string; 48 | {Gets name of exe file for a given process. 49 | @param PID [in] Identifier of required process. 50 | @return Process exe name or '' if no such process or can't read processes. 51 | } 52 | 53 | function ExploreFolder(const Folder: string ): Boolean; 54 | {Displays a folder in Windows explorer. 55 | @param Folder [in] Folder to be displayed. 56 | @return True if Explorer executed and False if not. 57 | } 58 | 59 | function OpenFile(const FileName: string): Boolean; 60 | {Opens a file in the associated program. 61 | @param Name of file to open. 62 | @return True if a program is found to display the file, False if not. 63 | } 64 | 65 | 66 | implementation 67 | 68 | 69 | uses 70 | // Delphi 71 | ShellAPI, TlHelp32; 72 | 73 | 74 | function OpenFile(const FileName: string): Boolean; 75 | {Opens a file in the associated program. 76 | @param Name of file to open. 77 | @return True if a program is found to display the file, False if not. 78 | } 79 | begin 80 | Result := ShellExecute(0, '', PChar(FileName), '', '', SW_SHOWNORMAL) > 32; 81 | end; 82 | 83 | function ExploreFolder(const Folder: string ): Boolean; 84 | {Displays a folder in Windows explorer. 85 | @param Folder [in] Folder to be displayed. 86 | @return True if Explorer executed and False if not. 87 | } 88 | begin 89 | Result := ShellExecute( 90 | 0, 'explore', PChar(Folder), '', '', SW_SHOWNORMAL 91 | ) > 32; 92 | end; 93 | 94 | function GetProcessName(const PID: DWORD): string; 95 | {Gets name of exe file for a given process. 96 | @param PID [in] Identifier of required process. 97 | @return Process exe name or '' if no such process or can't read processes. 98 | } 99 | var 100 | Snapshot: THandle; // snapshot of process 101 | PE: TProcessEntry32; // structure holding info about a process 102 | EndOfList: Boolean; // indicates end of process list reached 103 | begin 104 | // Assume failure 105 | Result := ''; 106 | // Get snapshot containing process list 107 | Snapshot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); 108 | if Snapshot = THandle(-1) then 109 | Exit; 110 | try 111 | // Look up process in process list 112 | PE.dwSize := SizeOf(PE); 113 | EndOfList := not Process32First(Snapshot, PE); 114 | while not EndOfList do 115 | begin 116 | if PE.th32ProcessID = PID then 117 | begin 118 | // Found process: record exe name 119 | Result := PE.szExeFile; 120 | Break; 121 | end; 122 | EndOfList := not Process32Next(Snapshot, PE); 123 | end; 124 | finally 125 | // Free the snapshot 126 | CloseHandle(Snapshot); 127 | end; 128 | end; 129 | 130 | end. 131 | 132 | -------------------------------------------------------------------------------- /Src/URTFViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * URTFViewer.pas 3 | * 4 | * Implements a viewer for rich text clipboard formats. 5 | * 6 | * $Rev$ 7 | * $Date$ 8 | * 9 | * ***** BEGIN LICENSE BLOCK ***** 10 | * 11 | * Version: MPL 1.1 12 | * 13 | * The contents of this file are subject to the Mozilla Public License Version 14 | * 1.1 (the "License"); you may not use this file except in compliance with the 15 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 16 | * 17 | * Software distributed under the License is distributed on an "AS IS" basis, 18 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 19 | * the specific language governing rights and limitations under the License. 20 | * 21 | * The Original Code is URTFViewer.pas. 22 | * 23 | * The Initial Developer of the Original Code is Peter Johnson 24 | * (http://www.delphidabbler.com/). 25 | * 26 | * Portions created by the Initial Developer are Copyright (C) 2008-2010 Peter 27 | * Johnson. All Rights Reserved. 28 | * 29 | * Contributor(s): None 30 | * 31 | * ***** END LICENSE BLOCK ***** 32 | } 33 | 34 | 35 | unit URTFViewer; 36 | 37 | 38 | interface 39 | 40 | 41 | uses 42 | // Delphi 43 | SysUtils, Forms, 44 | // Project 45 | IntfViewers, UBaseTextViewer; 46 | 47 | 48 | type 49 | 50 | { 51 | TRTFViewer: 52 | Viewer for rich text clipboard formats. 53 | } 54 | TRTFViewer = class(TBaseTextViewer, 55 | IViewer 56 | ) 57 | private 58 | fRTF: TBytes; 59 | {Contains rich text source code} 60 | protected 61 | { IViewer } 62 | function SupportsFormat(const FmtID: Word): Boolean; 63 | {Checks whether viewer supports a clipboard format. 64 | @param FmtID [in] ID of required clipboard format. 65 | @return True if format is supported, False if not. 66 | } 67 | function IsPrimaryViewer(const FmtID: Word): Boolean; 68 | {Checks if the viewer is the "primary" viewer for a clipboard format. 69 | @param FmtID [in] ID of required clipboard format. 70 | @return True. This is always a primary viewer. 71 | } 72 | function MenuText(const FmtID: Word): string; 73 | {Gets text to display in viewer menu. 74 | @param FmtID [in] ID of required clipboard format. 75 | @return Required menu text. 76 | } 77 | procedure RenderClipData(const FmtID: Word); 78 | {Reads data for a specified format from the clipboard and renders it into 79 | a format suitable for display. 80 | @param FmtID [in] ID of clipboard format to be rendered. 81 | } 82 | procedure ReleaseClipData; 83 | {Frees the data rendered when RenderClipData was last called. 84 | } 85 | procedure RenderView(const Frame: TFrame); 86 | {Displays the rendered clipboard data in viewer frame. 87 | @param Frame [in] Frame in which to display the data. 88 | } 89 | function UIFrameClass: TFrameClass; 90 | {Gets the class type of the viewer frame. 91 | @return Required frame class. 92 | } 93 | end; 94 | 95 | 96 | implementation 97 | 98 | 99 | uses 100 | // Project 101 | FrRTFViewer, UClipFmt, UViewers; 102 | 103 | 104 | { TRTFViewer } 105 | 106 | function TRTFViewer.IsPrimaryViewer(const FmtID: Word): Boolean; 107 | {Checks if the viewer is the "primary" viewer for a clipboard format. 108 | @param FmtID [in] ID of required clipboard format. 109 | @return True. This is always a primary viewer. 110 | } 111 | begin 112 | Result := True; 113 | end; 114 | 115 | function TRTFViewer.MenuText(const FmtID: Word): string; 116 | {Gets text to display in viewer menu. 117 | @param FmtID [in] ID of required clipboard format. 118 | @return Required menu text. 119 | } 120 | resourcestring 121 | sMenuText = 'View Rich Text'; // we display this menu for all formats 122 | begin 123 | Result := sMenuText; 124 | end; 125 | 126 | procedure TRTFViewer.ReleaseClipData; 127 | {Frees the data rendered when RenderClipData was last called. 128 | } 129 | begin 130 | // we simply empty the string holding rich text source 131 | SetLength(fRTF, 0); 132 | end; 133 | 134 | procedure TRTFViewer.RenderClipData(const FmtID: Word); 135 | {Reads data for a specified format from the clipboard and renders it into 136 | a format suitable for display. 137 | @param FmtID [in] ID of clipboard format to be rendered. 138 | } 139 | begin 140 | // rtf code is stored as plain text on clipboard 141 | fRTF := GetAsAnsiBytes(FmtID); 142 | end; 143 | 144 | procedure TRTFViewer.RenderView(const Frame: TFrame); 145 | {Displays the rendered clipboard data in viewer frame. 146 | @param Frame [in] Frame in which to display the data. 147 | } 148 | begin 149 | // frame displays raw RTF code 150 | (Frame as TRTFViewerFrame).Display(fRTF); 151 | end; 152 | 153 | function TRTFViewer.SupportsFormat(const FmtID: Word): Boolean; 154 | {Checks whether viewer supports a clipboard format. 155 | @param FmtID [in] ID of required clipboard format. 156 | @return True if format is supported, False if not. 157 | } 158 | begin 159 | Result := (FmtID = CF_RTF) or (FmtID = CF_RTFNOOBJS); 160 | end; 161 | 162 | function TRTFViewer.UIFrameClass: TFrameClass; 163 | {Gets the class type of the viewer frame. 164 | @return Required frame class. 165 | } 166 | begin 167 | Result := TRTFViewerFrame; 168 | end; 169 | 170 | 171 | initialization 172 | 173 | // Register viewer 174 | ViewerRegistrar.RegisterViewer(TRTFViewer.Create); 175 | 176 | end. 177 | 178 | -------------------------------------------------------------------------------- /Src/UShellNameViewer.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UShellNameViewer.pas 3 | * 4 | * Implements a base class for viewers that display shell names provided as 5 | * simple text. 6 | * 7 | * $Rev$ 8 | * $Date$ 9 | * 10 | * ***** BEGIN LICENSE BLOCK ***** 11 | * 12 | * Version: MPL 1.1 13 | * 14 | * The contents of this file are subject to the Mozilla Public License Version 15 | * 1.1 (the "License"); you may not use this file except in compliance with the 16 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 17 | * 18 | * Software distributed under the License is distributed on an "AS IS" basis, 19 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 20 | * the specific language governing rights and limitations under the License. 21 | * 22 | * The Original Code is UShellNameViewer.pas. 23 | * 24 | * The Initial Developer of the Original Code is Peter Johnson 25 | * (http://www.delphidabbler.com/). 26 | * 27 | * Portions created by the Initial Developer are Copyright (C) 2008-2010 Peter 28 | * Johnson. All Rights Reserved. 29 | * 30 | * Contributor(s): None 31 | * 32 | * ***** END LICENSE BLOCK ***** 33 | } 34 | 35 | 36 | unit UShellNameViewer; 37 | 38 | 39 | interface 40 | 41 | 42 | uses 43 | // Delphi 44 | Forms, 45 | // Project 46 | UBaseTextViewer; 47 | 48 | 49 | type 50 | /// 51 | /// Abstract base class for viewers that display shell names provided as 52 | /// simple ANSI or Unicode text. 53 | /// 54 | TShellNameViewer = class abstract(TBaseTextViewer) 55 | private 56 | fShellName: UnicodeString; 57 | {Name of referenced shell reference. Could be file name or URL} 58 | protected 59 | function GetShellName(const FmtID: Word): UnicodeString; virtual; abstract; 60 | {Gets Unicode representation of shell name. 61 | @param FmtID [in] ID of clipboard format to be rendered. 62 | @return Required shell name. 63 | } 64 | { IViewer } 65 | procedure RenderClipData(const FmtID: Word); 66 | {Reads data for a specified format from the clipboard and renders it into 67 | a format suitable for display. 68 | @param FmtID [in] ID of clipboard format to be rendered. 69 | } 70 | procedure ReleaseClipData; 71 | {Frees the data rendered when RenderClipData was last called. 72 | } 73 | procedure RenderView(const Frame: TFrame); 74 | {Displays the rendered clipboard data in viewer frame. 75 | @param Frame [in] Frame in which to display the data. 76 | } 77 | end; 78 | 79 | 80 | implementation 81 | 82 | 83 | uses 84 | // Project 85 | FrShellNameViewer; 86 | 87 | 88 | { TShellNameViewer } 89 | 90 | procedure TShellNameViewer.ReleaseClipData; 91 | {Frees the data rendered when RenderClipData was last called. 92 | } 93 | begin 94 | // simply delete the stored text 95 | fShellName := ''; 96 | end; 97 | 98 | procedure TShellNameViewer.RenderClipData(const FmtID: Word); 99 | {Reads data for a specified format from the clipboard and renders it into 100 | a format suitable for display. 101 | @param FmtID [in] ID of clipboard format to be rendered. 102 | } 103 | begin 104 | // get shell name from clipboard text 105 | fShellName := GetShellName(FmtID); 106 | end; 107 | 108 | procedure TShellNameViewer.RenderView(const Frame: TFrame); 109 | {Displays the rendered clipboard data in viewer frame. 110 | @param Frame [in] Frame in which to display the data. 111 | } 112 | begin 113 | // pass shell name to frame for display 114 | (Frame as TShellNameViewerFrame).Display(fShellName); 115 | end; 116 | 117 | end. 118 | 119 | -------------------------------------------------------------------------------- /Src/UStatusBarMgr.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UStatusBarMgr.pas 3 | * 4 | * Creates and manages a status bar that can display messages on the left and 5 | * a link to the DelphiDabbler website on the right. 6 | * 7 | * This unit requires the DelphiDabbler TPJHotLabel component Release 2.1 or 8 | * later. 9 | * 10 | * $Rev$ 11 | * $Date$ 12 | * 13 | * ***** BEGIN LICENSE BLOCK ***** 14 | * 15 | * Version: MPL 1.1 16 | * 17 | * The contents of this file are subject to the Mozilla Public License Version 18 | * 1.1 (the "License"); you may not use this file except in compliance with the 19 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 20 | * 21 | * Software distributed under the License is distributed on an "AS IS" basis, 22 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 23 | * the specific language governing rights and limitations under the License. 24 | * 25 | * The Original Code is UStatusBarMgr.pas 26 | * 27 | * The Initial Developer of the Original Code is Peter Johnson 28 | * (http://www.delphidabbler.com/). 29 | * 30 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 31 | * Johnson. All Rights Reserved. 32 | * 33 | * Contributor(s): None 34 | * 35 | * ***** END LICENSE BLOCK ***** 36 | } 37 | 38 | 39 | unit UStatusBarMgr; 40 | 41 | 42 | interface 43 | 44 | 45 | uses 46 | // Delphi 47 | ComCtrls, Controls, Windows, 48 | // DelphiDabbler library 49 | PJHotLabel; 50 | 51 | 52 | type 53 | 54 | { 55 | TStatusBarMgr: 56 | Class that creates and manages a status bar that can display messages on the 57 | left and a link to the DelphiDabbler website on the right. 58 | } 59 | TStatusBarMgr = class(TObject) 60 | private 61 | fStatusBar: TStatusBar; 62 | {Status bar} 63 | fHotLabel: TPJHotLabel; 64 | {Hot label used for web link} 65 | procedure DrawPanelHandler(StatusBar: TStatusBar; Panel: TStatusPanel; 66 | const Rect: TRect); 67 | {Called when status bar panels are redrawn. Positions hot label component 68 | to right of status bar. 69 | @param StatusBar [in] Reference to status bar triggering event. 70 | @param Panel [in] Reference to panel being redrawn. 71 | @param Rect [in] Bounding rectangle of drawing area of panel being 72 | drawn. 73 | } 74 | procedure ResizeHandler(Sender: TObject); 75 | {Called when status bar is resized. Adjusts width of left hand panel when 76 | status bar is resized. 77 | @param Sender [in] Not used. 78 | } 79 | public 80 | constructor Create(const SBOwner: TWinControl); 81 | {Class constructor. Creates status bar including parented hot label. 82 | @param SBOwner [in] Windowed control that hosts (and owns) status bar. 83 | } 84 | procedure DisplayText(const Text: string); 85 | {Displays text in left hand panel of status bar. 86 | @param Text [in] Text to be displayed. 87 | } 88 | end; 89 | 90 | 91 | implementation 92 | 93 | 94 | uses 95 | // Project 96 | UGlobals; 97 | 98 | 99 | resourcestring 100 | // Text displayed in web link 101 | sURLDesc = 'www.delphidabbler.com'; 102 | 103 | 104 | { TStatusBarMgr } 105 | 106 | constructor TStatusBarMgr.Create(const SBOwner: TWinControl); 107 | {Class constructor. Creates status bar including parented hot label. 108 | @param SBOwner [in] Windowed control that hosts (and owns) status bar. 109 | } 110 | begin 111 | inherited Create; 112 | // Create status bar with two panels (it will be freed when SBOwner is freed) 113 | fStatusBar := TStatusBar.Create(SBOwner); 114 | fStatusBar.Parent := SBOwner; 115 | fStatusBar.SimplePanel := False; 116 | fStatusBar.Panels.Add; 117 | fStatusBar.Panels.Add; 118 | fStatusBar.Panels[1].Style := psOwnerDraw; 119 | fStatusBar.OnDrawPanel := DrawPanelHandler; 120 | fStatusBar.OnResize := ResizeHandler; 121 | // Create hot label component parented by status bar (freed when status bar is 122 | // freed) 123 | fHotLabel := TPJHotLabel.Create(SBOwner); 124 | fHotLabel.Parent := fStatusBar; 125 | fHotLabel.CaptionIsURL := False; 126 | fHotLabel.Caption := sURLDesc; 127 | fHotLabel.URL := cWebAddress; 128 | end; 129 | 130 | procedure TStatusBarMgr.DisplayText(const Text: string); 131 | {Displays text in left hand panel of status bar. 132 | @param Text [in] Text to be displayed. 133 | } 134 | begin 135 | fStatusBar.Panels[0].Text := Text; 136 | end; 137 | 138 | procedure TStatusBarMgr.DrawPanelHandler(StatusBar: TStatusBar; 139 | Panel: TStatusPanel; const Rect: TRect); 140 | {Called when status bar panels are redrawn. Positions hot label component to 141 | right of status bar. 142 | @param StatusBar [in] Reference to status bar triggering event. 143 | @param Panel [in] Reference to panel being redrawn. 144 | @param Rect [in] Bounding rectangle of drawing area of panel being drawn. 145 | } 146 | begin 147 | if Panel = fStatusBar.Panels[1] then 148 | begin 149 | fHotLabel.Left := Rect.Right - fHotLabel.Width - 16; 150 | fHotLabel.Top := Rect.Top 151 | + (Rect.Bottom - Rect.Top - fHotLabel.Height) div 2; 152 | end; 153 | end; 154 | 155 | procedure TStatusBarMgr.ResizeHandler(Sender: TObject); 156 | {Called when status bar is resized. Adjusts width of left hand panel when 157 | status bar is resized. 158 | @param Sender [in] Not used. 159 | } 160 | begin 161 | fStatusBar.Panels[0].Width := fStatusBar.Width 162 | - (fHotLabel.Width + 12 + 12); 163 | end; 164 | 165 | end. 166 | 167 | -------------------------------------------------------------------------------- /Src/UWindowSettings.pas: -------------------------------------------------------------------------------- 1 | { 2 | * UWindowSettings.pas 3 | * 4 | * Implements a static class that stores and retrieves window state settings. 5 | * 6 | * This unit requires the DelphiDabbler TPJUserWdwState component Release 5.3 or 7 | * later. 8 | * 9 | * $Rev$ 10 | * $Date$ 11 | * 12 | * ***** BEGIN LICENSE BLOCK ***** 13 | * 14 | * Version: MPL 1.1 15 | * 16 | * The contents of this file are subject to the Mozilla Public License Version 17 | * 1.1 (the "License"); you may not use this file except in compliance with the 18 | * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 19 | * 20 | * Software distributed under the License is distributed on an "AS IS" basis, 21 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 22 | * the specific language governing rights and limitations under the License. 23 | * 24 | * The Original Code is UWindowSettings.pas 25 | * 26 | * The Initial Developer of the Original Code is Peter Johnson 27 | * (http://www.delphidabbler.com/). 28 | * 29 | * Portions created by the Initial Developer are Copyright (C) 2008-2014 Peter 30 | * Johnson. All Rights Reserved. 31 | * 32 | * Contributor(s): None 33 | * 34 | * ***** END LICENSE BLOCK ***** 35 | } 36 | 37 | 38 | unit UWindowSettings; 39 | 40 | 41 | interface 42 | 43 | 44 | uses 45 | // DelphiDabbler library 46 | PJWdwState; 47 | 48 | 49 | type 50 | 51 | { 52 | TWindowSettings: 53 | Static class that stores and retrieves window state settings. 54 | } 55 | TWindowSettings = class(TObject) 56 | public 57 | class procedure Write(const WdwName: string; const Data: TPJWdwStateData); 58 | {Stores window state settings. 59 | @param WdwName [in] Name of window for which settings are being stored. 60 | @param Data [in] Window state data to store. 61 | } 62 | class procedure Read(const WdwName: string; var Data: TPJWdwStateData); 63 | {Reads window state settings. 64 | @param WdwName [in] Name of window for which settings required. 65 | @param Data [in/out] Set to window state data read from settings. 66 | } 67 | end; 68 | 69 | 70 | implementation 71 | 72 | 73 | uses 74 | // Project 75 | UGlobals, USettings; 76 | 77 | 78 | { TWindowSettings } 79 | 80 | class procedure TWindowSettings.Read(const WdwName: string; 81 | var Data: TPJWdwStateData); 82 | {Reads window state settings. 83 | @param WdwName [in] Name of window for which settings required. 84 | @param Data [in/out] Set to window state data read from settings. 85 | } 86 | var 87 | SettingsSection: ISettingsSection; // settings section to save read from 88 | begin 89 | SettingsSection := Settings.OpenSection(cWdwStateRegSubKey); 90 | SettingsSection.ReadBin(WdwName, Data, SizeOf(Data)); 91 | end; 92 | 93 | class procedure TWindowSettings.Write(const WdwName: string; 94 | const Data: TPJWdwStateData); 95 | {Stores window state settings. 96 | @param WdwName [in] Name of window for which settings are being stored. 97 | @param Data [in] Window state data to store. 98 | } 99 | var 100 | SettingsSection: ISettingsSection; // settings section to save to 101 | begin 102 | SettingsSection := Settings.OpenSection(cWdwStateRegSubKey); 103 | SettingsSection.WriteBin(WdwName, Data, SizeOf(Data)); 104 | end; 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /Src/Version.vi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/delphidabbler/cfs/20217be59da2922753305e3f7b0b2fa55fd245eb/Src/Version.vi --------------------------------------------------------------------------------