├── Icon.rc ├── Demo ├── Icon.bmp ├── Icon.res ├── TOTALDemo.res ├── VersionInfo.res ├── TotalDemo.Consts.pas ├── TotalDemo.DockWindowForm.dfm ├── TOTALDemo.dpr ├── TotalDemo.DockWindowForm.pas ├── VersionInfo.rc ├── TotalDemo.Resources.pas ├── TotalDemo.FormEnhancer.pas ├── TotalDemo.OTAWizard.pas └── TotalDemo.Resources.dfm ├── DW.LibSuffixIDE.inc ├── DW.OTA.Types.pas ├── LICENSE ├── DW.OTA.Visualizers.pas ├── .gitignore ├── README.md ├── DW.OTA.ProjectConfigComboBox.pas ├── DW.Menus.Helpers.pas ├── DW.OTA.ProjConfigComboBox.pas ├── DW.OTA.Consts.pas ├── DW.OTA.Registry.pas ├── DW.OTA.CustomMessage.pas ├── DW.OTA.BaseProjectConfigComboBox.pas ├── DW.OTA.IDENotifierOTAWizard.pas ├── DW.OTA.ProjectManagerMenu.pas ├── DW.OTA.Notifiers.pas ├── DW.OTA.Wizard.pas └── DW.OTA.Helpers.pas /Icon.rc: -------------------------------------------------------------------------------- 1 | SplashScreenBitmap BITMAP "Icon.bmp" 2 | -------------------------------------------------------------------------------- /Demo/Icon.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiWorlds/TOTAL/HEAD/Demo/Icon.bmp -------------------------------------------------------------------------------- /Demo/Icon.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiWorlds/TOTAL/HEAD/Demo/Icon.res -------------------------------------------------------------------------------- /Demo/TOTALDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiWorlds/TOTAL/HEAD/Demo/TOTALDemo.res -------------------------------------------------------------------------------- /Demo/VersionInfo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiWorlds/TOTAL/HEAD/Demo/VersionInfo.res -------------------------------------------------------------------------------- /Demo/TotalDemo.Consts.pas: -------------------------------------------------------------------------------- 1 | unit TotalDemo.Consts; 2 | 3 | interface 4 | 5 | const 6 | cTOTALDemoMenuItemName = 'TOTALDemoMenuItem'; 7 | 8 | implementation 9 | 10 | end. 11 | -------------------------------------------------------------------------------- /Demo/TotalDemo.DockWindowForm.dfm: -------------------------------------------------------------------------------- 1 | object DockWindowForm: TDockWindowForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Dock Window' 5 | ClientHeight = 297 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | end 17 | -------------------------------------------------------------------------------- /DW.LibSuffixIDE.inc: -------------------------------------------------------------------------------- 1 | {$IF CompilerVersion = 30} 2 | {$LIBSUFFIX '230'} 3 | {$ENDIF} 4 | {$IF CompilerVersion = 31} 5 | {$LIBSUFFIX '240'} 6 | {$ENDIF} 7 | {$IF CompilerVersion = 32} 8 | {$LIBSUFFIX '250'} 9 | {$ENDIF} 10 | {$IF CompilerVersion = 33} 11 | {$LIBSUFFIX '260'} 12 | {$ENDIF} 13 | {$IF CompilerVersion = 34} 14 | {$LIBSUFFIX '270'} 15 | {$ENDIF} 16 | {$IF CompilerVersion = 35} 17 | {$LIBSUFFIX '280'} 18 | {$ENDIF} 19 | {$IF CompilerVersion = 36} 20 | {$LIBSUFFIX '290'} 21 | {$ENDIF} 22 | 23 | -------------------------------------------------------------------------------- /Demo/TOTALDemo.dpr: -------------------------------------------------------------------------------- 1 | library TOTALDemo; 2 | 3 | {$R 'Icon.res' '..\Icon.rc'} 4 | {$R 'VersionInfo.res' 'VersionInfo.rc'} 5 | {$I DW.LibSuffixIDE.inc} 6 | 7 | uses 8 | System.SysUtils, 9 | System.Classes, 10 | TotalDemo.OTAWizard in 'TotalDemo.OTAWizard.pas', 11 | TotalDemo.Consts in 'TotalDemo.Consts.pas', 12 | TotalDemo.DockWindowForm in 'TotalDemo.DockWindowForm.pas' {DockWindowForm}, 13 | TotalDemo.Resources in 'TotalDemo.Resources.pas' {Resources: TDataModule}; 14 | 15 | {$R *.res} 16 | 17 | begin 18 | end. 19 | -------------------------------------------------------------------------------- /Demo/TotalDemo.DockWindowForm.pas: -------------------------------------------------------------------------------- 1 | unit TotalDemo.DockWindowForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 7 | {$IF Defined(EXPERT)} DockForm, {$ENDIF} 8 | Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 9 | 10 | type 11 | TDockWindowForm = class({$IF Defined(EXPERT)}TDockableForm{$ELSE}TForm{$ENDIF}) 12 | private 13 | { Private declarations } 14 | public 15 | { Public declarations } 16 | end; 17 | 18 | var 19 | DockWindowForm: TDockWindowForm; 20 | 21 | implementation 22 | 23 | {$R *.dfm} 24 | 25 | end. 26 | -------------------------------------------------------------------------------- /Demo/VersionInfo.rc: -------------------------------------------------------------------------------- 1 | 1 VERSIONINFO 2 | FILEVERSION 1,0,0,0 3 | PRODUCTVERSION 1,0,0,0 4 | FILEFLAGSMASK 0x3fL 5 | FILEFLAGS 0x0L 6 | FILEOS 0x4 7 | FILETYPE 0x1 8 | { 9 | BLOCK "StringFileInfo" 10 | { 11 | BLOCK "041304E4" 12 | { 13 | VALUE "CompanyName", "Delphi Worlds" 14 | VALUE "FileDescription", "Total Demo" 15 | VALUE "FileVersion", "1.0.0.0" 16 | VALUE "InternalName", "Total Demo" 17 | VALUE "OriginalFilename", "Total Demo" 18 | VALUE "ProductName", "Total Demo" 19 | VALUE "ProductVersion", "1.0.0.0" 20 | } 21 | } 22 | 23 | BLOCK "VarFileInfo" 24 | { 25 | VALUE "Translation", 0x0413 0x04E4 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /DW.OTA.Types.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Types; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | type 12 | TBuildMode = (Clean, Compile, Build, Deploy); 13 | 14 | TDeployMode = (Normal, AdHoc, AppStore); 15 | 16 | TProjectPlatform = (Android32, Android64, iOSDevice32, iOSDevice64, iOSSimulatorArm64, Linux64, macOS32, macOS64, macOSArm64, Win32, Win64); 17 | 18 | TProjectPlatforms = set of TProjectPlatform; 19 | 20 | TProjectConfiguration = (Debug, Release); 21 | 22 | TProjectConfigurations = set of TProjectConfiguration; 23 | 24 | implementation 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020-2023 Dave Nottage 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Demo/TotalDemo.Resources.pas: -------------------------------------------------------------------------------- 1 | unit TotalDemo.Resources; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, System.ImageList, Vcl.ImgList, Vcl.Controls, System.Actions, Vcl.ActnList; 7 | 8 | type 9 | TResources = class(TDataModule) 10 | ActionList: TActionList; 11 | Demo1Action: TAction; 12 | ImageList: TImageList; 13 | Demo2Action: TAction; 14 | procedure Demo1ActionExecute(Sender: TObject); 15 | procedure Demo2ActionExecute(Sender: TObject); 16 | public 17 | constructor Create(AOwner: TComponent); override; 18 | end; 19 | 20 | var 21 | Resources: TResources; 22 | 23 | implementation 24 | 25 | {%CLASSGROUP 'Vcl.Controls.TControl'} 26 | 27 | {$R *.dfm} 28 | 29 | uses 30 | ToolsAPI, 31 | DW.OTA.Helpers; 32 | 33 | { TWziardResources } 34 | 35 | constructor TResources.Create(AOwner: TComponent); 36 | var 37 | LServices: INTAServices; 38 | begin 39 | inherited; 40 | LServices := BorlandIDEServices as INTAServices; 41 | LServices.AddImages(ImageList); 42 | LServices.AddActionMenu('', Demo1Action, nil); 43 | LServices.AddActionMenu('', Demo2Action, nil); 44 | end; 45 | 46 | procedure TResources.Demo1ActionExecute(Sender: TObject); 47 | begin 48 | // Does nothing 49 | end; 50 | 51 | procedure TResources.Demo2ActionExecute(Sender: TObject); 52 | begin 53 | // Does nothing 54 | end; 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /DW.OTA.Visualizers.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Visualizers; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | ToolsAPI; 13 | 14 | type 15 | IVisualizers = interface(IInterface) 16 | ['{F73F09FC-9D54-424B-81CA-7599C9E72E88}'] 17 | procedure Add(const AVisualizer: IOTADebuggerVisualizer); 18 | end; 19 | 20 | var 21 | Visualizers: IVisualizers; 22 | 23 | implementation 24 | 25 | type 26 | TVisualizers = class(TInterfacedObject, IVisualizers) 27 | private 28 | FItems: TArray; 29 | public 30 | { IVisualizers } 31 | procedure Add(const AVisualizer: IOTADebuggerVisualizer); 32 | public 33 | destructor Destroy; override; 34 | end; 35 | 36 | { TVisualizers } 37 | 38 | procedure TVisualizers.Add(const AVisualizer: IOTADebuggerVisualizer); 39 | begin 40 | FItems := FItems + [AVisualizer]; 41 | (BorlandIDEServices as IOTADebuggerServices).RegisterDebugVisualizer(AVisualizer); 42 | end; 43 | 44 | destructor TVisualizers.Destroy; 45 | var 46 | LVisualizer: IOTADebuggerVisualizer; 47 | begin 48 | for LVisualizer in FItems do 49 | (BorlandIDEServices as IOTADebuggerServices).UnregisterDebugVisualizer(LVisualizer); 50 | inherited; 51 | end; 52 | 53 | initialization 54 | Visualizers := TVisualizers.Create; 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /Demo/TotalDemo.FormEnhancer.pas: -------------------------------------------------------------------------------- 1 | unit TotalDemo.FormEnhancer; 2 | 3 | interface 4 | 5 | uses 6 | Vcl.Forms; 7 | 8 | type 9 | TFormEnhancer = record 10 | private 11 | class procedure EnhanceVariableEntryDialog(const AForm: TForm); static; 12 | public 13 | class procedure EnhanceActiveForm; static; 14 | end; 15 | 16 | implementation 17 | 18 | uses 19 | System.SysUtils, 20 | Vcl.Controls; 21 | 22 | const 23 | cFormsVariableEntryDialogClassName = 'TVariableEntry'; 24 | 25 | { TFormEnhancer } 26 | 27 | class procedure TFormEnhancer.EnhanceActiveForm; 28 | var 29 | LForm: TForm; 30 | begin 31 | LForm := Screen.ActiveForm; 32 | if LForm <> nil then 33 | begin 34 | if LForm.ClassName.Equals(cFormsVariableEntryDialogClassName) then 35 | EnhanceVariableEntryDialog(LForm); 36 | // Other "enhancements" can follow, here 37 | end; 38 | end; 39 | 40 | class procedure TFormEnhancer.EnhanceVariableEntryDialog(const AForm: TForm); 41 | var 42 | LControl: TControl; 43 | begin 44 | // This method is an example of how an IDE dialog might be "enhanced" 45 | // It was used for making the Environment Variable Entry dialog resizable in Delphi 10.2 Tokyo (no longer necessary for Delphi 10.3.x +) 46 | AForm.BorderStyle := TFormBorderStyle.bsSizeable; 47 | AForm.Width := AForm.Width + 4; 48 | AForm.Height := AForm.Height + 4; 49 | AForm.Constraints.MaxHeight := AForm.Height; 50 | LControl := TControl(AForm.FindComponent('VarName')); 51 | if LControl <> nil then 52 | LControl.Anchors := LControl.Anchors + [TAnchorKind.akRight]; 53 | LControl := TControl(AForm.FindComponent('VarValue')); 54 | if LControl <> nil then 55 | LControl.Anchors := LControl.Anchors + [TAnchorKind.akRight]; 56 | LControl := TControl(AForm.FindComponent('bOK')); 57 | if LControl <> nil then 58 | LControl.Anchors := [TAnchorKind.akBottom, TAnchorKind.akRight]; 59 | LControl := TControl(AForm.FindComponent('bCancel')); 60 | if LControl <> nil then 61 | LControl.Anchors := [TAnchorKind.akBottom, TAnchorKind.akRight]; 62 | LControl := TControl(AForm.FindComponent('bHelp')); 63 | if LControl <> nil then 64 | LControl.Anchors := [TAnchorKind.akBottom, TAnchorKind.akRight]; 65 | end; 66 | 67 | end. 68 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | *.deployproj 71 | !Tools/*.exe 72 | AndroidManifest.template.xml 73 | Entitlement.TemplateOSX.xml 74 | Entitlement.TemplateiOS.xml 75 | info.plist.TemplateOSX.xml 76 | info.plist.TemplateIOS.xml 77 | *.res 78 | .DS_Store 79 | Unused 80 | LaunchScreen.TemplateiOS 81 | Settings.bundle 82 | **/Android/Debug 83 | **/Android/Release 84 | **/Android64/Debug 85 | **/Android64/Release 86 | **/iOSDevice64/Debug/ 87 | **/iOSDevice64/Release/ 88 | **/OSX64/Debug/ 89 | **/OSX64/Release/ 90 | **/Win32/Debug/ 91 | **/Win32/Release/ 92 | **/Win64/Debug/ 93 | **/Win64/Release/ 94 | ThirdParty/Firebase/iOS/Firebase.6.* 95 | **/Service/*.java 96 | **/Service/JavaClasses 97 | dbgout.log 98 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TOTAL 2 | 3 | TOTAL is an acronym for: Terrific Open Tools API Library 4 | 5 | TOTAL is used as the foundation for the [Codex Delphi add-in](https://www.delphiworlds.com/Codex) 6 | 7 | ## Objective 8 | 9 | The goal of TOTAL was to create a framework for creating Delphi add-ins, whilst keeping everything as simple as possible. Having said that, developing Delphi add-ins is by no means simple. 10 | 11 | ## Supported Delphi versions 12 | 13 | TOTAL officially supports Delphi 12 and 11.x, however it may compile for earlier versions. 14 | 15 | ## Creating an add-in 16 | 17 | **Note that TOTAL has a dependency on the [Kastri library](https://github.com/DelphiWorlds/Kastri)** 18 | 19 | 1. In Delphi, File|New|Other, select Delphi, then Dynamic Library (currently only DLL add-ins are supported with TOTAL) 20 | 2. In the Project Options, select Building > Delphi Compiler, All configurations - All platforms 21 | 3. Optional: In Conditional Defines enter: EXPERT (please see below about how it is used) 22 | 4. In the Search Path box, ensure that you have paths to the API, Core and Include folders of Kastri 23 | 5. Create a 24x24 bitmap called Icon.bmp which will be used as the icon on the Delphi splash screen when your add-in loads, and save it in your add-in project folder 24 | 6. Create a new unit (this will be for the wizard for your add-in) 25 | Typically, your add-in will use a wizard based on TIDENotifierWizard. You can use the TotalDemo.OTAWizard unit from the demo project as a basis or as a guideline for your wizard. The main requirements are the Initialize function, the exports and initialization sections at the bottom of the unit 26 | 27 | This completes the basic requirements for your add-in. 28 | 29 | ## TOTAL helper functions 30 | 31 | Total has a number of functions (in TOTAHelper record in the DW.OTA.Helpers unit) to help you code your add-in. Here are just a few: 32 | 33 | ### TOTAHelper.ApplyTheme 34 | 35 | Applies the active theme to a component and its children. Updates the UI properties like Color, Font.Color on controls that do not use style hooks (eg TLabel, TPanel etc) 36 | If your form has these kinds of components, you could call this method when the form is created e.g. in an overridden Create method or OnCreate event, like this: 37 | 38 | `TOTAHelper.ApplyTheme(Self);` 39 | 40 | ### TOTAHelper.FindTopMenu 41 | 42 | Finds a top-level menu in the IDE with the given *name*. Note that the name is usually different from the *caption* 43 | 44 | ### TOTAHelper.FindToolsMenu 45 | 46 | Finds the Tools top-level menu item in the IDE. Use this if you want to place a menu item of your own under the Tools menu 47 | 48 | ### Other functions 49 | 50 | There are a number of other helper functions - please refer to the DW.OTA.Helpers unit as they are all documented there 51 | 52 | ## Demo 53 | 54 | There is a project in the Demo folder that you can use as a guide 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /DW.OTA.ProjectConfigComboBox.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.ProjectConfigComboBox; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | ToolsAPI, PlatformAPI, 13 | DW.OTA.BaseProjectConfigComboBox; 14 | 15 | type 16 | TOTAProjectConfigComboBox = class(TBaseProjectConfigComboBox) 17 | private 18 | FPlatforms: IOTAProjectPlatforms; 19 | FConfigs: TArray; 20 | procedure AddConfig(const AConfig: IOTABuildConfiguration); 21 | procedure AddConfigPlatform(const AConfig: IOTABuildConfiguration); 22 | function GetSelectedConfig: IOTABuildConfiguration; 23 | protected 24 | procedure DoLoadTargets; override; 25 | public 26 | procedure Clear; override; 27 | property SelectedConfig: IOTABuildConfiguration read GetSelectedConfig; 28 | end; 29 | 30 | implementation 31 | 32 | uses 33 | System.SysUtils, 34 | DW.Proj.Types, 35 | DW.OTA.Helpers, DW.OTA.Types; 36 | 37 | { TOTAProjectConfigComboBox } 38 | 39 | procedure TOTAProjectConfigComboBox.AddConfigPlatform(const AConfig: IOTABuildConfiguration); 40 | var 41 | LTarget: TProjectTarget; 42 | LProjectPlatform: TProjectPlatform; 43 | begin 44 | LProjectPlatform := TProjectPlatform.Win32; 45 | TProjectPlatformHelper.FindProjectPlatform(AConfig.Platform, LProjectPlatform); 46 | LTarget := TProjectTarget.Create(TProjConfig.Create(AConfig.Name, ''), LProjectPlatform, AConfig.Platform = ''); 47 | Targets.Add(LTarget); 48 | Items.Add(LTarget.GetDisplayValue(True)); 49 | FConfigs := FConfigs + [AConfig]; 50 | end; 51 | 52 | procedure TOTAProjectConfigComboBox.Clear; 53 | begin 54 | inherited; 55 | FConfigs := []; 56 | end; 57 | 58 | procedure TOTAProjectConfigComboBox.AddConfig(const AConfig: IOTABuildConfiguration); 59 | var 60 | I: Integer; 61 | LPlatform: string; 62 | begin 63 | AddConfigPlatform(AConfig); 64 | for LPlatform in FPlatforms.EnabledPlatforms do 65 | AddConfigPlatform(AConfig.PlatformConfiguration[LPlatform]); 66 | for I := 0 to AConfig.ChildCount -1 do 67 | AddConfig(AConfig.Children[I]); 68 | end; 69 | 70 | procedure TOTAProjectConfigComboBox.DoLoadTargets; 71 | var 72 | LProject: IOTAProject; 73 | LConfigs: IOTAProjectOptionsConfigurations; 74 | begin 75 | LProject := TOTAHelper.GetActiveProject; 76 | if (LProject <> nil) and Supports(LProject, IOTAProjectPlatforms, FPlatforms) 77 | and Supports(LProject.ProjectOptions, IOTAProjectOptionsConfigurations, LConfigs) then 78 | begin 79 | AddConfig(LConfigs.BaseConfiguration); 80 | end; 81 | end; 82 | 83 | function TOTAProjectConfigComboBox.GetSelectedConfig: IOTABuildConfiguration; 84 | begin 85 | Result := nil; 86 | if (ItemIndex > -1) and (ItemIndex < Length(FConfigs)) then 87 | Result := FConfigs[ItemIndex]; 88 | end; 89 | 90 | end. 91 | -------------------------------------------------------------------------------- /DW.Menus.Helpers.pas: -------------------------------------------------------------------------------- 1 | unit DW.Menus.Helpers; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | System.Classes, 13 | Vcl.Menus; 14 | 15 | type 16 | TMenuItemHelper = class helper for TMenuItem 17 | public 18 | class function CreateWithAction(const AOwner: TComponent; const ACaption: string; const AHandler: TNotifyEvent; 19 | const AImageIndex: Integer = -1): TMenuItem; 20 | class function CreateSeparator(const AOwner: TComponent; const AIndex: Integer = -1): TMenuItem; 21 | public 22 | function FindMenuByCaption(const ACaption: string; out AItem: TMenuItem): Boolean; 23 | procedure Sort(const AToSeparator: Boolean = False); 24 | end; 25 | 26 | implementation 27 | 28 | uses 29 | // RTL 30 | System.SysUtils, 31 | // Vcl 32 | Vcl.ActnList; 33 | 34 | { TMenuItemHelper } 35 | 36 | class function TMenuItemHelper.CreateSeparator(const AOwner: TComponent; const AIndex: Integer = -1): TMenuItem; 37 | var 38 | LParent: TMenuItem; 39 | begin 40 | Result := nil; 41 | LParent := TMenuItem(AOwner); 42 | if (LParent.Count > 0) and ((AIndex <> -1) or (LParent.Items[LParent.Count - 1].Caption <> '-')) then 43 | begin 44 | Result := TMenuItem.Create(AOwner); 45 | Result.Caption := '-'; 46 | if AIndex > -1 then 47 | LParent.Insert(AIndex, Result) 48 | else 49 | LParent.Insert(TMenuItem(AOwner).Count, Result); 50 | end; 51 | end; 52 | 53 | class function TMenuItemHelper.CreateWithAction(const AOwner: TComponent; const ACaption: string; const AHandler: TNotifyEvent; 54 | const AImageIndex: Integer = -1): TMenuItem; 55 | var 56 | LAction: TAction; 57 | begin 58 | Result := TMenuItem.Create(AOwner); 59 | LAction := TAction.Create(Result); 60 | LAction.Caption := ACaption; 61 | LAction.OnExecute := AHandler; 62 | Result.Action := LAction; 63 | // if AInsert and (AOwner is TMenuItem) then 64 | // TMenuItem(AOwner).Insert(TMenuItem(AOwner).Count, Result); 65 | Result.ImageIndex := AImageIndex; 66 | end; 67 | 68 | function TMenuItemHelper.FindMenuByCaption(const ACaption: string; out AItem: TMenuItem): Boolean; 69 | var 70 | I: Integer; 71 | begin 72 | Result := False; 73 | for I := 0 to Count - 1 do 74 | begin 75 | if string(Items[I].Caption).Equals(ACaption) then 76 | begin 77 | AItem := Items[I]; 78 | Exit(True); 79 | end; 80 | end; 81 | end; 82 | 83 | // A variation of: http://embarcadero.newsgroups.archived.at/public.delphi.language.delphi.win32/200912/0912166323.html 84 | procedure TMenuItemHelper.Sort; 85 | var 86 | I, J: Integer; 87 | begin 88 | for I := 0 to Count - 2 do 89 | begin 90 | for J := I + 1 to Count - 1 do 91 | begin 92 | if Items[J].Caption < Items[I].Caption then 93 | Items[J].MenuIndex := Items[I].MenuIndex; 94 | end; 95 | end; 96 | end; 97 | 98 | end. 99 | -------------------------------------------------------------------------------- /DW.OTA.ProjConfigComboBox.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.ProjConfigComboBox; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | // DW 13 | DW.Proj, 14 | // TOTAL 15 | DW.OTA.BaseProjectConfigComboBox; 16 | 17 | type 18 | TProjConfigComboBox = class(TBaseProjectConfigComboBox) 19 | private 20 | FFileName: string; 21 | FProj: IProj; 22 | procedure SetFileName(const Value: string); 23 | protected 24 | procedure DoLoadTargets; override; 25 | public 26 | procedure Clear; override; 27 | function GetSelectedSearchPaths: TArray; 28 | property FileName: string read FFileName write SetFileName; 29 | end; 30 | 31 | implementation 32 | 33 | uses 34 | // RTL 35 | System.SysUtils, System.IOUtils, 36 | // DW 37 | DW.Proj.Types, 38 | // TOTAL 39 | DW.OTA.Types; 40 | 41 | { TProjConfigComboBox } 42 | 43 | procedure TProjConfigComboBox.SetFileName(const Value: string); 44 | begin 45 | if not SameText(Value, FFileName) and TFile.Exists(Value) then 46 | begin 47 | FFileName := Value; 48 | LoadTargets; 49 | end; 50 | end; 51 | 52 | procedure TProjConfigComboBox.Clear; 53 | begin 54 | inherited; 55 | FProj := nil; 56 | end; 57 | 58 | procedure TProjConfigComboBox.DoLoadTargets; 59 | var 60 | LConfig: TProjConfig; 61 | LPlatform: string; 62 | LPlatforms: TArray; 63 | LGroup: IProjPropertyGroup; 64 | LProjectPlatform: TProjectPlatform; 65 | LTarget: TProjectTarget; 66 | begin 67 | if FProj = nil then 68 | FProj := TProj.Create(FFileName) 69 | else 70 | FProj.LoadFromFile(FFileName); 71 | LPlatforms := FProj.GetPlatforms(True); 72 | for LConfig in FProj.GetConfigs do 73 | begin 74 | LTarget := TProjectTarget.Create(LConfig, TProjectPlatform.Win32, True); 75 | Targets.Add(LTarget); 76 | Items.Add(LTarget.GetDisplayValue(True)); 77 | for LPlatform in LPlatforms do 78 | begin 79 | if FProj.FindPropertyGroup(LConfig.Ident, LPlatform, LGroup) and TProjectPlatformHelper.FindProjectPlatform(LPlatform, LProjectPlatform) then 80 | begin 81 | LTarget := TProjectTarget.Create(LConfig, LProjectPlatform, False); 82 | Targets.Add(LTarget); 83 | Items.Add(LTarget.GetDisplayValue(True)); 84 | end; 85 | end; 86 | end; 87 | end; 88 | 89 | function TProjConfigComboBox.GetSelectedSearchPaths: TArray; 90 | var 91 | LTarget: TProjectTarget; 92 | LPlatform: string; 93 | begin 94 | if (FProj <> nil) and (Length(Targets) > 0) and (ItemIndex >= 0) and (ItemIndex < Length(Targets)) then 95 | begin 96 | LTarget := Targets[ItemIndex]; 97 | if LTarget.IsAllPlatforms then 98 | LPlatform := '' 99 | else 100 | LPlatform := cProjectPlatformsShort[LTarget.Target]; 101 | Result := FProj.GetProjectPaths(LPlatform, LTarget.Config.Name); 102 | end; 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /DW.OTA.Consts.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Consts; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | {$IF Defined(EXPERT)} PlatformConst, ToolsAPI, {$ENDIF} 13 | DW.OTA.Types; 14 | 15 | const 16 | {$IF CompilerVersion < 33} 17 | ciOSSimulator32Platform = ciOSSimulatorPlatform; 18 | cOSX64Platform = 'OSX64'; 19 | {$ENDIF} 20 | {$IF CompilerVersion < 35} 21 | cOSXArm64Platform = 'OSXARM64'; 22 | ciOSSimulatorArm64Platform = 'iOSSimulator64'; 23 | {$ENDIF} 24 | 25 | {$IF Defined(EXPERT)} 26 | cProjectPlatforms: array[TProjectPlatform] of string = ( 27 | 'Android', 'Android64', 28 | ciOSDevice32Platform, ciOSDevice64Platform, ciOSSimulatorArm64Platform, 29 | cLinux64Platform, 30 | cOSX32Platform, cOSX64Platform, cOSXArm64Platform, 31 | cWin32Platform, cWin64Platform 32 | ); 33 | {$ENDIF} 34 | 35 | cProjectPlatformsShort: array[TProjectPlatform] of string = ( 36 | 'Android', 'Android64', 37 | 'iOS32', 'iOS64', 'iOSSimArm64', 38 | 'Linux64', 39 | 'macOS32', 'macOS64', 'macOSArm64', 40 | 'Win32', 'Win64' 41 | ); 42 | 43 | cProjectPlatformsLong: array[TProjectPlatform] of string = ( 44 | 'Android 32-bit', 'Android 64-bit', 45 | 'iOS 32-bit', 'iOS 64-bit', 'iOS Simulator ARM 64-bit', 46 | 'Linux 64-bit', 47 | 'macOS 32-bit', 'macOS 64-bit', 'macOS ARM 64-bit', 48 | 'Windows 32-bit', 'Windows 64-bit' 49 | ); 50 | 51 | cProjectPlatformDefaultBuildType: array[TProjectPlatform] of string = ( 52 | 'Development', 'Development', 53 | 'Development', 'Development', 'Development', 54 | '', 55 | 'Normal', 'Normal', 'Normal', 56 | 'Normal', 'Normal' 57 | ); 58 | 59 | cProjectPlatformsIDE: array[TProjectPlatform] of string = ( 60 | 'Android', 'Android64', 61 | 'iOSDevice32' , 'iOSDevice64', 'iOSSimulatorArm64', 62 | 'Linux64', 63 | 'OSX32', 'OSX64', 'OSXArm64', 64 | 'Win32', 'Win64' 65 | ); 66 | 67 | cProjectPlatformsRegistry: array[TProjectPlatform] of string = ( 68 | 'Android32', 'Android64', 69 | 'iOSDevice32' , 'iOSDevice64', 'iOSSimulatorArm64', 70 | 'Linux64', 71 | 'OSX32', 'OSX64', 'OSXArm64', 72 | 'Win32', 'Win64' 73 | ); 74 | 75 | cProjectConfigurations: array[TProjectConfiguration] of string = ('Debug', 'Release'); 76 | 77 | {$IF Defined(EXPERT)} 78 | cCompileModes: array[TOTACompileMode] of string = ('Compile', 'Build', 'Check', 'Make Unit' {$IF CompilerVersion > 34}, 'Clean', 'Link'{$ENDIF}); 79 | {$ENDIF} 80 | 81 | cBuildModes: array[TBuildMode] of string = ('Clean', 'Make', 'Build', 'Deploy'); 82 | 83 | cDeployModes: array[TDeployMode] of string = ('', 'AdHoc', 'AppStore'); 84 | 85 | cCompileResults: array[Boolean] of string = ('FAILED', 'Succeeded'); 86 | 87 | cProjectOptionOutputDir = 'OutputDir'; 88 | 89 | cProductVersionNumbers: array[17..24] of string = ('10', '10.1', '10.2', '10.3', '10.4', '11', '12', '13'); 90 | 91 | {$IF Defined(EXPERT)} 92 | cIDEToolBarNames: array[0..14] of string = ( 93 | sCustomToolBar, sStandardToolBar, sDebugToolBar, sViewToolBar, sDesktopToolBar, sAlignToolbar, sBrowserToolbar, 94 | sHTMLDesignToolbar, sHTMLFormatToolbar, sHTMLTableToolbar, sPersonalityToolBar, sPositionToolbar, 95 | sSpacingToolbar, sIDEInsightToolbar, sPlatformDeviceToolbar 96 | ); 97 | 98 | cMacOSPlatformNames: array[0..4] of string = ( 99 | ciOSDevice32Platform, ciOSDevice64Platform, ciOSSimulator32Platform, cOSX32Platform, cOSX64Platform 100 | ); 101 | {$ENDIF} 102 | cAppleProjectPlatforms: set of TProjectPlatform = [TProjectPlatform.iOSSimulatorArm64, TProjectPlatform.iOSDevice64, 103 | TProjectPlatform.macOS32, TProjectPlatform.macOS64, TProjectPlatform.macOSArm64]; 104 | cIOSProjectPlatforms: set of TProjectPlatform = [TProjectPlatform.iOSSimulatorArm64, TProjectPlatform.iOSDevice64]; 105 | cMacOSProjectPlatforms: set of TProjectPlatform = [TProjectPlatform.macOS32, TProjectPlatform.macOS64, TProjectPlatform.macOSArm64]; 106 | cAndroidProjectPlatforms: set of TProjectPlatform = [TProjectPlatform.Android32, TProjectPlatform.Android64]; 107 | 108 | cTabChar = #9; 109 | cLineFeedChar = #10; 110 | cCarriageReturnChar = #13; 111 | 112 | implementation 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /DW.OTA.Registry.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Registry; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | // RTL 13 | System.Win.Registry, System.Classes; 14 | 15 | type 16 | TBDSRegistry = class(TRegistry) 17 | private 18 | class var FCurrent: TBDSRegistry; 19 | class destructor DestroyClass; 20 | class function GetCurrent: TBDSRegistry; static; 21 | private 22 | FRootPath: string; 23 | protected 24 | function FindNextKeyIndex(const AKeys: TStrings; const AKey: string): Integer; 25 | public 26 | class property Current: TBDSRegistry read GetCurrent; 27 | public 28 | constructor Create; 29 | function GetUpdateVersion: Integer; // i.e. is it 10.4.0, 10.4.1, 10.4.2 etc 30 | function OpenSubKey(const APath: string; const ACanCreate: Boolean = False): Boolean; 31 | procedure ReadKeys(const APath: string; const AKeys: TStrings); overload; 32 | function ReadKeys(const APath: string): TArray; overload; 33 | function ReadSubKeyString(const APath, AName: string): string; 34 | function ReadValues(const APath: string): TArray; 35 | function WriteSubKeyString(const APath, AName, AValue: string): Boolean; 36 | function WriteValues(const APath, ANamePrefix: string; const AValues: TArray): Boolean; 37 | property RootPath: string read FRootPath; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | // RTL 44 | System.SysUtils, 45 | // Windows 46 | Winapi.Windows, 47 | // DW 48 | DW.OTA.Helpers; 49 | 50 | { TBDSRegistry } 51 | 52 | constructor TBDSRegistry.Create; 53 | var 54 | LAccess: Cardinal; 55 | begin 56 | LAccess := KEY_READ or KEY_WRITE; 57 | if TOSVersion.Architecture = TOSVersion.TArchitecture.arIntelX64 then 58 | LAccess := LAccess or KEY_WOW64_64KEY 59 | else 60 | LAccess := LAccess or KEY_WOW64_32KEY; 61 | inherited Create(LAccess); 62 | RootKey := HKEY_CURRENT_USER; 63 | FRootPath := TOTAHelper.GetRegKey; 64 | end; 65 | 66 | class destructor TBDSRegistry.DestroyClass; 67 | begin 68 | FCurrent.Free; 69 | end; 70 | 71 | function TBDSRegistry.FindNextKeyIndex(const AKeys: TStrings; const AKey: string): Integer; 72 | var 73 | I, LKeyIndex: Integer; 74 | LKeyName: string; 75 | begin 76 | Result := -1; 77 | for I := 0 to AKeys.Count - 1 do 78 | begin 79 | LKeyName := AKeys[I]; 80 | if LKeyName.StartsWith(AKey) and TryStrToInt(LKeyName.Substring(Length(AKey)), LKeyIndex) and (LKeyIndex > Result) then 81 | Result := LKeyIndex; 82 | end; 83 | if Result > -1 then 84 | Inc(Result); 85 | end; 86 | 87 | class function TBDSRegistry.GetCurrent: TBDSRegistry; 88 | begin 89 | if FCurrent = nil then 90 | FCurrent := TBDSRegistry.Create; 91 | Result := FCurrent; 92 | end; 93 | 94 | function TBDSRegistry.GetUpdateVersion: Integer; 95 | var 96 | LParts: TArray; 97 | begin 98 | Result := -1; // Cannot determine 99 | if OpenKey(FRootPath + '\InstalledUpdates', False) then 100 | try 101 | LParts := ReadString('Main Product Update').Split([' ']); // e.g. Delphi 10.4 and C++Builder 10.4 Update 2 102 | if Length(LParts) > 0 then 103 | Result := StrToIntDef(LParts[Length(LParts) - 1], -1); 104 | finally 105 | CloseKey; 106 | end; 107 | end; 108 | 109 | function TBDSRegistry.OpenSubKey(const APath: string; const ACanCreate: Boolean): Boolean; 110 | begin 111 | Result := OpenKey(FRootPath + APath, ACanCreate); 112 | end; 113 | 114 | function TBDSRegistry.ReadKeys(const APath: string): TArray; 115 | var 116 | LKeys: TStrings; 117 | begin 118 | LKeys := TStringList.Create; 119 | try 120 | ReadKeys(APath, LKeys); 121 | Result := LKeys.ToStringArray; 122 | finally 123 | LKeys.Free; 124 | end; 125 | end; 126 | 127 | function TBDSRegistry.ReadSubKeyString(const APath, AName: string): string; 128 | begin 129 | Result := ''; 130 | if OpenSubKey(APath) then 131 | try 132 | if ValueExists(AName) then 133 | Result := ReadString(AName); 134 | finally 135 | CloseKey; 136 | end; 137 | end; 138 | 139 | function TBDSRegistry.ReadValues(const APath: string): TArray; 140 | var 141 | LKeys: TStrings; 142 | I: Integer; 143 | begin 144 | if OpenSubKey(APath) then 145 | try 146 | LKeys := TStringList.Create; 147 | try 148 | GetValueNames(LKeys); 149 | for I := 0 to LKeys.Count - 1 do 150 | Result := Result + [ReadString(LKeys[I])]; 151 | finally 152 | LKeys.Free; 153 | end; 154 | finally 155 | CloseKey; 156 | end; 157 | end; 158 | 159 | function TBDSRegistry.WriteSubKeyString(const APath, AName, AValue: string): Boolean; 160 | begin 161 | Result := False; 162 | if OpenSubKey(APath, True) then 163 | try 164 | WriteString(AName, AValue); 165 | Result := True; 166 | finally 167 | CloseKey; 168 | end; 169 | end; 170 | 171 | function TBDSRegistry.WriteValues(const APath, ANamePrefix: string; const AValues: TArray): Boolean; 172 | var 173 | I: Integer; 174 | begin 175 | Result := False; 176 | if OpenSubKey(APath) then 177 | try 178 | for I := 0 to Length(AValues) - 1 do 179 | WriteString(ANamePrefix + I.ToString, AValues[I]); 180 | Result := True; 181 | finally 182 | CloseKey; 183 | end; 184 | end; 185 | 186 | procedure TBDSRegistry.ReadKeys(const APath: string; const AKeys: TStrings); 187 | begin 188 | AKeys.Clear; 189 | if OpenSubKey(APath) then 190 | try 191 | GetKeyNames(AKeys); 192 | finally 193 | CloseKey; 194 | end; 195 | end; 196 | 197 | end. 198 | -------------------------------------------------------------------------------- /DW.OTA.CustomMessage.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.CustomMessage; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | System.Types, 13 | ToolsAPI, 14 | Vcl.Graphics; 15 | 16 | type 17 | TCustomMessage = class(TInterfacedObject, IOTACustomMessage, INTACustomDrawMessage) 18 | private 19 | FColumnNumber: Integer; 20 | FFileName: string; 21 | FLineNumber: Integer; 22 | FLineText: string; 23 | public 24 | { IOTACustomMessage } 25 | function GetColumnNumber: Integer; 26 | function GetFileName: string; 27 | function GetLineNumber: Integer; 28 | function GetLineText: string; 29 | procedure ShowHelp; virtual; 30 | { INTACustomDrawMessage } 31 | function CalcRect(Canvas: TCanvas; MaxWidth: Integer; Wrap: Boolean): TRect; virtual; 32 | procedure Draw(Canvas: TCanvas; const Rect: TRect; Wrap: Boolean); virtual; 33 | public 34 | constructor Create(const ALineText: string; const AFileName: string = ''; const ALineNumber: Integer = 0; const AColumnNumber: Integer = 0); 35 | end; 36 | 37 | TTextStyle = record 38 | Bold: Boolean; 39 | Italic: Boolean; 40 | Underline: Boolean; 41 | Color: TColor; 42 | end; 43 | 44 | // Uses same scheme as HTML for bold , italic and underline 45 | // Uses a tag with # for colors, e.g.: <#FF4455> 46 | // Needs a closing tag for each opening tag, e.g. This is bold and <#FF0000>this part is in red 47 | 48 | THighlightedCustomMessage = class(TCustomMessage) 49 | private 50 | procedure DrawText(const ACanvas: TCanvas; const AX, AY: Integer; const AText: string; const AStyle: TTextStyle); 51 | public 52 | procedure Draw(Canvas: TCanvas; const Rect: TRect; Wrap: Boolean); override; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | System.SysUtils; 59 | 60 | { TCustomMessage } 61 | 62 | constructor TCustomMessage.Create(const ALineText: string; const AFileName: string = ''; const ALineNumber: Integer = 0; 63 | const AColumnNumber: Integer = 0); 64 | begin 65 | inherited Create; 66 | FLineText := ALineText; 67 | FFileName := AFileName; 68 | FLineNumber := ALineNumber; 69 | FColumnNumber := AColumnNumber; 70 | end; 71 | 72 | function TCustomMessage.CalcRect(Canvas: TCanvas; MaxWidth: Integer; Wrap: Boolean): TRect; 73 | begin 74 | Result := Canvas.ClipRect; 75 | Result.Bottom := Result.Top + Canvas.TextHeight('W'); 76 | Result.Right := Result.Left + Canvas.TextWidth(FLineText); 77 | end; 78 | 79 | procedure TCustomMessage.Draw(Canvas: TCanvas; const Rect: TRect; Wrap: Boolean); 80 | begin 81 | Canvas.TextOut(Rect.Left, Rect.Top, FLineText); 82 | end; 83 | 84 | function TCustomMessage.GetColumnNumber: Integer; 85 | begin 86 | Result := FColumnNumber; 87 | end; 88 | 89 | function TCustomMessage.GetFileName: string; 90 | begin 91 | Result := FFileName; 92 | end; 93 | 94 | function TCustomMessage.GetLineNumber: Integer; 95 | begin 96 | Result := FLineNumber; 97 | end; 98 | 99 | function TCustomMessage.GetLineText: string; 100 | begin 101 | Result := FLineText; 102 | end; 103 | 104 | procedure TCustomMessage.ShowHelp; 105 | begin 106 | // 107 | end; 108 | 109 | { THighlightedCustomMessage } 110 | 111 | procedure THighlightedCustomMessage.Draw(Canvas: TCanvas; const Rect: TRect; Wrap: Boolean); 112 | var 113 | LStyle: TTextStyle; 114 | LText: string; 115 | I, LStartPos, LEndPos, LX: Integer; 116 | LDefaultColor: TColor; 117 | 118 | function ExtractTag(var APos: Integer): string; 119 | var 120 | LTagEnd: Integer; 121 | begin 122 | Inc(APos); 123 | LTagEnd := APos; 124 | while (LTagEnd <= Length(FLineText)) and (FLineText.Chars[LTagEnd] <> '>') do 125 | Inc(LTagEnd); 126 | Result := Copy(FLineText, APos + 1, LTagEnd - APos); 127 | APos := LTagEnd + 1; 128 | end; 129 | 130 | procedure ApplyTagStyle(const LTag: string); 131 | begin 132 | if LTag = 'b' then 133 | LStyle.Bold := True 134 | else if LTag = '/b' then 135 | LStyle.Bold := False 136 | else if LTag = 'i' then 137 | LStyle.Italic := True 138 | else if LTag = '/i' then 139 | LStyle.Italic := False 140 | else if LTag = 'u' then 141 | LStyle.Underline := True 142 | else if LTag = '/u' then 143 | LStyle.Underline := False 144 | else if Copy(LTag, 1, 1) = '#' then 145 | LStyle.Color := StringToColor('$' + Copy(LTag, 2, 6)) 146 | else if LTag = '/#' then 147 | LStyle.Color := LDefaultColor; 148 | end; 149 | 150 | begin 151 | LDefaultColor := Canvas.Font.Color; 152 | LStyle.Bold := False; 153 | LStyle.Italic := False; 154 | LStyle.Underline := False; 155 | LStyle.Color := LDefaultColor; 156 | LX := Rect.Left; 157 | I := 0; 158 | while I < Length(FLineText) do 159 | begin 160 | if FLineText.Chars[I] <> '<' then 161 | begin 162 | LStartPos := I; 163 | while (I < Length(FLineText)) and (FLineText.Chars[I] <> '<') do 164 | Inc(I); 165 | LEndPos := I - 1; 166 | LText := Copy(FLineText, LStartPos + 1, LEndPos - LStartPos + 1); 167 | DrawText(Canvas, LX, Rect.Top, LText, LStyle); 168 | LX := LX + Canvas.TextWidth(LText); 169 | end 170 | else 171 | ApplyTagStyle(ExtractTag(I)); 172 | end; 173 | end; 174 | 175 | procedure THighlightedCustomMessage.DrawText(const ACanvas: TCanvas; const AX, AY: Integer; const AText: string; const AStyle: TTextStyle); 176 | begin 177 | ACanvas.Font.Style := []; 178 | if AStyle.Bold then ACanvas.Font.Style := 179 | ACanvas.Font.Style + [fsBold]; 180 | if AStyle.Italic then 181 | ACanvas.Font.Style := ACanvas.Font.Style + [fsItalic]; 182 | if AStyle.Underline then 183 | ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline]; 184 | ACanvas.Font.Color := AStyle.Color; 185 | ACanvas.TextOut(AX, AY, AText); 186 | end; 187 | 188 | end. 189 | -------------------------------------------------------------------------------- /DW.OTA.BaseProjectConfigComboBox.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.BaseProjectConfigComboBox; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | System.Types, System.Classes, 13 | Winapi.Messages, 14 | Vcl.Controls, Vcl.StdCtrls, 15 | DW.Proj.Types, 16 | DW.OTA.Types; 17 | 18 | const 19 | cProjectPlatformsShort: array[TProjectPlatform] of string = ( 20 | 'Android', 'Android64', 21 | 'iOSDevice32', 'iOSDevice64', 'iOSSimARM64', 22 | 'Linux64', 23 | 'OSX32', 'OSX64', 'OSXARM64', 24 | 'Win32', 'Win64' 25 | ); 26 | 27 | type 28 | TProjectPlatformHelper = record 29 | class function FindProjectPlatform(const AShortName: string; out APlatform: TProjectPlatform): Boolean; static; 30 | end; 31 | 32 | TProjectTarget = record 33 | Config: TProjConfig; 34 | Target: TProjectPlatform; 35 | IsAllPlatforms: Boolean; 36 | constructor Create(const AConfig: TProjConfig; const ATarget: TProjectPlatform; const AIsAllPlatforms: Boolean); 37 | function GetDisplayValue(const ANeedExtended: Boolean): string; 38 | end; 39 | 40 | TProjectTargets = TArray; 41 | 42 | TProjectTargetsHelper = record helper for TProjectTargets 43 | procedure Add(const ATarget: TProjectTarget); 44 | end; 45 | 46 | TBaseProjectConfigComboBox = class(TComboBox) 47 | private 48 | FTargets: TProjectTargets; 49 | protected 50 | procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; 51 | procedure DoLoadTargets; virtual; 52 | property Targets: TProjectTargets read FTargets; 53 | public 54 | constructor Create(AOwner: TComponent); override; 55 | procedure Clear; override; 56 | procedure LoadTargets; 57 | end; 58 | 59 | implementation 60 | 61 | uses 62 | System.SysUtils, System.IOUtils, 63 | Winapi.Windows, 64 | {$IF Defined(EXPERT)} 65 | BrandingAPI, 66 | {$ENDIF} 67 | Vcl.Graphics; 68 | 69 | const 70 | cProjectPlatformsLong: array[TProjectPlatform] of string = ( 71 | 'Android 32-bit', 'Android 64-bit', 72 | 'iOS 32-bit', 'iOS 64-bit', 'iOS Simulator ARM 64-bit', 73 | 'Linux 64-bit', 74 | 'macOS 32-bit', 'macOS 64-bit', 'macOS ARM 64-bit', 75 | 'Windows 32-bit', 'Windows 64-bit' 76 | ); 77 | 78 | { TProjectPlatformHelper } 79 | 80 | class function TProjectPlatformHelper.FindProjectPlatform(const AShortName: string; out APlatform: TProjectPlatform): Boolean; 81 | var 82 | LPlatform: TProjectPlatform; 83 | begin 84 | Result := False; 85 | for LPlatform := Low(TProjectPlatform) to High(TProjectPlatform) do 86 | begin 87 | if SameText(cProjectPlatformsShort[LPlatform], AShortName) then 88 | begin 89 | APlatform := LPlatform; 90 | Result := True; 91 | Break; 92 | end; 93 | end; 94 | end; 95 | 96 | { TProjectTargetsHelper } 97 | 98 | procedure TProjectTargetsHelper.Add(const ATarget: TProjectTarget); 99 | begin 100 | Self := Self + [ATarget]; 101 | end; 102 | 103 | { TProjectTarget } 104 | 105 | constructor TProjectTarget.Create(const AConfig: TProjConfig; const ATarget: TProjectPlatform; const AIsAllPlatforms: Boolean); 106 | begin 107 | Config := AConfig; 108 | Target := ATarget; 109 | IsAllPlatforms := AIsAllPlatforms; 110 | end; 111 | 112 | function TProjectTarget.GetDisplayValue(const ANeedExtended: Boolean): string; 113 | begin 114 | if Config.Name = 'Base' then 115 | Result := 'All Configurations' 116 | else 117 | Result := Config.Name + ' Configuration'; 118 | if not IsAllPlatforms then 119 | begin 120 | if ANeedExtended then 121 | Result := Format('%s - %s', [Result, cProjectPlatformsLong[Target]]) 122 | else 123 | Result := cProjectPlatformsLong[Target] 124 | end; 125 | end; 126 | 127 | { TBaseProjectConfigComboBox } 128 | 129 | constructor TBaseProjectConfigComboBox.Create(AOwner: TComponent); 130 | begin 131 | inherited; 132 | Style := csOwnerDrawFixed; 133 | end; 134 | 135 | procedure TBaseProjectConfigComboBox.Clear; 136 | begin 137 | inherited; 138 | FTargets := []; 139 | Enabled := False; 140 | end; 141 | 142 | procedure TBaseProjectConfigComboBox.LoadTargets; 143 | begin 144 | Clear; 145 | Items.BeginUpdate; 146 | try 147 | DoLoadTargets; 148 | finally 149 | Items.EndUpdate; 150 | end; 151 | if Length(Targets) > 24 then 152 | DropDownCount := 24 153 | else 154 | DropDownCount := Length(Targets); 155 | if Items.Count > 0 then 156 | ItemIndex := 0; 157 | Enabled := Items.Count > 0; 158 | end; 159 | 160 | procedure TBaseProjectConfigComboBox.DoLoadTargets; 161 | begin 162 | // 163 | end; 164 | 165 | procedure TBaseProjectConfigComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); 166 | var 167 | LTarget: TProjectTarget; 168 | begin 169 | TControlCanvas(Canvas).UpdateTextFlags; 170 | {$IF Defined(EXPERT)} 171 | if (ThemeProperties <> nil) and (odSelected in State) then 172 | begin 173 | Canvas.Brush.Color := ThemeProperties.StyleServices.GetSystemColor(clHighlight); 174 | Canvas.Font.Color := ThemeProperties.StyleServices.GetSystemColor(clHighlightText); 175 | end; 176 | {$ENDIF} 177 | Canvas.FillRect(Rect); 178 | if Index >= 0 then 179 | begin 180 | LTarget := FTargets[Index]; 181 | if (odComboBoxEdit in State) or not DroppedDown then 182 | begin 183 | Canvas.Font.Style := Canvas.Font.Style - [fsBold]; 184 | Canvas.TextOut(Rect.Left, Rect.Top, LTarget.GetDisplayValue(True)); 185 | end 186 | else 187 | begin 188 | if LTarget.IsAllPlatforms then 189 | Canvas.Font.Style := Canvas.Font.Style + [fsBold] 190 | else 191 | Canvas.Font.Style := Canvas.Font.Style - [fsBold]; 192 | Canvas.TextOut(Rect.Left + (Ord(not LTarget.IsAllPlatforms) * 16), Rect.Top, LTarget.GetDisplayValue(odComboBoxEdit in State)); 193 | end; 194 | {$IF Defined(EXPERT)} 195 | if (ThemeProperties <> nil) and (odFocused in State) then 196 | DrawFocusRect(Canvas.Handle, Rect); 197 | {$ENDIF} 198 | end; 199 | end; 200 | 201 | end. 202 | -------------------------------------------------------------------------------- /DW.OTA.IDENotifierOTAWizard.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.IDENotifierOTAWizard; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | ToolsAPI, 13 | DW.OTA.Wizard, DW.OTA.Notifiers; 14 | 15 | type 16 | TIDENotifierOTAWizard = class; 17 | 18 | /// 19 | /// Class for forwarding IDE notifications to the wizard 20 | /// 21 | TIDENotifier = class(TTOTALNotifier, IOTAIDENotifier, IOTAIDENotifier80, ITOTALNotifier) 22 | private 23 | [Weak] FWizard: TIDENotifierOTAWizard; 24 | protected 25 | { IOTAIDENotifier } 26 | procedure AfterCompile(Succeeded: Boolean); overload; 27 | procedure AfterSave; 28 | procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload; 29 | procedure BeforeSave; 30 | procedure Destroyed; 31 | procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); 32 | procedure Modified; 33 | { IOTAIDENotifier50 } 34 | procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload; 35 | procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload; 36 | { IOTAIDENotifier80 } 37 | procedure AfterCompile(const Project: IOTAProject; Succeeded: Boolean; IsCodeInsight: Boolean); overload; 38 | public 39 | constructor Create(const AWizard: TIDENotifierOTAWizard); 40 | destructor Destroy; override; 41 | procedure AddNotifier; override; 42 | procedure RemoveNotifier; override; 43 | end; 44 | 45 | /// 46 | /// Base OTA Wizard that responds to IDE notifications. Create a descendant of this class for your own add-ins 47 | /// 48 | TIDENotifierOTAWizard = class(TOTAWizard) 49 | private 50 | FIDENotifier: ITOTALNotifier; 51 | protected 52 | /// 53 | /// Override IDENotifierAfterCompile to be notified when a compile has finished 54 | /// 55 | procedure IDENotifierAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); virtual; 56 | /// 57 | /// Override IDENotifierAfterSave to be notified after a file is saved 58 | /// 59 | procedure IDENotifierAfterSave; virtual; 60 | /// 61 | /// Override IDENotifierBeforeCompile to be notified when a compile is about to start 62 | /// 63 | procedure IDENotifierBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); virtual; 64 | /// 65 | /// Override IDENotifierAfterSave to be notified when a file is about to be saved 66 | /// 67 | procedure IDENotifierBeforeSave; virtual; 68 | procedure IDENotifierDestroyed; virtual; 69 | /// 70 | /// Override IDENotifierFileNotification to be notified of a TOTAFileNotification 71 | /// 72 | procedure IDENotifierFileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); virtual; 73 | procedure IDEStopped; override; 74 | public 75 | constructor Create; override; 76 | destructor Destroy; override; 77 | end; 78 | 79 | implementation 80 | 81 | { TIDENotifier } 82 | 83 | constructor TIDENotifier.Create(const AWizard: TIDENotifierOTAWizard); 84 | begin 85 | inherited Create; 86 | FWizard := AWizard; 87 | end; 88 | 89 | destructor TIDENotifier.Destroy; 90 | begin 91 | // 92 | inherited; 93 | end; 94 | 95 | procedure TIDENotifier.Destroyed; 96 | begin 97 | FWizard.IDENotifierDestroyed; 98 | end; 99 | 100 | procedure TIDENotifier.AddNotifier; 101 | begin 102 | Index := (BorlandIDEServices as IOTAServices).AddNotifier(Self); 103 | end; 104 | 105 | procedure TIDENotifier.RemoveNotifier; 106 | begin 107 | (BorlandIDEServices as IOTAServices).RemoveNotifier(Index); 108 | end; 109 | 110 | procedure TIDENotifier.AfterCompile(Succeeded: Boolean); 111 | begin 112 | // 113 | end; 114 | 115 | procedure TIDENotifier.AfterCompile(const Project: IOTAProject; Succeeded, IsCodeInsight: Boolean); 116 | begin 117 | FWizard.IDENotifierAfterCompile(Project, Succeeded, IsCodeInsight); 118 | end; 119 | 120 | procedure TIDENotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean); 121 | begin 122 | // 123 | end; 124 | 125 | procedure TIDENotifier.AfterSave; 126 | begin 127 | FWizard.IDENotifierAfterSave; 128 | end; 129 | 130 | procedure TIDENotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); 131 | begin 132 | FWizard.IDENotifierBeforeCompile(Project, False, Cancel); 133 | end; 134 | 135 | procedure TIDENotifier.BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); 136 | begin 137 | FWizard.IDENotifierBeforeCompile(Project, IsCodeInsight, Cancel); 138 | end; 139 | 140 | procedure TIDENotifier.BeforeSave; 141 | begin 142 | FWizard.IDENotifierBeforeSave; 143 | end; 144 | 145 | procedure TIDENotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); 146 | begin 147 | FWizard.IDENotifierFileNotification(NotifyCode, FileName); 148 | end; 149 | 150 | procedure TIDENotifier.Modified; 151 | begin 152 | // Apparently this is never called? 153 | end; 154 | 155 | { TIDENotifierOTAWizard } 156 | 157 | constructor TIDENotifierOTAWizard.Create; 158 | begin 159 | inherited; 160 | FIDENotifier := TIDENotifier.Create(Self); 161 | end; 162 | 163 | destructor TIDENotifierOTAWizard.Destroy; 164 | begin 165 | // 166 | inherited; 167 | end; 168 | 169 | procedure TIDENotifierOTAWizard.IDEStopped; 170 | begin 171 | inherited; 172 | // FIDENotifier.RemoveNotifier; 173 | end; 174 | 175 | procedure TIDENotifierOTAWizard.IDENotifierAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); 176 | begin 177 | IDEAfterCompile(AProject, ASucceeded, AIsCodeInsight); 178 | end; 179 | 180 | procedure TIDENotifierOTAWizard.IDENotifierAfterSave; 181 | begin 182 | // 183 | end; 184 | 185 | procedure TIDENotifierOTAWizard.IDENotifierBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); 186 | begin 187 | IDEBeforeCompile(AProject, AIsCodeInsight, ACancel); 188 | end; 189 | 190 | procedure TIDENotifierOTAWizard.IDENotifierBeforeSave; 191 | begin 192 | // 193 | end; 194 | 195 | procedure TIDENotifierOTAWizard.IDENotifierDestroyed; 196 | begin 197 | // 198 | end; 199 | 200 | procedure TIDENotifierOTAWizard.IDENotifierFileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); 201 | begin 202 | // This passes the notification on to the "plugin" wizards 203 | FileNotification(ANotifyCode, AFileName); 204 | end; 205 | 206 | end. 207 | -------------------------------------------------------------------------------- /Demo/TotalDemo.OTAWizard.pas: -------------------------------------------------------------------------------- 1 | unit TotalDemo.OTAWizard; 2 | 3 | interface 4 | 5 | implementation 6 | 7 | uses 8 | // RTL 9 | System.Classes, 10 | // ToolsAPI 11 | ToolsAPI, 12 | // Vcl 13 | Vcl.Menus, Vcl.Forms, Vcl.Dialogs, 14 | // TOTAL 15 | DW.OTA.Wizard, DW.OTA.IDENotifierOTAWizard, DW.OTA.Helpers, DW.Menus.Helpers, DW.OTA.ProjectManagerMenu, DW.OTA.Notifiers, 16 | // Demo 17 | TotalDemo.Consts, TotalDemo.DockWindowForm, TotalDemo.Resources; 18 | 19 | type 20 | TDemoOTAWizard = class; 21 | 22 | TDemoProjectManagerMenuNotifier = class(TProjectManagerMenuNotifier) 23 | private 24 | FWizard: TDemoOTAWizard; 25 | public 26 | procedure DoAddMenu(const AProject: IOTAProject; const AIdentList: TStrings; const AProjectManagerMenuList: IInterfaceList; 27 | AIsMultiSelect: Boolean); override; 28 | public 29 | constructor Create(const AWizard: TDemoOTAWizard); 30 | end; 31 | 32 | /// 33 | /// Demo add-in wizard descendant that receives IDE notifications 34 | /// 35 | TDemoOTAWizard = class(TIDENotifierOTAWizard) 36 | private 37 | FMenuItem: TMenuItem; 38 | FPMMenuNotifier: ITOTALNotifier; 39 | FThemeNotifier: ITOTALNotifier; 40 | FResources: TResources; 41 | procedure AddDockWindowMenu; 42 | procedure AddMenu; 43 | procedure DemoMenuHandler; 44 | procedure DockWindowActionHandler(Sender: TObject); 45 | procedure AddToolbarButtons; 46 | protected 47 | class function GetWizardName: string; override; 48 | protected 49 | procedure ActiveFormChanged; override; 50 | procedure ChangedTheme; 51 | function GetIDString: string; override; 52 | function GetName: string; override; 53 | function GetWizardDescription: string; override; 54 | class function GetWizardLicense: string; override; 55 | procedure IDEStarted; override; 56 | procedure WizardsCreated; override; 57 | public 58 | constructor Create; override; 59 | destructor Destroy; override; 60 | end; 61 | 62 | const 63 | cPMMPDemoSection = pmmpVersionControlSection + 100000; 64 | cTOTALDemoToolbarName = 'TOTALDemoToolbar'; 65 | cTOTALDemoToolbarCaption = 'TOTAL'; 66 | 67 | type 68 | TDemoThemingServicesNotifier = class(TThemingServicesNotifier) 69 | private 70 | FWizard: TDemoOTAWizard; 71 | public 72 | constructor Create(const AWizard: TDemoOTAWizard); 73 | procedure ChangedTheme; override; 74 | end; 75 | 76 | { TDemoThemingServicesNotifier } 77 | 78 | constructor TDemoThemingServicesNotifier.Create(const AWizard: TDemoOTAWizard); 79 | begin 80 | inherited Create; 81 | FWizard := AWizard; 82 | end; 83 | 84 | procedure TDemoThemingServicesNotifier.ChangedTheme; 85 | begin 86 | FWizard.ChangedTheme; 87 | end; 88 | 89 | { TDemoProjectManagerMenuNotifier } 90 | 91 | constructor TDemoProjectManagerMenuNotifier.Create(const AWizard: TDemoOTAWizard); 92 | begin 93 | inherited Create; 94 | FWizard := AWizard; 95 | end; 96 | 97 | procedure TDemoProjectManagerMenuNotifier.DoAddMenu(const AProject: IOTAProject; const AIdentList: TStrings; 98 | const AProjectManagerMenuList: IInterfaceList; AIsMultiSelect: Boolean); 99 | begin 100 | AProjectManagerMenuList.Add(TProjectManagerMenuSeparator.Create(cPMMPDemoSection)); 101 | AProjectManagerMenuList.Add(TProjectManagerMenu.Create('Demo Item', 'DemoItem', cPMMPDemoSection + 100, FWizard.DemoMenuHandler)); 102 | end; 103 | 104 | { TDemoOTAWizard } 105 | 106 | constructor TDemoOTAWizard.Create; 107 | begin 108 | inherited; 109 | TOTAHelper.RegisterThemeForms([TDockWindowForm]); 110 | FResources := TResources.Create(Application); 111 | FPMMenuNotifier := TDemoProjectManagerMenuNotifier.Create(Self); 112 | FThemeNotifier := TDemoThemingServicesNotifier.Create(Self); 113 | (BorlandIDEServices as INTAServices).NewToolbar(cTOTALDemoToolbarName, cTOTALDemoToolbarCaption); 114 | AddMenu; 115 | AddDockWindowMenu; 116 | AddToolbarButtons; 117 | end; 118 | 119 | destructor TDemoOTAWizard.Destroy; 120 | begin 121 | FMenuItem.Free; 122 | FPMMenuNotifier.RemoveNotifier; 123 | FThemeNotifier.RemoveNotifier; 124 | inherited; 125 | end; 126 | 127 | procedure TDemoOTAWizard.ChangedTheme; 128 | begin 129 | // These calls do nothing, despite what is documented - see: https://quality.embarcadero.com/browse/RSP-43972 130 | TOTAHelper.RegisterThemeForms([TDockWindowForm]); 131 | if DockWindowForm <> nil then 132 | TOTAHelper.ApplyTheme(DockWindowForm); 133 | end; 134 | 135 | procedure TDemoOTAWizard.AddMenu; 136 | var 137 | LToolsMenuItem: TMenuItem; 138 | begin 139 | // Finds the Tools menu in the IDE, and adds its own menu item underneath it 140 | if TOTAHelper.FindToolsMenu(LToolsMenuItem) then 141 | begin 142 | FMenuItem := TMenuItem.Create(nil); 143 | FMenuItem.Name := cTOTALDemoMenuItemName; 144 | FMenuItem.Caption := 'TOTAL Demo'; 145 | LToolsMenuItem.Insert(0, FMenuItem); 146 | end; 147 | end; 148 | 149 | procedure TDemoOTAWizard.AddDockWindowMenu; 150 | var 151 | LMenuItem: TMenuItem; 152 | begin 153 | LMenuItem := TMenuItem.CreateWithAction(FMenuItem, 'Dock Window', DockWindowActionHandler); 154 | FMenuItem.Insert(FMenuItem.Count, LMenuItem); 155 | end; 156 | 157 | procedure TDemoOTAWizard.AddToolbarButtons; 158 | var 159 | LServices: INTAServices; 160 | begin 161 | LServices := BorlandIDEServices as INTAServices; 162 | if LServices.GetToolbar(cTOTALDemoToolbarName) <> nil then 163 | begin 164 | LServices.AddToolButton(cTOTALDemoToolbarName, 'TOTALDemo1Button', FResources.Demo1Action); 165 | LServices.AddToolButton(cTOTALDemoToolbarName, 'TOTALDemo2Button', FResources.Demo2Action); 166 | end; 167 | end; 168 | 169 | procedure TDemoOTAWizard.DockWindowActionHandler(Sender: TObject); 170 | begin 171 | if DockWindowForm = nil then 172 | begin 173 | DockWindowForm := TDockWindowForm.Create(Application); 174 | TOTAHelper.ApplyTheme(DockWindowForm); 175 | end; 176 | DockWindowForm.Show; 177 | end; 178 | 179 | procedure TDemoOTAWizard.DemoMenuHandler; 180 | begin 181 | ShowMessage('Demo item clicked'); 182 | end; 183 | 184 | procedure TDemoOTAWizard.IDEStarted; 185 | begin 186 | inherited; 187 | 188 | end; 189 | 190 | procedure TDemoOTAWizard.WizardsCreated; 191 | begin 192 | inherited; 193 | 194 | end; 195 | 196 | procedure TDemoOTAWizard.ActiveFormChanged; 197 | begin 198 | inherited; 199 | 200 | end; 201 | 202 | // Unique identifier 203 | function TDemoOTAWizard.GetIDString: string; 204 | begin 205 | Result := 'com.delphiworlds.totaldemowizard'; 206 | end; 207 | 208 | function TDemoOTAWizard.GetName: string; 209 | begin 210 | Result := GetWizardName; 211 | end; 212 | 213 | function TDemoOTAWizard.GetWizardDescription: string; 214 | begin 215 | Result := 'Demo of a Delphi IDE Wizard using TOTAL'; 216 | end; 217 | 218 | class function TDemoOTAWizard.GetWizardLicense: string; 219 | begin 220 | Result := 'License for TOTAL Demo'; 221 | end; 222 | 223 | class function TDemoOTAWizard.GetWizardName: string; 224 | begin 225 | Result := 'TOTAL Demo'; 226 | end; 227 | 228 | // Invokes TOTAWizard.InitializeWizard, which in turn creates an instance of the add-in, and registers it with the IDE 229 | function Initialize(const Services: IBorlandIDEServices; RegisterProc: TWizardRegisterProc; 230 | var TerminateProc: TWizardTerminateProc): Boolean; stdcall; 231 | begin 232 | Result := TOTAWizard.InitializeWizard(Services, RegisterProc, TerminateProc, TDemoOTAWizard); 233 | end; 234 | 235 | exports 236 | // Provides a function named WizardEntryPoint that is required by the IDE when loading a DLL-based add-in 237 | Initialize name WizardEntryPoint; 238 | 239 | initialization 240 | // Ensures that the add-in info is displayed on the IDE splash screen and About screen 241 | TDemoOTAWizard.RegisterSplash; 242 | 243 | end. 244 | -------------------------------------------------------------------------------- /DW.OTA.ProjectManagerMenu.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.ProjectManagerMenu; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | // RTL 13 | System.Classes, System.SysUtils, 14 | // Design 15 | ToolsAPI, 16 | // TOTAL 17 | DW.OTA.Notifiers; 18 | 19 | type 20 | TProjectManagerMenu = class; 21 | 22 | TProjectManagerMenuNotifier = class(TTOTALNotifier, IUnknown, IOTANotifier, IOTAProjectMenuItemCreatorNotifier) 23 | protected 24 | procedure AddMenuItem(const AItem: TProjectManagerMenu; const APosition: Integer); 25 | procedure DoAddMenu(const AProject: IOTAProject; const AIdentList: TStrings; const AProjectManagerMenuList: IInterfaceList; 26 | AIsMultiSelect: Boolean); virtual; 27 | procedure DoAddGroupMenu(const AProject: IOTAProject; const AIdentList: TStrings; const AProjectManagerMenuList: IInterfaceList; 28 | AIsMultiSelect: Boolean); virtual; 29 | function FindItem(const AProjectManagerMenuList: IInterfaceList; const AVerb: string): Integer; 30 | public 31 | { IOTANotifier } 32 | procedure AfterSave; 33 | procedure BeforeSave; 34 | procedure Destroyed; 35 | procedure Modified; 36 | { IOTAProjectMenuItemCreatorNotifier } 37 | procedure AddMenu(const AProject: IOTAProject; const AIdentList: TStrings; const AProjectManagerMenuList: IInterfaceList; 38 | AIsMultiSelect: Boolean); 39 | public 40 | constructor Create; 41 | destructor Destroy; override; 42 | procedure AddNotifier; override; 43 | procedure RemoveNotifier; override; 44 | end; 45 | 46 | TProjectManagerMenu = class(TNotifierObject, IOTALocalMenu, IOTAProjectManagerMenu) 47 | private 48 | FCaption: string; 49 | FExecuteProc: TProc; 50 | FName: string; 51 | FParent: string; 52 | FPosition: Integer; 53 | FVerb: string; 54 | public 55 | { IOTALocalMenu } 56 | function GetCaption: string; virtual; 57 | function GetChecked: Boolean; virtual; 58 | function GetEnabled: Boolean; virtual; 59 | function GetHelpContext: Integer; 60 | function GetName: string; 61 | function GetParent: string; 62 | function GetPosition: Integer; 63 | function GetVerb: string; 64 | procedure SetCaption(const Value: string); 65 | procedure SetChecked(Value: Boolean); 66 | procedure SetEnabled(Value: Boolean); 67 | procedure SetHelpContext(Value: Integer); 68 | procedure SetName(const Value: string); 69 | procedure SetParent(const Value: string); 70 | procedure SetPosition(Value: Integer); 71 | procedure SetVerb(const Value: string); 72 | { IOTAProjectManagerMenu } 73 | function GetIsMultiSelectable: Boolean; 74 | procedure Execute(const MenuContextList: IInterfaceList); overload; 75 | function PostExecute(const MenuContextList: IInterfaceList): Boolean; 76 | function PreExecute(const MenuContextList: IInterfaceList): Boolean; 77 | procedure SetIsMultiSelectable(Value: Boolean); 78 | public 79 | constructor Create(const ACaption, AVerb: string; const APosition: Integer; const AExecuteProc: TProc = nil; 80 | const AName: string = ''; const AParent: string = ''); 81 | end; 82 | 83 | TProjectManagerMenuSeparator = class(TProjectManagerMenu, IOTAProjectManagerMenu) 84 | public 85 | constructor Create(APosition: Integer; const AParent: string = ''); 86 | end; 87 | 88 | implementation 89 | 90 | uses 91 | DW.OTA.Helpers; 92 | 93 | { TProjectManagerMenuNotifier } 94 | 95 | constructor TProjectManagerMenuNotifier.Create; 96 | begin 97 | inherited; 98 | // FIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuItemCreatorNotifier(Self); 99 | end; 100 | 101 | destructor TProjectManagerMenuNotifier.Destroy; 102 | begin 103 | // (BorlandIDEServices as IOTAProjectManager).RemoveMenuItemCreatorNotifier(FIndex); 104 | inherited; 105 | end; 106 | 107 | procedure TProjectManagerMenuNotifier.AddNotifier; 108 | begin 109 | Index := (BorlandIDEServices as IOTAProjectManager).AddMenuItemCreatorNotifier(Self); 110 | end; 111 | 112 | procedure TProjectManagerMenuNotifier.RemoveNotifier; 113 | begin 114 | (BorlandIDEServices as IOTAProjectManager).RemoveMenuItemCreatorNotifier(Index); 115 | end; 116 | 117 | procedure TProjectManagerMenuNotifier.DoAddMenu(const AProject: IOTAProject; const AIdentList: TStrings; 118 | const AProjectManagerMenuList: IInterfaceList; AIsMultiSelect: Boolean); 119 | begin 120 | // 121 | end; 122 | 123 | procedure TProjectManagerMenuNotifier.DoAddGroupMenu(const AProject: IOTAProject; const AIdentList: TStrings; 124 | const AProjectManagerMenuList: IInterfaceList; AIsMultiSelect: Boolean); 125 | begin 126 | // 127 | end; 128 | 129 | procedure TProjectManagerMenuNotifier.AddMenu(const AProject: IOTAProject; const AIdentList: TStrings; const AProjectManagerMenuList: IInterfaceList; 130 | AIsMultiSelect: Boolean); 131 | begin 132 | if AIdentList.IndexOf(sProjectContainer) > -1 then 133 | DoAddMenu(AProject, AIdentList, AProjectManagerMenuList, AIsMultiSelect) 134 | else if AIdentList.IndexOf(sProjectGroupContainer) > -1 then 135 | DoAddGroupMenu(AProject, AIdentList, AProjectManagerMenuList, AIsMultiSelect); 136 | end; 137 | 138 | procedure TProjectManagerMenuNotifier.AddMenuItem(const AItem: TProjectManagerMenu; const APosition: Integer); 139 | begin 140 | 141 | end; 142 | 143 | function TProjectManagerMenuNotifier.FindItem(const AProjectManagerMenuList: IInterfaceList; const AVerb: string): Integer; 144 | var 145 | I: Integer; 146 | begin 147 | Result := -1; 148 | for I := 0 To AProjectManagerMenuList.Count - 1 Do 149 | begin 150 | if CompareText((AProjectManagerMenuList[I] as IOTAProjectManagerMenu).Verb, AVerb) = 0 Then 151 | Exit(I); 152 | end; 153 | end; 154 | 155 | procedure TProjectManagerMenuNotifier.AfterSave; 156 | begin 157 | // 158 | end; 159 | 160 | procedure TProjectManagerMenuNotifier.BeforeSave; 161 | begin 162 | // 163 | end; 164 | 165 | procedure TProjectManagerMenuNotifier.Destroyed; 166 | begin 167 | // 168 | end; 169 | 170 | procedure TProjectManagerMenuNotifier.Modified; 171 | begin 172 | // 173 | end; 174 | 175 | { TProjectManagerMenu } 176 | 177 | constructor TProjectManagerMenu.Create(const ACaption, AVerb: string; const APosition: Integer; const AExecuteProc: TProc = nil; 178 | const AName: string = ''; const AParent: string = ''); 179 | begin 180 | inherited Create; 181 | FCaption := ACaption; 182 | FName := AName; 183 | FParent := AParent; 184 | FPosition := APosition; 185 | FVerb := AVerb; 186 | FExecuteProc := AExecuteProc; 187 | end; 188 | 189 | procedure TProjectManagerMenu.Execute(const MenuContextList: IInterfaceList); 190 | begin 191 | if Assigned(FExecuteProc) then 192 | FExecuteProc; 193 | end; 194 | 195 | function TProjectManagerMenu.GetCaption: string; 196 | begin 197 | Result := FCaption; 198 | end; 199 | 200 | function TProjectManagerMenu.GetChecked: Boolean; 201 | begin 202 | Result := False; 203 | end; 204 | 205 | function TProjectManagerMenu.GetEnabled: Boolean; 206 | begin 207 | Result := True; 208 | end; 209 | 210 | function TProjectManagerMenu.GetHelpContext: Integer; 211 | begin 212 | Result := 0; 213 | end; 214 | 215 | function TProjectManagerMenu.GetIsMultiSelectable: Boolean; 216 | begin 217 | Result := False; 218 | end; 219 | 220 | function TProjectManagerMenu.GetName: string; 221 | begin 222 | Result := FName; 223 | end; 224 | 225 | function TProjectManagerMenu.GetParent: string; 226 | begin 227 | Result := FParent; 228 | end; 229 | 230 | function TProjectManagerMenu.GetPosition: Integer; 231 | begin 232 | Result := FPosition; 233 | end; 234 | 235 | function TProjectManagerMenu.GetVerb: string; 236 | begin 237 | Result := FVerb; 238 | end; 239 | 240 | function TProjectManagerMenu.PostExecute(const MenuContextList: IInterfaceList): Boolean; 241 | begin 242 | Result := False; 243 | end; 244 | 245 | function TProjectManagerMenu.PreExecute(const MenuContextList: IInterfaceList): Boolean; 246 | begin 247 | Result := False; 248 | end; 249 | 250 | procedure TProjectManagerMenu.SetCaption(const Value: string); 251 | begin 252 | FCaption := Value; 253 | end; 254 | 255 | procedure TProjectManagerMenu.SetChecked(Value: Boolean); 256 | begin 257 | // Override GetChecked instead 258 | end; 259 | 260 | procedure TProjectManagerMenu.SetEnabled(Value: Boolean); 261 | begin 262 | // Override GetEnabled instead 263 | end; 264 | 265 | procedure TProjectManagerMenu.SetHelpContext(Value: Integer); 266 | begin 267 | // Override GetHelpContext instead 268 | end; 269 | 270 | procedure TProjectManagerMenu.SetIsMultiSelectable(Value: Boolean); 271 | begin 272 | // Override GetIsMultiSelectable instead 273 | end; 274 | 275 | procedure TProjectManagerMenu.SetName(const Value: string); 276 | begin 277 | // Why would you change the name, after creation? :-) 278 | end; 279 | 280 | procedure TProjectManagerMenu.SetParent(const Value: string); 281 | begin 282 | // Override GetParent instead 283 | end; 284 | 285 | procedure TProjectManagerMenu.SetPosition(Value: Integer); 286 | begin 287 | // Not sure why you would change the position after creation 288 | end; 289 | 290 | procedure TProjectManagerMenu.SetVerb(const Value: string); 291 | begin 292 | // Why would you change the verb, after creation? :-) 293 | end; 294 | 295 | { TProjectManagerMenuSeparator } 296 | 297 | constructor TProjectManagerMenuSeparator.Create(APosition: Integer; const AParent: string); 298 | begin 299 | inherited Create('-', '', APosition, nil, '', AParent); 300 | end; 301 | 302 | end. 303 | -------------------------------------------------------------------------------- /Demo/TotalDemo.Resources.dfm: -------------------------------------------------------------------------------- 1 | object Resources: TResources 2 | Height = 377 3 | Width = 631 4 | PixelsPerInch = 96 5 | object ActionList: TActionList 6 | Images = ImageList 7 | Left = 196 8 | Top = 160 9 | object Demo1Action: TAction 10 | ImageIndex = 0 11 | OnExecute = Demo1ActionExecute 12 | end 13 | object Demo2Action: TAction 14 | ImageIndex = 1 15 | OnExecute = Demo2ActionExecute 16 | end 17 | end 18 | object ImageList: TImageList 19 | Left = 196 20 | Top = 84 21 | Bitmap = { 22 | 494C010103000800040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 23 | 0000000000003600000028000000400000001000000001002000000000000010 24 | 000000000000000000000000000000000000000000000000000000000000277F 25 | FF0000000000277FFF0000000000277FFF000000000000000000277FFF000000 26 | 0000277FFF000000000000000000000000000000000000000000000000000000 27 | 00000000000000000000000000000000000000000000409FFF00000000000000 28 | 00000000000000000000000000000000000000000000FDFDFD00F3F3F300E9E9 29 | E900E5E5E500E5E5E500E5E5E500E5E5E500E5E5E500E5E5E500E5E5E500E5E5 30 | E5009B7F6300B2A99E00FDFDFD00000000000000000000000000000000000000 31 | 0000000000000000000000000000000000000000000000000000000000000000 32 | 000000000000000000000000000000000000000000000000000000000000277F 33 | FF0000000000277FFF0000000000277FFF0000000000277FFF00000000000000 34 | 0000277FFF0000000000000000000000000000000000409FFF0000000000409F 35 | FF0000000000409FFF0000000000409FFF0000000000409FFF00409FFF00409F 36 | FF000000000000000000409FFF000000000000000000FBFBFB00E8E8E800D4D4 37 | D400BCBCBE007F7F9A00545495003B3B93003B3B9300545495007F7F9A00BCBC 38 | BE00996733009B6A3700B7ADA200000000000000000000000000000000000000 39 | 0000000000000000000000000000000000000000000000000000000000000000 40 | 000000000000000000000000000000000000000000000000000000000000277F 41 | FF0000000000277FFF0000000000277FFF0000000000277FFF00000000000000 42 | 0000277FFF0000000000000000000000000000000000409FFF0000000000409F 43 | FF0000000000409FFF0000000000409FFF0000000000409FFF00000000000000 44 | 0000409FFF0000000000409FFF0000000000000000000000000000000000B2B2 45 | BC00434397003C3CB3004B4BD6005353E9008E626D009F6340009B603900975E 46 | 3400A06C3B00FFC53800A7774200BAB1A6000000000000000000000000000000 47 | 0000000000000000000000000000000000000000000000000000000000000000 48 | 000000000000000000000000000000000000000000000000000000000000277F 49 | FF0000000000277FFF00277FFF000000000000000000277FFF00277FFF000000 50 | 0000277FFF00277FFF00000000000000000000000000409FFF0000000000409F 51 | FF0000000000409FFF0000000000409FFF0000000000409FFF00000000000000 52 | 0000409FFF0000000000409FFF00000000000000000000000000B3B3C0003B3B 53 | 9B004D4DDA008383EA00BDBDE200D6D6DE00C78B4900FFE39200FFD56A00FFD1 54 | 5D00FFD15D00FFD15D00FFD87300AF8049000000000000000000000000000000 55 | 0000000000000000000000000000000000000000000000000000000000000000 56 | 000000000000000000000000000000000000000000000000000000000000277F 57 | FF000000000000000000000000000000000000000000277FFF00000000000000 58 | 0000277FFF0000000000000000000000000000000000409FFF0000000000409F 59 | FF00409FFF00409FFF00409FFF000000000000000000409FFF00409FFF00409F 60 | FF000000000000000000409FFF000000000000000000E6E6E7004B4B9F005252 61 | DB00A1A1E700C8C8E1008383EB006565F000A4777B00C3875400D0945200C88C 62 | 5300B87C5200FFE59700B7864E00BEB4A8000000000000000000000000000000 63 | 0000000000000000000000000000000000000000000000000000000000000000 64 | 000000000000000000000000000000000000000000000000000000000000277F 65 | FF00000000000000000000000000000000000000000000000000000000000000 66 | 000000000000277FFF00000000000000000000000000409FFF00000000000000 67 | 0000000000000000000000000000000000000000000000000000000000000000 68 | 00000000000000000000409FFF0000000000000000009C9CB7004848BE008888 69 | ED00C9C9E2006A6AF1006A6AF1009191EB009191EB006A6AF1006A6AF100C9C9 70 | E200CE925C00BE83550094879100000000000000000000000000000000000000 71 | 0000000000000000000000000000000000000000000000000000000000000000 72 | 0000000000000000000000000000000000000000000000000000000000000000 73 | 0000000000000000000000000000000000000000000000000000000000000000 74 | 00000000000000000000000000000000000000000000409FFF00000000000000 75 | 0000000000000000000000000000000000000000000000000000000000000000 76 | 00000000000000000000409FFF0000000000000000006969AC005E5EE000C5C5 77 | E9008A8AF0006E6EF400D1D1E700B8B8EA00B8B8EA00D1D1E7006E6EF4008A8A 78 | F000E0B382008A71A7006969AC00000000000000000000000000000000000000 79 | 0000000000000000000000000000000000000000000000000000000000000000 80 | 000000000000000000000000000000000000B5848400B5848400B5848400B584 81 | 8400B5848400B5848400B5848400B58484000000000000000000000000000000 82 | 0000428C3900000000000000000000000000B5848400B5848400B5848400B584 83 | 8400B5848400B5848400B5848400B58484000000000000000000000000000000 84 | 0000428C3900000000000000000000000000000000005151AE006D6DF300E5E5 85 | ED006F6FF6009B9BF300BFBFF0006565F6006565F600BFBFF0009B9BF3006F6F 86 | F600E5E5ED006D6DF3005151AE00000000000000000000000000000000000000 87 | 0000000000000000000000000000000000000000000000000000000000000000 88 | 000000000000000000000000000000000000B5848400EFD6B500E7BD9400E7B5 89 | 8C00DEB58400DEAD7300EFC68400B58484000000000000000000000000000073 90 | 080042D6730031AD4A000000000000000000B5848400EFD6B500E7BD9400E7B5 91 | 8C00DEB58400DEAD7300EFC68400B58484000000000000000000000000000073 92 | 080042D6730031AD4A000000000000000000000000005454B1007474F500EDED 93 | F4007373F800A0A0F700C6C6F6006969F8006969F800C6C6F600A0A0F7007373 94 | F800EDEDF4007474F5005454B100000000000000000000000000000000000000 95 | 0000000000000000000000000000000000000000000000000000000000000000 96 | 000000000000000000000000000000000000B5848400CE8C6B00942900009C31 97 | 00009C3100009C310000E7B57B00B58484000000000000000000007B08004ACE 98 | 73005AE78C0039C65A00108C210000000000B5848400CE8C6B00942900009C31 99 | 00009C3100009C310000E7B57B00B58484000000000000000000007B08004ACE 100 | 73005AE78C0039C65A00108C210000000000000000007070B3007070E800D9D9 101 | FB009898FA007A7AFA00E6E6FC00CCCCFB00CCCCFB00E6E6FC007A7AFA009898 102 | FA00D9D9FB007070E8007070B300000000000000000000000000000000000000 103 | 0000000000000000000000000000000000000000000000000000000000000000 104 | 000000000000000000000000000000000000BD8C8400FFEFE700A54210009429 105 | 000094290000BD734A00FFE7B500B584840000000000428429001094210029AD 106 | 4A0039CE630021AD3900189C2900087B1000BD8C8400FFEFE700A54210009429 107 | 000094290000BD734A00FFE7B500B584840000000000428429001094210029AD 108 | 4A0039CE630021AD3900189C2900087B100000000000A3A3BF005E5ECE00A4A4 109 | FD00E7E7FF007D7DFC007D7DFC00A9A9FE00A9A9FE007D7DFC007D7DFC00E7E7 110 | FF00A4A4FD005E5ECE00A3A3BF00000000000000000000000000000000000000 111 | 0000000000000000000000000000000000000000000000000000000000000000 112 | 000000000000000000000000000000000000CE9C8400FFFFFF00D6AD94009421 113 | 0000A5421000EFCEAD00FFEFC600B58484000000000000000000000000000073 114 | 080021BD4200088C18000000000000000000CE9C8400FFFFFF00D6AD94009421 115 | 0000A5421000EFCEAD00FFEFC600B58484000000000000000000000000000073 116 | 080021BD4200088C1800000000000000000000000000E9E9EA006060B9007D7D 117 | EC00C1C1FF00E8E8FF009E9EFD007D7DFD007D7DFD009E9EFD00E8E8FF00C1C1 118 | FF007D7DEC006060B900E9E9EA00000000000000000000000000000000000000 119 | 0000000000000000000000000000000000000000000000000000000000000000 120 | 000000000000000000000000000000000000DEAD8400FFFFFF00FFF7F700AD5A 121 | 3100CE947300FFF7DE00DECEB500B5848400000000000000000000000000087B 122 | 100010AD2100088410000000000000000000DEAD8400FFFFFF00FFF7F700AD5A 123 | 3100CE947300FFF7DE00DECEB500B5848400000000000000000000000000087B 124 | 100010AD21000884100000000000000000000000000000000000BFBFCD005959 125 | BE008080EC00A8A8FF00DEDEFF00F8F8FF00F8F8FF00DEDEFF00A8A8FF008080 126 | EC005959BE00BFBFCD0000000000000000000000000000000000000000000000 127 | 0000000000000000000000000000000000000000000000000000000000000000 128 | 000000000000000000000000000000000000E7B58C00FFFFFF00FFFFFF00EFDE 129 | D600FFF7EF00B5848400B5848400B58473000000000000000000088C10000894 130 | 100008A51800007B08000000000000000000E7B58C00FFFFFF00FFFFFF00EFDE 131 | D600FFF7EF00B5848400B5848400B58473000000000000000000088C10000894 132 | 100008A51800007B08000000000000000000000000000000000000000000BFBF 133 | CD006262BA006464CF008080EB008C8CFA008C8CFA008080EB006464CF006262 134 | BA00BFBFCD000000000000000000000000000000000000000000000000000000 135 | 0000000000000000000000000000000000000000000000000000000000000000 136 | 000000000000000000000000000000000000EFBD9400FFFFFF00FFFFFF00FFFF 137 | FF00FFFFFF00B5848400DE9C630000000000008408000084080000941000089C 138 | 180000840800000000000000000000000000EFBD9400FFFFFF00FFFFFF00FFFF 139 | FF00FFFFFF00B5848400DE9C630000000000008408000084080000941000089C 140 | 1800008408000000000000000000000000000000000000000000000000000000 141 | 0000E9E9EA00A4A4C1007474B8005B5BB9005B5BB9007474B800A4A4C100E9E9 142 | EA00000000000000000000000000000000000000000000000000000000000000 143 | 0000000000000000000000000000000000000000000000000000000000000000 144 | 000000000000000000000000000000000000EFBD9400DEAD8400DEAD8400DEAD 145 | 8400DEAD8400B584840000000000000000000000000000000000000000000000 146 | 000000000000000000000000000000000000EFBD9400DEAD8400DEAD8400DEAD 147 | 8400DEAD8400B584840000000000000000000000000000000000000000000000 148 | 0000000000000000000000000000000000000000000000000000000000000000 149 | 0000000000000000000000000000000000000000000000000000000000000000 150 | 0000000000000000000000000000000000000000000000000000000000000000 151 | 0000000000000000000000000000000000000000000000000000000000000000 152 | 000000000000000000000000000000000000424D3E000000000000003E000000 153 | 2800000040000000100000000100010000000000800000000000000000000000 154 | 000000000000000000000000FFFFFF00EAD7FFBF80010000EAB7AA8D80010000 155 | EAB7AAB5E0000000E993AAB5C0000000EFB7A18D80000000EFFBBFFD80010000 156 | FFFFBFFD8001000000F700F78001000000E300E38001000000C100C180010000 157 | 008000808001000000E300E38001000000E300E3C003000000C300C3E0070000 158 | 01070107F00F000003FF03FFFFFF000000000000000000000000000000000000 159 | 000000000000} 160 | end 161 | end 162 | -------------------------------------------------------------------------------- /DW.OTA.Notifiers.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Notifiers; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | System.Generics.Collections, System.Classes, System.Types, 13 | DockForm, ToolsAPI, StructureViewAPI, 14 | Vcl.Graphics; 15 | 16 | type 17 | ITOTALNotifier = interface(IInterface) 18 | ['{85CA09CC-370C-4FAB-9A42-4687A6550328}'] 19 | function GetIndex: Integer; 20 | procedure AddNotifier; 21 | procedure RemoveNotifier; 22 | procedure SetIndex(const AValue: Integer); 23 | end; 24 | 25 | ITOTALModuleTracker = interface(IInterface) 26 | ['{38C0E273-C75A-450A-8F7E-5787BEF9A348}'] 27 | procedure AfterRename(const AOldFileName, ANewFileName: string); 28 | procedure AfterSave(const AFileName: string); 29 | end; 30 | 31 | TTOTALNotifier = class(TNotifierObject, ITOTALNotifier) 32 | private 33 | FIndex: Integer; 34 | protected 35 | { ITOTALNotifier } 36 | procedure AddNotifier; virtual; abstract; 37 | function GetIndex: Integer; 38 | procedure RemoveNotifier; virtual; abstract; 39 | procedure SetIndex(const AValue: Integer); 40 | protected 41 | property Index: Integer read GetIndex write SetIndex; 42 | public 43 | constructor Create; 44 | end; 45 | 46 | TDebuggerNotifier = class(TTOTALNotifier, IOTADebuggerNotifier, IOTADebuggerNotifier90) 47 | protected 48 | { IOTADebuggerNotifier } 49 | procedure ProcessCreated(const Process: IOTAProcess); virtual; 50 | procedure ProcessDestroyed(const Process: IOTAProcess); virtual; 51 | procedure BreakpointAdded(const Breakpoint: IOTABreakpoint); virtual; 52 | procedure BreakpointDeleted(const Breakpoint: IOTABreakpoint); virtual; 53 | { IOTADebuggerNotifier90 } 54 | procedure BreakpointChanged(const Breakpoint: IOTABreakpoint); virtual; 55 | procedure CurrentProcessChanged(const Process: IOTAProcess); virtual; 56 | procedure ProcessStateChanged(const Process: IOTAProcess); virtual; 57 | function BeforeProgramLaunch(const Project: IOTAProject): Boolean; virtual; 58 | procedure ProcessMemoryChanged; virtual; 59 | public 60 | procedure AddNotifier; override; 61 | procedure RemoveNotifier; override; 62 | end; 63 | 64 | TIDENotifier = class(TTOTALNotifier, IOTAIDENotifier) 65 | protected 66 | { IOTAIDENotifier } 67 | procedure AfterCompile(Succeeded: Boolean); virtual; 68 | procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); virtual; 69 | procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); virtual; 70 | public 71 | procedure AddNotifier; override; 72 | procedure RemoveNotifier; override; 73 | end; 74 | 75 | TEditServicesNotifier = class(TTOTALNotifier, INTAEditServicesNotifier) 76 | protected 77 | procedure EditWindowClosed(const EditWindow: INTAEditWindow); virtual; 78 | procedure EditWindowOpened(const EditWindow: INTAEditWindow); virtual; 79 | protected 80 | { INTAEditServicesNotifier } 81 | procedure DockFormRefresh(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 82 | procedure DockFormUpdated(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 83 | procedure DockFormVisibleChanged(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 84 | procedure EditorViewActivated(const EditWindow: INTAEditWindow; const EditView: IOTAEditView); virtual; 85 | procedure EditorViewModified(const EditWindow: INTAEditWindow; const EditView: IOTAEditView); virtual; 86 | procedure WindowActivated(const EditWindow: INTAEditWindow); 87 | procedure WindowCommand(const EditWindow: INTAEditWindow; Command, Param: Integer; var Handled: Boolean); 88 | procedure WindowNotification(const EditWindow: INTAEditWindow; Operation: TOperation); 89 | procedure WindowShow(const EditWindow: INTAEditWindow; Show, LoadedFromDesktop: Boolean); 90 | public 91 | procedure AddNotifier; override; 92 | procedure RemoveNotifier; override; 93 | end; 94 | 95 | TEditViewNotifier = class(TTOTALNotifier, INTAEditViewNotifier) 96 | private 97 | FView: IOTAEditView; 98 | public 99 | { INTAEditViewNotifier } 100 | procedure BeginPaint(const View: IOTAEditView; var FullRepaint: Boolean); virtual; 101 | procedure EditorIdle(const View: IOTAEditView); 102 | procedure EndPaint(const View: IOTAEditView); 103 | procedure PaintLine(const View: IOTAEditView; LineNumber: Integer; const LineText: PAnsiChar; const TextWidth: Word; 104 | const LineAttributes: TOTAAttributeArray; const Canvas: TCanvas; const TextRect: TRect; const LineRect: TRect; const CellSize: TSize); virtual; 105 | public 106 | constructor Create(const AView: IOTAEditView); 107 | destructor Destroy; override; 108 | procedure AddNotifier; override; 109 | procedure RemoveNotifier; override; 110 | property View: IOTAEditView read FView; 111 | end; 112 | 113 | TStructureViewNotifier = class(TTOTALNotifier, IOTAStructureNotifier) 114 | public 115 | { IOTAStructureNotifier } 116 | procedure DefaultNodeAction(const Node: IOTAStructureNode); 117 | procedure NodeEdited(const Node: IOTAStructureNode); 118 | procedure NodeFocused(const Node: IOTAStructureNode); 119 | procedure NodeSelected(const Node: IOTAStructureNode); 120 | procedure StructureChanged(const Context: IOTAStructureContext); virtual; 121 | procedure VisibleChanged(Visible: WordBool); 122 | public 123 | procedure AddNotifier; override; 124 | procedure RemoveNotifier; override; 125 | end; 126 | 127 | TMessageNotifier = class(TTOTALNotifier, IOTAMessageNotifier) 128 | public 129 | { IOTAMessageNotifier } 130 | procedure MessageGroupAdded(const Group: IOTAMessageGroup); virtual; 131 | procedure MessageGroupDeleted(const Group: IOTAMessageGroup); virtual; 132 | public 133 | procedure AddNotifier; override; 134 | procedure RemoveNotifier; override; 135 | end; 136 | 137 | TNonRefInterfacedObject = class(TObject, IInterface) 138 | protected 139 | function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 140 | function _AddRef: Integer; stdcall; 141 | function _Release: Integer; stdcall; 142 | end; 143 | 144 | TModuleNotifier = class(TNonRefInterfacedObject, IOTANotifier, IOTAModuleNotifier, IOTAModuleNotifier80, IOTAModuleNotifier90) 145 | private 146 | [Weak] FTracker: ITOTALModuleTracker; 147 | public 148 | { IOTANotifier } 149 | procedure AfterSave; 150 | procedure BeforeSave; 151 | procedure Destroyed; 152 | procedure Modified; 153 | { IOTAModuleNotifier } 154 | function CheckOverwrite: Boolean; 155 | procedure ModuleRenamed(const ANewName: string); 156 | { IOTAModuleNotifier80 } 157 | function AllowSave: Boolean; 158 | function GetOverwriteFileName(Index: Integer): string; 159 | function GetOverwriteFileNameCount: Integer; 160 | procedure SetSaveFileName(const FileName: string); 161 | { IOTAModuleNotifier90 } 162 | procedure AfterRename(const OldFileName, NewFileName: string); 163 | procedure BeforeRename(const OldFileName, NewFileName: string); 164 | public 165 | constructor Create(const ATracker: ITOTALModuleTracker); 166 | end; 167 | 168 | TThemingServicesNotifier = class(TTOTALNotifier, INTAIDEThemingServicesNotifier) 169 | public 170 | { INTAIDEThemingServicesNotifier } 171 | procedure ChangedTheme; virtual; 172 | procedure ChangingTheme; virtual; 173 | public 174 | procedure AddNotifier; override; 175 | procedure RemoveNotifier; override; 176 | end; 177 | 178 | THighlighter = class(TTOTALNotifier, IOTANotifier, IOTAHighlighter) 179 | public 180 | { ITOTALNotifier } 181 | procedure AddNotifier; override; 182 | procedure RemoveNotifier; override; 183 | { IOTAHighlighter } 184 | function GetIDString: string; virtual; 185 | function GetName: string; virtual; 186 | procedure Tokenize(StartClass: TOTALineClass; LineBuf: POTAEdChar; LineBufLen: TOTALineSize; HighlightCodes: POTASyntaxCode); virtual; 187 | function TokenizeLineClass(StartClass: TOTALineClass; LineBuf: POTAEdChar; LineBufLen: TOTALineSize): TOTALineClass; virtual; 188 | end; 189 | 190 | implementation 191 | 192 | { TTOTALNotifier } 193 | 194 | constructor TTOTALNotifier.Create; 195 | begin 196 | inherited; 197 | AddNotifier; 198 | end; 199 | 200 | function TTOTALNotifier.GetIndex: Integer; 201 | begin 202 | Result := FIndex; 203 | end; 204 | 205 | procedure TTOTALNotifier.SetIndex(const AValue: Integer); 206 | begin 207 | FIndex := AValue; 208 | end; 209 | 210 | { TDebuggerNotifier } 211 | 212 | procedure TDebuggerNotifier.AddNotifier; 213 | begin 214 | Index := (BorlandIDEServices as IOTADebuggerServices).AddNotifier(Self); 215 | end; 216 | 217 | procedure TDebuggerNotifier.RemoveNotifier; 218 | begin 219 | (BorlandIDEServices as IOTADebuggerServices).RemoveNotifier(Index); 220 | end; 221 | 222 | function TDebuggerNotifier.BeforeProgramLaunch(const Project: IOTAProject): Boolean; 223 | begin 224 | Result := True; 225 | end; 226 | 227 | procedure TDebuggerNotifier.BreakpointAdded(const Breakpoint: IOTABreakpoint); 228 | begin 229 | // 230 | end; 231 | 232 | procedure TDebuggerNotifier.BreakpointChanged(const Breakpoint: IOTABreakpoint); 233 | begin 234 | // 235 | end; 236 | 237 | procedure TDebuggerNotifier.BreakpointDeleted(const Breakpoint: IOTABreakpoint); 238 | begin 239 | // 240 | end; 241 | 242 | procedure TDebuggerNotifier.CurrentProcessChanged(const Process: IOTAProcess); 243 | begin 244 | // 245 | end; 246 | 247 | procedure TDebuggerNotifier.ProcessCreated(const Process: IOTAProcess); 248 | begin 249 | // 250 | end; 251 | 252 | procedure TDebuggerNotifier.ProcessDestroyed(const Process: IOTAProcess); 253 | begin 254 | // 255 | end; 256 | 257 | procedure TDebuggerNotifier.ProcessMemoryChanged; 258 | begin 259 | // 260 | end; 261 | 262 | procedure TDebuggerNotifier.ProcessStateChanged(const Process: IOTAProcess); 263 | begin 264 | // 265 | end; 266 | 267 | { TIDENotifier } 268 | 269 | procedure TIDENotifier.AddNotifier; 270 | begin 271 | Index := (BorlandIDEServices as IOTAServices).AddNotifier(Self); 272 | end; 273 | 274 | procedure TIDENotifier.RemoveNotifier; 275 | begin 276 | (BorlandIDEServices as IOTAServices).RemoveNotifier(Index); 277 | end; 278 | 279 | procedure TIDENotifier.AfterCompile(Succeeded: Boolean); 280 | begin 281 | // 282 | end; 283 | 284 | procedure TIDENotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); 285 | begin 286 | // 287 | end; 288 | 289 | procedure TIDENotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); 290 | begin 291 | // 292 | end; 293 | 294 | { TEditServicesNotifier } 295 | 296 | procedure TEditServicesNotifier.AddNotifier; 297 | begin 298 | Index := (BorlandIDEServices as IOTAEditorServices).AddNotifier(Self); 299 | end; 300 | 301 | procedure TEditServicesNotifier.RemoveNotifier; 302 | begin 303 | (BorlandIDEServices as IOTAEditorServices).RemoveNotifier(Index); 304 | end; 305 | 306 | procedure TEditServicesNotifier.DockFormRefresh(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 307 | begin 308 | 309 | end; 310 | 311 | procedure TEditServicesNotifier.DockFormUpdated(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 312 | begin 313 | 314 | end; 315 | 316 | procedure TEditServicesNotifier.DockFormVisibleChanged(const EditWindow: INTAEditWindow; DockForm: TDockableForm); 317 | begin 318 | 319 | end; 320 | 321 | procedure TEditServicesNotifier.EditorViewActivated(const EditWindow: INTAEditWindow; const EditView: IOTAEditView); 322 | begin 323 | 324 | end; 325 | 326 | procedure TEditServicesNotifier.EditorViewModified(const EditWindow: INTAEditWindow; const EditView: IOTAEditView); 327 | begin 328 | 329 | end; 330 | 331 | procedure TEditServicesNotifier.EditWindowClosed(const EditWindow: INTAEditWindow); 332 | begin 333 | 334 | end; 335 | 336 | procedure TEditServicesNotifier.EditWindowOpened(const EditWindow: INTAEditWindow); 337 | begin 338 | 339 | end; 340 | 341 | procedure TEditServicesNotifier.WindowActivated(const EditWindow: INTAEditWindow); 342 | begin 343 | 344 | end; 345 | 346 | procedure TEditServicesNotifier.WindowCommand(const EditWindow: INTAEditWindow; Command, Param: Integer; var Handled: Boolean); 347 | begin 348 | 349 | end; 350 | 351 | procedure TEditServicesNotifier.WindowNotification(const EditWindow: INTAEditWindow; Operation: TOperation); 352 | begin 353 | case Operation of 354 | opInsert: 355 | EditWindowOpened(EditWindow); 356 | opRemove: 357 | EditWindowClosed(EditWindow); 358 | end; 359 | end; 360 | 361 | procedure TEditServicesNotifier.WindowShow(const EditWindow: INTAEditWindow; Show, LoadedFromDesktop: Boolean); 362 | begin 363 | 364 | end; 365 | 366 | { TEditViewNotifier } 367 | 368 | constructor TEditViewNotifier.Create(const AView: IOTAEditView); 369 | begin 370 | inherited Create; 371 | FView := AView; 372 | FView.AddNotifier(Self); 373 | end; 374 | 375 | destructor TEditViewNotifier.Destroy; 376 | begin 377 | 378 | inherited; 379 | end; 380 | 381 | procedure TEditViewNotifier.AddNotifier; 382 | begin 383 | 384 | end; 385 | 386 | procedure TEditViewNotifier.RemoveNotifier; 387 | begin 388 | 389 | end; 390 | 391 | procedure TEditViewNotifier.BeginPaint(const View: IOTAEditView; var FullRepaint: Boolean); 392 | begin 393 | // 394 | end; 395 | 396 | procedure TEditViewNotifier.EditorIdle(const View: IOTAEditView); 397 | begin 398 | // 399 | end; 400 | 401 | procedure TEditViewNotifier.EndPaint(const View: IOTAEditView); 402 | begin 403 | // 404 | end; 405 | 406 | procedure TEditViewNotifier.PaintLine(const View: IOTAEditView; LineNumber: Integer; const LineText: PAnsiChar; const TextWidth: Word; 407 | const LineAttributes: TOTAAttributeArray; const Canvas: TCanvas; const TextRect, LineRect: TRect; const CellSize: TSize); 408 | begin 409 | // 410 | end; 411 | 412 | { TStructureViewNotifier } 413 | 414 | procedure TStructureViewNotifier.AddNotifier; 415 | begin 416 | Index := (BorlandIDEServices as IOTAStructureView).AddNotifier(Self); 417 | end; 418 | 419 | procedure TStructureViewNotifier.RemoveNotifier; 420 | begin 421 | (BorlandIDEServices as IOTAStructureView).RemoveNotifier(Index); 422 | end; 423 | 424 | procedure TStructureViewNotifier.DefaultNodeAction(const Node: IOTAStructureNode); 425 | begin 426 | // 427 | end; 428 | 429 | procedure TStructureViewNotifier.NodeEdited(const Node: IOTAStructureNode); 430 | begin 431 | // 432 | end; 433 | 434 | procedure TStructureViewNotifier.NodeFocused(const Node: IOTAStructureNode); 435 | begin 436 | // 437 | end; 438 | 439 | procedure TStructureViewNotifier.NodeSelected(const Node: IOTAStructureNode); 440 | begin 441 | // 442 | end; 443 | 444 | procedure TStructureViewNotifier.StructureChanged(const Context: IOTAStructureContext); 445 | begin 446 | // 447 | end; 448 | 449 | procedure TStructureViewNotifier.VisibleChanged(Visible: WordBool); 450 | begin 451 | // 452 | end; 453 | 454 | { TNonRefInterfacedObject } 455 | 456 | function TNonRefInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult; 457 | begin 458 | if GetInterface(IID, Obj) then 459 | Result := S_OK 460 | else 461 | Result := E_NOINTERFACE; 462 | end; 463 | 464 | function TNonRefInterfacedObject._AddRef: Integer; 465 | begin 466 | Result := -1; 467 | end; 468 | 469 | function TNonRefInterfacedObject._Release: Integer; 470 | begin 471 | Result := -1; 472 | end; 473 | 474 | { TModuleNotifier } 475 | 476 | constructor TModuleNotifier.Create(const ATracker: ITOTALModuleTracker); 477 | begin 478 | inherited Create; 479 | FTracker := ATracker; 480 | end; 481 | 482 | procedure TModuleNotifier.Destroyed; 483 | begin 484 | // 485 | end; 486 | 487 | procedure TModuleNotifier.AfterRename(const OldFileName, NewFileName: String); 488 | begin 489 | if FTracker <> nil then 490 | FTracker.AfterRename(OldFileName, NewFileName); 491 | end; 492 | 493 | procedure TModuleNotifier.AfterSave; 494 | begin 495 | 496 | end; 497 | 498 | function TModuleNotifier.AllowSave: Boolean; 499 | begin 500 | Result := True; 501 | end; 502 | 503 | procedure TModuleNotifier.BeforeRename(const OldFileName, NewFileName: String); 504 | begin 505 | // 506 | end; 507 | 508 | procedure TModuleNotifier.BeforeSave; 509 | begin 510 | // 511 | end; 512 | 513 | function TModuleNotifier.CheckOverwrite: Boolean; 514 | begin 515 | Result := True; 516 | end; 517 | 518 | function TModuleNotifier.GetOverwriteFileName(Index: Integer): String; 519 | begin 520 | Result := ''; 521 | end; 522 | 523 | function TModuleNotifier.GetOverwriteFileNameCount: Integer; 524 | begin 525 | Result := 0; 526 | end; 527 | 528 | procedure TModuleNotifier.Modified; 529 | begin 530 | // 531 | end; 532 | 533 | procedure TModuleNotifier.ModuleRenamed(const ANewName: string); 534 | begin 535 | // 536 | end; 537 | 538 | procedure TModuleNotifier.SetSaveFileName(const FileName: String); 539 | begin 540 | // 541 | end; 542 | 543 | { TMessageNotifier } 544 | 545 | procedure TMessageNotifier.AddNotifier; 546 | begin 547 | Index := (BorlandIDEServices as IOTAMessageServices).AddNotifier(Self); 548 | end; 549 | 550 | procedure TMessageNotifier.RemoveNotifier; 551 | begin 552 | (BorlandIDEServices as IOTAMessageServices).RemoveNotifier(Index); 553 | end; 554 | 555 | procedure TMessageNotifier.MessageGroupAdded(const Group: IOTAMessageGroup); 556 | begin 557 | // 558 | end; 559 | 560 | procedure TMessageNotifier.MessageGroupDeleted(const Group: IOTAMessageGroup); 561 | begin 562 | // 563 | end; 564 | 565 | { TThemingServicesNotifier } 566 | 567 | procedure TThemingServicesNotifier.AddNotifier; 568 | begin 569 | Index := (BorlandIDEServices as IOTAIDEThemingServices).AddNotifier(Self); 570 | end; 571 | 572 | procedure TThemingServicesNotifier.RemoveNotifier; 573 | begin 574 | (BorlandIDEServices as IOTAIDEThemingServices).RemoveNotifier(Index); 575 | end; 576 | 577 | procedure TThemingServicesNotifier.ChangedTheme; 578 | begin 579 | 580 | end; 581 | 582 | procedure TThemingServicesNotifier.ChangingTheme; 583 | begin 584 | 585 | end; 586 | 587 | { THighlighter } 588 | 589 | function THighlighter.GetIDString: string; 590 | begin 591 | Result := ''; // e.g. 'DelphiWorlds.Highlighter.ISS'; 592 | end; 593 | 594 | function THighlighter.GetName: string; 595 | begin 596 | Result := ''; // e.g. 'InnoSetup File'; 597 | end; 598 | 599 | procedure THighlighter.AddNotifier; 600 | begin 601 | (BorlandIDEServices as IOTAHighlightServices).AddHighlighter(Self); 602 | end; 603 | 604 | procedure THighlighter.RemoveNotifier; 605 | begin 606 | (BorlandIDEServices as IOTAHighlightServices).RemoveHighlighter(Index); 607 | end; 608 | 609 | procedure THighlighter.Tokenize(StartClass: TOTALineClass; LineBuf: POTAEdChar; LineBufLen: TOTALineSize; HighlightCodes: POTASyntaxCode); 610 | begin 611 | // 612 | end; 613 | 614 | function THighlighter.TokenizeLineClass(StartClass: TOTALineClass; LineBuf: POTAEdChar; LineBufLen: TOTALineSize): TOTALineClass; 615 | begin 616 | Result := 0; 617 | end; 618 | 619 | end. 620 | -------------------------------------------------------------------------------- /DW.OTA.Wizard.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Wizard; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | // RTL 13 | System.Generics.Collections, System.Classes, 14 | // Design 15 | ToolsAPI, DeskUtil, DeskForm, 16 | // VCL 17 | Vcl.Forms, Vcl.ExtCtrls, Vcl.ActnList, Vcl.ActnPopup, Vcl.Menus; 18 | 19 | type 20 | /// 21 | /// Base Wizard. Create descendants of this class to act as "sub-wizards" of your OTA Wizard 22 | /// 23 | TWizard = class(TInterfacedObject) 24 | protected 25 | function _AddRef: Integer; stdcall; 26 | function _Release: Integer; stdcall; 27 | procedure ActiveFormChanged; virtual; 28 | procedure ConfigChanged; virtual; 29 | function DebuggerBeforeProgramLaunch(const Project: IOTAProject): Boolean; virtual; 30 | procedure DebuggerProcessCreated(const AProcess: IOTAProcess); virtual; 31 | procedure FileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); virtual; 32 | function GetRSVersion: string; 33 | function HookedEditorMenuPopup(const AMenuItem: TMenuItem): Boolean; virtual; 34 | procedure IDEAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); virtual; 35 | procedure IDEBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); virtual; 36 | procedure IDEStarted; virtual; 37 | procedure IDEStopped; virtual; 38 | procedure Modification; virtual; 39 | procedure PeriodicTimer; virtual; 40 | procedure ProjectChanged; virtual; 41 | public 42 | class procedure GetEffectivePaths(const APaths: TStrings; const ABase: Boolean = False); 43 | class procedure GetSearchPaths(const APlatform: string; const APaths: TStrings; const AAdd: Boolean = False); 44 | public 45 | constructor Create; virtual; 46 | end; 47 | 48 | TWizardClass = class of TWizard; 49 | 50 | TWizardRegistry = TList; 51 | TWizards = TList; 52 | 53 | TOTAWizard = class; 54 | 55 | TOTAWizardClass = class of TOTAWizard; 56 | 57 | /// 58 | /// Base OTA Wizard. This class manages all that's required for your add-in 59 | /// 60 | /// 61 | /// Usually, add-ins will use descendants of TIDENotifierOTAWizard, rather than of this class 62 | /// 63 | TOTAWizard = class(TInterfacedObject, IOTAWizard) 64 | private 65 | class var FIndex: Integer; 66 | class var FPluginIndex: Integer; 67 | class var FRegistry: TWizardRegistry; 68 | class var FWizard: TOTAWizard; 69 | class var FWizards: TWizards; 70 | class procedure DestroyWizards; 71 | class procedure Terminate; static; 72 | private 73 | FActiveForm: TForm; 74 | FIsIDEStarted: Boolean; 75 | FPeriodicInterval: Cardinal; 76 | FTimer: TTimer; 77 | procedure CreateWizards; 78 | procedure DoActiveFormChanged; 79 | procedure TimerIntervalHandler(Sender: TObject); 80 | procedure NotifyIDEStarted; 81 | procedure NotifyIDEStopped; 82 | procedure NotifyPeriodicTimer; 83 | procedure RegisterPlugin; 84 | protected 85 | /// 86 | /// Override this function with the name of your add-in 87 | /// 88 | class function GetWizardName: string; virtual; 89 | /// 90 | /// Call RegisterSplash in the initialization section of your TOTAWizard descendants unit 91 | /// 92 | class procedure RegisterSplash; 93 | /// 94 | /// Provides class-based access to the instance of the add-in 95 | /// 96 | class property Wizard: TOTAWizard read FWizard; 97 | protected 98 | /// 99 | /// Called when the active form of the IDE changes 100 | /// 101 | procedure ActiveFormChanged; virtual; 102 | /// 103 | /// Call ConfigChanged to notify the "sub-wizards" that the configuration has changed 104 | /// 105 | procedure ConfigChanged; virtual; 106 | function DebuggerBeforeProgramLaunch(const AProject: IOTAProject): Boolean; virtual; 107 | /// 108 | /// Called when the debugger creates a process 109 | /// 110 | procedure DebuggerProcessCreated(const AProcess: IOTAProcess); 111 | /// 112 | /// Call FileNotification to notify the "sub-wizards" of the TOTAFileNotification 113 | /// 114 | procedure FileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); 115 | /// 116 | /// Finds the popup that shows when right-clicking the editor 117 | /// 118 | function FindEditorPopup(out APopup: TPopupActionBar): Boolean; 119 | /// 120 | /// Override this function with the description of your add-in 121 | /// 122 | function GetWizardDescription: string; virtual; 123 | /// 124 | /// Returns the plugin filename 125 | /// 126 | function GetWizardFileName: string; 127 | /// 128 | /// Returns the plugin name and version 129 | /// 130 | function GetWizardPluginName: string; 131 | /// 132 | /// Call HookedEditorMenu to notify the "sub-wizards" that they can now add items to the wizard's menu item 133 | /// 134 | procedure HookedEditorMenuPopup(const AMenuItem: TMenuItem); 135 | /// 136 | /// Called when the IDE has finished compiling the specified project 137 | /// 138 | procedure IDEAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); 139 | /// 140 | /// Called when the IDE is about to compile the specified project 141 | /// 142 | procedure IDEBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); 143 | /// 144 | /// Override this function to respond when the IDE has started 145 | /// 146 | procedure IDEStarted; virtual; 147 | /// 148 | /// Override this function to respond when the IDE has stopped 149 | /// 150 | procedure IDEStopped; virtual; 151 | /// 152 | /// Override this function to take advantage of the IDE timer 153 | /// 154 | procedure PeriodicTimer; virtual; 155 | /// 156 | /// Call Modification to notify the "sub-wizards" that a modification has occurred 157 | /// 158 | procedure Modification; 159 | procedure ProjectChanged; 160 | /// 161 | /// Override this function to respond when all the "sub-wizards" have been created 162 | /// 163 | procedure WizardsCreated; virtual; 164 | { IOTANotifier } 165 | procedure AfterSave; 166 | procedure BeforeSave; 167 | procedure Destroyed; 168 | procedure Modified; 169 | { IOTAWizard } 170 | procedure Execute; virtual; 171 | /// 172 | /// Override GetIDString with a unique id for your add-in (e.g. com.mydomain.myexpert) 173 | /// 174 | function GetIDString: string; virtual; 175 | /// 176 | /// Override GetName with a name for your add-in 177 | /// 178 | function GetName: string; virtual; 179 | function GetState: TWizardState; 180 | public 181 | /// 182 | /// Creates an instance of a dockable form and performs the necessary initialization 183 | /// 184 | class procedure CreateDockableForm(var AForm; const AClass: TDesktopFormClass); 185 | /// 186 | /// Destroys an instance of a dockable form and performs the necessary finalization 187 | /// 188 | class procedure FreeDockableForm(var AForm); 189 | /// 190 | /// Override this function if necessary to provide the add-in's version (default is Major.Minor.Release) 191 | /// 192 | class function GetWizardVersion: string; virtual; 193 | /// 194 | /// Override this function if necessary to provide the add-in's license info 195 | /// 196 | class function GetWizardLicense: string; virtual; 197 | /// 198 | /// Call InitializeWizard from the function named as WizardEntryPoint that is exported by your add-in 199 | /// 200 | /// 201 | /// Refer to the export section at the end of the TotalDemo.OTAWizard unit 202 | /// 203 | class function InitializeWizard(const Services: IBorlandIDEServices; RegisterProc: TWizardRegisterProc; 204 | var TerminateProc: TWizardTerminateProc; const AWizardClass: TOTAWizardClass): Boolean; 205 | /// 206 | /// Call RegisterDesktopForm somewhere 207 | /// 208 | // class procedure RegisterDesktopFormClass(const AClass: TDesktopFormClass); 209 | // class procedure RegisterDesktopForm(var AForm); 210 | /// 211 | /// Call RegisterWizard to register a "sub-wizard" that is managed by the add-in 212 | /// 213 | class procedure RegisterWizard(const AWizardClass: TWizardClass); 214 | public 215 | constructor Create; virtual; 216 | destructor Destroy; override; 217 | procedure AfterConstruction; override; 218 | end; 219 | 220 | implementation 221 | 222 | uses 223 | // RTL 224 | System.SysUtils, System.Win.Registry, 225 | // Windows 226 | Winapi.Windows, 227 | // DW 228 | DW.OTA.Registry, DW.OTA.Helpers, DW.Menus.Helpers, DW.OSDevice; 229 | 230 | function GetEnvironmentVariable(const AName: string): string; 231 | const 232 | BufSize = 1024; 233 | var 234 | Len: Integer; 235 | Buffer: array[0..BufSize - 1] of Char; 236 | begin 237 | Result := ''; 238 | Len := Winapi.Windows.GetEnvironmentVariable(PChar(AName), @Buffer, BufSize); 239 | if Len < BufSize then 240 | SetString(Result, PChar(@Buffer), Len) 241 | else 242 | begin 243 | SetLength(Result, Len - 1); 244 | Winapi.Windows.GetEnvironmentVariable(PChar(AName), PChar(Result), Len); 245 | end; 246 | end; 247 | 248 | { TWizard } 249 | 250 | constructor TWizard.Create; 251 | begin 252 | inherited; 253 | // 254 | end; 255 | 256 | function TWizard.DebuggerBeforeProgramLaunch(const Project: IOTAProject): Boolean; 257 | begin 258 | Result := True; 259 | end; 260 | 261 | procedure TWizard.DebuggerProcessCreated(const AProcess: IOTAProcess); 262 | begin 263 | // 264 | end; 265 | 266 | procedure TWizard.FileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); 267 | begin 268 | // 269 | end; 270 | 271 | function TWizard.GetRSVersion: string; 272 | begin 273 | Result := GetEnvironmentVariable('ProductVersion'); 274 | end; 275 | 276 | class procedure TWizard.GetEffectivePaths(const APaths: TStrings; const ABase: Boolean = False); 277 | var 278 | LPlatform: string; 279 | LProject: IOTAProject; 280 | begin 281 | LProject := TOTAHelper.GetActiveProject; 282 | if LProject <> nil then 283 | begin 284 | TOTAHelper.GetProjectActiveEffectivePaths(LProject, APaths, ABase); 285 | LPlatform := LProject.CurrentPlatform; 286 | if LPlatform.Equals('Android') then 287 | LPlatform := 'Android32'; 288 | GetSearchPaths(LPlatform, APaths, True); 289 | TOTAHelper.ExpandPaths(APaths, LProject); 290 | end; 291 | end; 292 | 293 | class procedure TWizard.GetSearchPaths(const APlatform: string; const APaths: TStrings; const AAdd: Boolean = False); 294 | var 295 | LPaths: TStrings; 296 | LReg: TRegistry; 297 | begin 298 | LReg := TBDSRegistry.Current; 299 | if LReg.OpenKey(TOTAHelper.GetRegKey + '\Library\' + APlatform, False) then 300 | try 301 | LPaths := TStringList.Create; 302 | try 303 | LPaths.Text := StringReplace(LReg.GetDataAsString('Search Path'), ';', #13#10, [rfReplaceAll]); 304 | if AAdd then 305 | APaths.AddStrings(LPaths) 306 | else 307 | APaths.Assign(LPaths); 308 | finally 309 | LPaths.Free; 310 | end; 311 | finally 312 | LReg.CloseKey; 313 | end; 314 | end; 315 | 316 | function TWizard.HookedEditorMenuPopup(const AMenuItem: TMenuItem): Boolean; 317 | begin 318 | Result := False; 319 | end; 320 | 321 | procedure TWizard.Modification; 322 | begin 323 | // 324 | end; 325 | 326 | procedure TWizard.PeriodicTimer; 327 | begin 328 | // 329 | end; 330 | 331 | procedure TWizard.ProjectChanged; 332 | begin 333 | // 334 | end; 335 | 336 | function TWizard._AddRef: Integer; 337 | begin 338 | Result := -1; 339 | end; 340 | 341 | function TWizard._Release: Integer; 342 | begin 343 | Result := -1; 344 | end; 345 | 346 | procedure TWizard.ActiveFormChanged; 347 | begin 348 | // 349 | end; 350 | 351 | procedure TWizard.ConfigChanged; 352 | begin 353 | // 354 | end; 355 | 356 | procedure TWizard.IDEAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); 357 | begin 358 | // 359 | end; 360 | 361 | procedure TWizard.IDEBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); 362 | begin 363 | // 364 | end; 365 | 366 | procedure TWizard.IDEStarted; 367 | begin 368 | // 369 | end; 370 | 371 | procedure TWizard.IDEStopped; 372 | begin 373 | // 374 | end; 375 | 376 | { TOTAWizard } 377 | 378 | constructor TOTAWizard.Create; 379 | begin 380 | inherited; 381 | {$IFDEF DEBUG} 382 | TOTAHelper.IsDebug := True; 383 | {$ENDIF} 384 | RegisterPlugin; 385 | FTimer := TTimer.Create(nil); 386 | FTimer.Interval := 50; 387 | FTimer.OnTimer := TimerIntervalHandler; 388 | FTimer.Enabled := True; 389 | end; 390 | 391 | destructor TOTAWizard.Destroy; 392 | begin 393 | if FPluginIndex > 0 then 394 | (BorlandIDEServices as IOTAAboutBoxServices).RemovePluginInfo(FPluginIndex); 395 | FTimer.Free; 396 | inherited; 397 | end; 398 | 399 | procedure TOTAWizard.ConfigChanged; 400 | var 401 | LWizard: TWizard; 402 | begin 403 | if FWizards <> nil then 404 | begin 405 | for LWizard in FWizards do 406 | LWizard.ConfigChanged; 407 | end; 408 | end; 409 | 410 | function TOTAWizard.DebuggerBeforeProgramLaunch(const AProject: IOTAProject): Boolean; 411 | var 412 | LWizard: TWizard; 413 | begin 414 | Result := True; 415 | if FWizards <> nil then 416 | begin 417 | for LWizard in FWizards do 418 | try 419 | Result := LWizard.DebuggerBeforeProgramLaunch(AProject); 420 | except 421 | // Swallow any exceptions caused by wizards 422 | end; 423 | end; 424 | end; 425 | 426 | procedure TOTAWizard.DebuggerProcessCreated(const AProcess: IOTAProcess); 427 | var 428 | LWizard: TWizard; 429 | begin 430 | if FWizards <> nil then 431 | begin 432 | for LWizard in FWizards do 433 | LWizard.DebuggerProcessCreated(AProcess); 434 | end; 435 | end; 436 | 437 | procedure TOTAWizard.IDEAfterCompile(const AProject: IOTAProject; const ASucceeded, AIsCodeInsight: Boolean); 438 | var 439 | LWizard: TWizard; 440 | begin 441 | if FWizards <> nil then 442 | begin 443 | for LWizard in FWizards do 444 | LWizard.IDEAfterCompile(AProject, ASucceeded, AIsCodeInsight); 445 | end; 446 | end; 447 | 448 | procedure TOTAWizard.IDEBeforeCompile(const AProject: IOTAProject; const AIsCodeInsight: Boolean; var ACancel: Boolean); 449 | var 450 | LWizard: TWizard; 451 | begin 452 | if FWizards <> nil then 453 | begin 454 | for LWizard in FWizards do 455 | try 456 | LWizard.IDEBeforeCompile(AProject, AIsCodeInsight, ACancel); 457 | except 458 | // Swallow any exceptions caused by wizards 459 | end; 460 | end; 461 | end; 462 | 463 | procedure TOTAWizard.IDEStarted; 464 | begin 465 | // 466 | end; 467 | 468 | procedure TOTAWizard.IDEStopped; 469 | begin 470 | // 471 | end; 472 | 473 | procedure TOTAWizard.PeriodicTimer; 474 | begin 475 | // 476 | end; 477 | 478 | procedure TOTAWizard.ProjectChanged; 479 | var 480 | LWizard: TWizard; 481 | begin 482 | if FWizards <> nil then 483 | begin 484 | for LWizard in FWizards do 485 | LWizard.ProjectChanged; 486 | end; 487 | end; 488 | 489 | function TOTAWizard.FindEditorPopup(out APopup: TPopupActionBar): Boolean; 490 | var 491 | LComponent: TComponent; 492 | begin 493 | Result := False; 494 | if TOTAHelper.FindComponentGlobal('EditorLocalMenu', LComponent) and (LComponent is TPopupActionBar) then 495 | begin 496 | APopup := TPopupActionBar(LComponent); 497 | Result := True; 498 | end; 499 | end; 500 | 501 | procedure TOTAWizard.TimerIntervalHandler(Sender: TObject); 502 | var 503 | LMainForm: TComponent; 504 | LTerminated: Boolean; 505 | begin 506 | LTerminated := Application.Terminated; 507 | if not LTerminated then 508 | begin 509 | LMainForm := Application.FindComponent('AppBuilder'); 510 | if not FIsIDEStarted and (LMainForm is TForm) and TForm(LMainForm).Visible then 511 | NotifyIDEStarted; 512 | if Screen.ActiveForm <> FActiveForm then 513 | begin 514 | FActiveForm := Screen.ActiveForm; 515 | DoActiveFormChanged; 516 | end; 517 | if FIsIDEStarted then 518 | begin 519 | Inc(FPeriodicInterval, FTimer.Interval); 520 | if FPeriodicInterval >= 100 then 521 | NotifyPeriodicTimer; 522 | end; 523 | end 524 | else if FIsIDEStarted then 525 | NotifyIDEStopped; 526 | end; 527 | 528 | procedure TOTAWizard.DoActiveFormChanged; 529 | var 530 | LWizard: TWizard; 531 | begin 532 | ActiveFormChanged; 533 | if FWizards <> nil then 534 | begin 535 | for LWizard in FWizards do 536 | LWizard.ActiveFormChanged; 537 | end; 538 | end; 539 | 540 | procedure TOTAWizard.NotifyIDEStarted; 541 | var 542 | LWizard: TWizard; 543 | begin 544 | FIsIDEStarted := True; 545 | IDEStarted; 546 | if FWizards <> nil then 547 | begin 548 | for LWizard in FWizards do 549 | LWizard.IDEStarted; 550 | end; 551 | end; 552 | 553 | procedure TOTAWizard.NotifyIDEStopped; 554 | var 555 | LWizard: TWizard; 556 | begin 557 | IDEStopped; 558 | if FWizards <> nil then 559 | begin 560 | for LWizard in FWizards do 561 | LWizard.IDEStopped; 562 | end; 563 | end; 564 | 565 | procedure TOTAWizard.NotifyPeriodicTimer; 566 | var 567 | LWizard: TWizard; 568 | begin 569 | PeriodicTimer; 570 | if FWizards <> nil then 571 | begin 572 | for LWizard in FWizards do 573 | LWizard.PeriodicTimer; 574 | end; 575 | FPeriodicInterval := 0; 576 | end; 577 | 578 | procedure TOTAWizard.ActiveFormChanged; 579 | begin 580 | // 581 | end; 582 | 583 | procedure TOTAWizard.AfterConstruction; 584 | begin 585 | inherited; 586 | CreateWizards; 587 | end; 588 | 589 | procedure TOTAWizard.CreateWizards; 590 | var 591 | LWizardClass: TWizardClass; 592 | begin 593 | if FRegistry <> nil then 594 | begin 595 | for LWizardClass in FRegistry do 596 | FWizards.Add(LWizardClass.Create); 597 | end; 598 | WizardsCreated; 599 | end; 600 | 601 | class procedure TOTAWizard.DestroyWizards; 602 | var 603 | LWizard: TWizard; 604 | begin 605 | if FWizards <> nil then 606 | begin 607 | for LWizard in FWizards do 608 | LWizard.Free; 609 | FWizards.Free; 610 | FWizards := nil; 611 | end; 612 | end; 613 | 614 | procedure TOTAWizard.WizardsCreated; 615 | begin 616 | // 617 | end; 618 | 619 | procedure TOTAWizard.AfterSave; 620 | begin 621 | // 622 | end; 623 | 624 | procedure TOTAWizard.BeforeSave; 625 | begin 626 | // 627 | end; 628 | 629 | procedure TOTAWizard.Destroyed; 630 | begin 631 | // 632 | end; 633 | 634 | procedure TOTAWizard.Modification; 635 | var 636 | LWizard: TWizard; 637 | begin 638 | if FWizards <> nil then 639 | begin 640 | for LWizard in FWizards do 641 | LWizard.Modification; 642 | end; 643 | end; 644 | 645 | procedure TOTAWizard.Modified; 646 | begin 647 | // 648 | end; 649 | 650 | procedure TOTAWizard.Execute; 651 | begin 652 | // 653 | end; 654 | 655 | procedure TOTAWizard.FileNotification(const ANotifyCode: TOTAFileNotification; const AFileName: string); 656 | var 657 | LWizard: TWizard; 658 | begin 659 | if FWizards <> nil then 660 | begin 661 | for LWizard in FWizards do 662 | LWizard.FileNotification(ANotifyCode, AFileName); 663 | end; 664 | end; 665 | 666 | procedure TOTAWizard.HookedEditorMenuPopup(const AMenuItem: TMenuItem); 667 | var 668 | LWizard: TWizard; 669 | begin 670 | if FWizards <> nil then 671 | begin 672 | for LWizard in FWizards do 673 | LWizard.HookedEditorMenuPopup(AMenuItem); 674 | end; 675 | end; 676 | 677 | function TOTAWizard.GetIDString: string; 678 | begin 679 | Result := ''; 680 | end; 681 | 682 | function TOTAWizard.GetName: string; 683 | begin 684 | Result := ''; 685 | end; 686 | 687 | function TOTAWizard.GetState: TWizardState; 688 | begin 689 | Result := [wsEnabled]; 690 | end; 691 | 692 | function TOTAWizard.GetWizardDescription: string; 693 | begin 694 | Result := ''; 695 | end; 696 | 697 | function TOTAWizard.GetWizardFileName: string; 698 | begin 699 | Result := GetModuleName(HInstance); 700 | end; 701 | 702 | class function TOTAWizard.GetWizardLicense: string; 703 | begin 704 | Result := ''; 705 | end; 706 | 707 | class function TOTAWizard.GetWizardName: string; 708 | begin 709 | Result := ''; 710 | end; 711 | 712 | function TOTAWizard.GetWizardPluginName: string; 713 | begin 714 | Result := GetName + ' ' + GetWizardVersion; 715 | end; 716 | 717 | class function TOTAWizard.GetWizardVersion: string; 718 | var 719 | LBuild: string; 720 | begin 721 | Result := TOSDevice.GetPackageVersion; 722 | if TOSDevice.IsBeta then 723 | begin 724 | LBuild := TOSDevice.GetPackageBuild; 725 | if not LBuild.Equals('0') then 726 | Result := Format('%s (Beta %s)', [Result, LBuild]) 727 | else 728 | Result := Format('%s (Beta)', [Result]); 729 | end; 730 | end; 731 | 732 | class procedure TOTAWizard.CreateDockableForm(var AForm; const AClass: TDesktopFormClass); 733 | var 734 | LForm: TCustomForm; 735 | begin 736 | TCustomForm(AForm) := AClass.Create(nil); 737 | LForm := TCustomForm(AForm); 738 | if @RegisterFieldAddress <> nil then 739 | RegisterFieldAddress(LForm.Name, @AForm); 740 | RegisterDesktopFormClass(AClass, LForm.Name, LForm.Name); 741 | end; 742 | 743 | class procedure TOTAWizard.FreeDockableForm(var AForm); 744 | var 745 | LForm: TCustomForm; 746 | begin 747 | LForm := TCustomForm(AForm); 748 | if Assigned(LForm) then 749 | begin 750 | if @UnRegisterFieldAddress <> nil then 751 | UnregisterFieldAddress(@AForm); 752 | LForm.Free; 753 | TCustomForm(AForm) := nil; 754 | end; 755 | end; 756 | 757 | procedure TOTAWizard.RegisterPlugin; 758 | var 759 | LBitmapHandle: HBITMAP; 760 | LServices: IOTAAboutBoxServices; 761 | begin 762 | LBitmapHandle := LoadBitmap(HInstance, 'SplashScreenBitmap'); 763 | if LBitmapHandle > 0 then 764 | begin 765 | LServices := BorlandIDEServices as IOTAAboutBoxServices; 766 | FPluginIndex := LServices.AddPluginInfo(GetWizardPluginName, GetWizardDescription, LBitmapHandle, False, GetWizardLicense, GetWizardVersion); 767 | end; 768 | end; 769 | 770 | class procedure TOTAWizard.RegisterSplash; 771 | var 772 | LBitmapHandle: HBITMAP; 773 | begin 774 | LBitmapHandle := LoadBitmap(HInstance, 'SplashScreenBitmap'); 775 | if LBitmapHandle > 0 then 776 | SplashScreenServices.AddPluginBitmap(GetWizardName, LBitmapHandle, False, GetWizardLicense, GetWizardVersion); 777 | end; 778 | 779 | class procedure TOTAWizard.RegisterWizard(const AWizardClass: TWizardClass); 780 | begin 781 | if FRegistry = nil then 782 | FRegistry := TWizardRegistry.Create; 783 | if FWizards = nil then 784 | FWizards := TWizards.Create; 785 | FRegistry.Add(AWizardClass); 786 | end; 787 | 788 | class function TOTAWizard.InitializeWizard(const Services: IBorlandIDEServices; RegisterProc: TWizardRegisterProc; 789 | var TerminateProc: TWizardTerminateProc; const AWizardClass: TOTAWizardClass): Boolean; 790 | begin 791 | FWizard := AWizardClass.Create; 792 | FIndex := (BorlandIDEServices as IOTAWizardServices).AddWizard(FWizard as IOTAWizard); 793 | TerminateProc := TOTAWizard.Terminate; 794 | Result := True; 795 | end; 796 | 797 | class procedure TOTAWizard.Terminate; 798 | begin 799 | DestroyWizards; 800 | (BorlandIDEServices as IOTAWizardServices).RemoveWizard(FIndex); 801 | end; 802 | 803 | end. 804 | -------------------------------------------------------------------------------- /DW.OTA.Helpers.pas: -------------------------------------------------------------------------------- 1 | unit DW.OTA.Helpers; 2 | 3 | {*******************************************************} 4 | { } 5 | { TOTAL - Terrific Open Tools API Library } 6 | { } 7 | {*******************************************************} 8 | 9 | interface 10 | 11 | uses 12 | System.Classes, System.SysUtils, 13 | ToolsAPI, PlatformAPI, 14 | Vcl.Menus, Vcl.Forms, Vcl.ActnList, 15 | DW.OTA.Types; 16 | 17 | const 18 | cFileMenuItemName = 'FileMenu'; 19 | cFileReopenMenuItemName = 'FileClosedFilesItem'; 20 | cToolsMenuItemName = 'ToolsMenu'; 21 | 22 | type 23 | TOTAHelper = record 24 | private 25 | class function FindComponentRecurse(const AParent: TComponent; const AComponentName: string; out AComponent: TComponent): Boolean; static; 26 | class function GetSourceEditor(const AModule: IOTAModule): IOTASourceEditor; static; 27 | public 28 | /// 29 | /// Set this flag if building for debug 30 | /// 31 | class var IsDebug: Boolean; 32 | /// 33 | /// Adds an image to the IDEs image list 34 | /// 35 | class function AddImage(const AResName: string): Integer; static; 36 | /// 37 | /// Adds a message to a group entitled TOTAL Debug 38 | /// 39 | class procedure AddDebugMessage(const AMsg: string); static; 40 | /// 41 | /// Adds an exception message to a group specified by AGroupName 42 | /// 43 | class procedure AddTitleException(const AException: Exception; const AProcess: string; const AGroupName: string = ''); static; 44 | /// 45 | /// Adds a message to a group specified by AGroupName. Returns the group that the message was added to. 46 | /// 47 | class function AddTitleMessage(const AMsg: string; const AGroupName: string = ''): IOTAMessageGroup; static; 48 | /// 49 | /// Adds a toolbar button to the named toolbar 50 | /// 51 | class function AddToolbarButton(const AToolbarName, AButtonName: string; const AAction: TCustomAction): Boolean; static; 52 | /// 53 | /// Applies the active theme to the component and children 54 | /// 55 | class procedure ApplyTheme(const AComponent: TComponent); static; 56 | /// 57 | /// Clears the message group specified by AGroupName. Optionally removes the group 58 | /// 59 | class procedure ClearMessageGroup(const AGroupName: string; const ARemove: Boolean = False); static; 60 | /// 61 | /// Closes the module that is currently visible in the IDE 62 | /// 63 | class procedure CloseCurrentModule; static; 64 | /// 65 | /// Expands the paths associated with the configuration 66 | /// 67 | class function ExpandConfiguration(const ASource: string; const AConfig: IOTABuildConfiguration): string; static; 68 | /// 69 | /// Expands a folder 70 | /// 71 | class function ExpandOutputDir(const ASource: string): string; static; 72 | /// 73 | /// Expands the paths associated with a project 74 | /// 75 | class procedure ExpandPaths(const APaths: TStrings; const AProject: IOTAProject = nil); static; 76 | /// 77 | /// Expands the paths associated with the active configuration 78 | /// 79 | class function ExpandProjectActiveConfiguration(const ASource: string; const AProject: IOTAProject): string; static; 80 | /// 81 | /// Expands the variables contained in ASource 82 | /// 83 | class function ExpandVars(const ASource: string): string; static; 84 | /// 85 | /// Finds an action application-wide 86 | /// 87 | class function FindActionGlobal(const AActionName: string; out AAction: TCustomAction): Boolean; static; 88 | /// 89 | /// Finds a form with a particular name 90 | /// 91 | class function FindForm(const AFormName: string; out AForm: TComponent; const ACheckVisible: Boolean = False): Boolean; static; 92 | /// 93 | /// Finds the first form with a particular class 94 | /// 95 | class function FindFormByClass(const AClassName: string; out AForm: TComponent; const ACheckVisible: Boolean = False): Boolean; static; 96 | /// 97 | /// Finds a component application-wide 98 | /// 99 | class function FindComponentGlobal(const AComponentName: string; out AComponent: TComponent): Boolean; static; 100 | /// 101 | /// Finds a menu with a given name from the given parent 102 | /// 103 | class function FindMenu(const AParentItem: TMenuItem; const AMenuName: string; out AMenuItem: TMenuItem): Boolean; static; 104 | /// 105 | /// Finds a menu with a given caption from the given parent 106 | /// 107 | class function FindMenuByCaption(const AParentItem: TMenuItem; const ACaption: string; out AMenuItem: TMenuItem): Boolean; static; 108 | /// 109 | /// Finds the index of the AOccurence-th menu separator (1-based) 110 | /// 111 | class function FindMenuSeparatorIndex(const AParentItem: TMenuItem; const AOccurence: Integer): Integer; overload; static; 112 | class function FindMenuSeparatorIndex(const AParentItem: TMenuItem; const AAfterMenuName: string): Integer; overload; static; 113 | /// 114 | /// Finds the IDEs Tools menu 115 | /// 116 | class function FindToolsMenu(out AMenuItem: TMenuItem): Boolean; static; 117 | /// 118 | /// Finds a submenu with the given name under Tools 119 | /// 120 | class function FindToolsSubMenu(const AMenuName: string; out AMenuItem: TMenuItem): Boolean; static; 121 | /// 122 | /// Finds a top-level menu with the given name 123 | /// 124 | class function FindTopMenu(const AMenuName: string; out AMenuItem: TMenuItem): Boolean; static; 125 | /// 126 | /// Finds the top most edit view, if available 127 | /// 128 | class function FindTopEditView(const ASourceEditor: IOTASourceEditor; out AEditView: IOTAEditView): Boolean; static; 129 | /// 130 | /// Gets the active project, if any 131 | /// 132 | class function GetActiveProject: IOTAProject; static; 133 | /// 134 | /// Gets the output build folder for the active project (combination of output path and Sanitized Project Name) 135 | /// 136 | class function GetActiveProjectBuildPath: string; static; 137 | /// 138 | /// Gets the filename for the active project 139 | /// 140 | class function GetActiveProjectFileName: string; static; 141 | /// 142 | /// Gets the active project options, if any 143 | /// 144 | class function GetActiveProjectOptions: IOTAProjectOptions; static; 145 | /// 146 | /// Gets the configurations for the active project, if any 147 | /// 148 | class function GetActiveProjectOptionsConfigurations: IOTAProjectOptionsConfigurations; static; 149 | /// 150 | /// Gets the output folder for the active project 151 | /// 152 | class function GetActiveProjectOutputDir: string; static; 153 | /// 154 | /// Gets the folder for the active project 155 | /// 156 | class function GetActiveProjectPath: string; static; 157 | /// 158 | /// Gets the sanitized project name for the active project 159 | /// 160 | class function GetActiveProjectSanitizedProjectName: string; static; 161 | /// 162 | /// Gets the active source editor 163 | /// 164 | class function GetActiveSourceEditor: IOTASourceEditor; static; 165 | /// 166 | /// Gets the active source editor filename 167 | /// 168 | class function GetActiveSourceEditorFileName: string; static; 169 | /// 170 | /// Gets the current module 171 | /// 172 | class function GetCurrentModule: IOTAModule; static; 173 | /// 174 | /// Gets the currently selected project, if any 175 | /// 176 | class function GetCurrentSelectedProject: IOTAProject; static; 177 | /// 178 | /// Gets the environment options for the IDE 179 | /// 180 | class function GetEnvironmentOptions: IOTAEnvironmentOptions; static; 181 | /// 182 | /// Gets the main form for the IDE 183 | /// 184 | class function GetMainForm: TComponent; static; 185 | /// 186 | /// Gets the effective paths for the active project 187 | /// 188 | class procedure GetProjectActiveEffectivePaths(const AProject: IOTAProject; const APaths: TStrings; const ABase: Boolean = False); static; 189 | /// 190 | /// Gets the projects current connection profile, if any 191 | /// 192 | class function GetProjectBuildFileName(const AProject: IOTAProject; const AFileName: string): string; static; 193 | /// 194 | /// Gets the projects current build type, e.g. Developer, Ad-Hoc, App Store 195 | /// 196 | class function GetProjectCurrentBuildType(const AProject: IOTAProject): string; static; 197 | /// 198 | /// Gets the projects current connection profile, if any 199 | /// 200 | class function GetProjectCurrentConnectionProfile(const AProject: IOTAProject): string; static; 201 | /// 202 | /// Gets the projects current mobile device serial number, if any 203 | /// 204 | class function GetProjectCurrentMobileDeviceName(const AProject: IOTAProject): string; static; 205 | /// 206 | /// Gets the current platform for the given project 207 | /// 208 | class function GetProjectCurrentPlatform(const AProject: IOTAProject): TProjectPlatform; static; 209 | /// 210 | /// Gets the projects currently selected SDK as a string e.g. iPhoneOS 14.5 211 | /// 212 | class function GetProjectCurrentSDKVersion(const AProject: IOTAProject): string; static; 213 | /// 214 | /// Gets the projects deployed filename for the active platform/build 215 | /// 216 | class function GetProjectDeployedFileName(const AProject: IOTAProject): string; static; 217 | /// 218 | /// Gets the projects deployed path for the active platform/build 219 | /// 220 | class function GetProjectDeployedPath(const AProject: IOTAProject): string; static; 221 | /// 222 | /// Gets the current project group, if any 223 | /// 224 | class function GetProjectGroup: IOTAProjectGroup; static; 225 | /// 226 | /// Gets the active build configuration for the given project 227 | /// 228 | class function GetProjectActiveBuildConfiguration(const AProject: IOTAProject): IOTABuildConfiguration; static; 229 | /// 230 | /// Gets the active build configuration value for the given project and key 231 | /// 232 | class function GetProjectActiveBuildConfigurationValue(const AProject: IOTAProject; const AKey: string): string; static; 233 | /// 234 | /// Gets the configuration names for the project, e.g. Debug, Release 235 | /// 236 | class function GetProjectConfigurationNames(const AProject: IOTAProject): TArray; static; 237 | /// 238 | /// Gets the options configurations for the given project 239 | /// 240 | class function GetProjectOptionsConfigurations(const AProject: IOTAProject): IOTAProjectOptionsConfigurations; static; 241 | /// 242 | /// Gets the output folder for the given project 243 | /// 244 | class function GetProjectOutputDir(const AProject: IOTAProject): string; static; 245 | /// 246 | /// Gets the folder for the given project 247 | /// 248 | class function GetProjectPath(const AProject: IOTAProject): string; static; 249 | /// 250 | /// Gets the project platform from the string value 251 | /// 252 | class function GetProjectPlatform(const APlatform: string): TProjectPlatform; static; 253 | /// 254 | /// Gets the project supported platforms as a set e.g. [TProjectPlatform.Android32, TProjectPlatform.Android64] etc 255 | /// 256 | class function GetProjectSupportedPlatforms(const AProject: IOTAProject): TProjectPlatforms; static; 257 | /// 258 | /// Gets the base registry key for the IDE 259 | /// 260 | class function GetRegKey: string; static; 261 | /// 262 | /// Gets the remote profile for the selected platform and profile name 263 | /// 264 | class function GetRemoteProfile(const APlatform, AProfileName: string): IOTARemoteProfile; static; 265 | /// 266 | /// Gets all the text in a source editor 267 | /// 268 | class function GetSourceEditorText(const ASourceEditor: IOTASourceEditor): string; static; 269 | /// 270 | /// Gets a value from version info for the given key 271 | /// 272 | class function GetVerInfoValue(const AVerInfo: string; const AKey: string): string; static; 273 | class function HasBuildEvents(const AProject: IOTAProject): Boolean; static; 274 | /// 275 | /// Indicates whether or not the IDE is closing 276 | /// 277 | class function IsIDEClosing: Boolean; static; 278 | /// 279 | /// Indicates whether or not the platform is iOS 280 | /// 281 | class function IsIOSPlatform(const APlatform: string): Boolean; static; 282 | /// 283 | /// Indicates whether or not the platform is Mac/iOS 284 | /// 285 | class function IsMacOSPlatform(const APlatform: string): Boolean; static; 286 | /// 287 | /// Indicates whether or not a platform matches the profile platform 288 | /// 289 | class function IsMatchingProfilePlatform(const APlatform, AProfilePlatform: string): Boolean; static; 290 | /// 291 | /// Marks the current module as being modified 292 | /// 293 | class procedure MarkCurrentModuleModified; static; 294 | /// 295 | /// Marks the active project as being modified 296 | /// 297 | class procedure MarkActiveProjectModified; static; 298 | /// 299 | /// Opens the given file in the IDE, where the file may be a project or a group 300 | /// 301 | class function OpenFile(const AFilename: string): Boolean; static; 302 | /// 303 | /// Refreshes the project manager tree 304 | /// 305 | class procedure RefreshProjectTree; static; 306 | class procedure ResetProjectSearchPathToBase(const AProject: IOTAProject; const AExcludePlatforms: TArray = []); static; 307 | /// 308 | /// Shows the message view in the messages window for the given group 309 | /// 310 | class procedure RegisterThemeForms(const AFormClasses: array of TCustomFormClass); static; 311 | /// 312 | /// Sets the projects SDK version 313 | /// 314 | class procedure SetProjectSDKVersion(const AProject: IOTAProject; const APlatform, ASDKVersion: string); static; 315 | /// 316 | /// Sets the projects output path for all platforms/configs, *removing* the values from descendants (i.e. Platforms/Configs) 317 | /// 318 | /// 319 | /// Omitting ADCUPath will result in the DCU path being set to the *same* as the Output path 320 | /// 321 | class procedure SetProjectOutputToBase(const AProject: IOTAProject; const AOutputPath: string; const ADCUPath: string = ''); static; 322 | /// 323 | /// Shows the message view in the messages window for the given group 324 | /// 325 | class procedure ShowMessageView(const AGroupName: string = ''); static; 326 | end; 327 | 328 | function ExpandPath(const ABaseDir, ARelativeDir: string): string; 329 | 330 | // Really only here for debugging purposes 331 | function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean; 332 | 333 | implementation 334 | 335 | uses 336 | System.IOUtils, System.StrUtils, XML.XMLIntf, 337 | DCCStrs, CommonOptionStrs, 338 | Winapi.Windows, Winapi.ShLwApi, 339 | Vcl.Graphics, Vcl.Controls, 340 | // DW.OSLog, 341 | DW.OTA.Consts; 342 | 343 | type 344 | TOpenControl = class(TControl); 345 | 346 | function IsLike(const AValue, AIsLikeValue: string): Boolean; 347 | var 348 | LWildStart, LWildEnd: Boolean; 349 | begin 350 | Result := False; 351 | LWildStart := AIsLikeValue.StartsWith('%'); 352 | LWildEnd := AIsLikeValue.EndsWith('%'); 353 | if LWildStart and not LWildEnd then 354 | Result := AValue.EndsWith(AIsLikeValue.Substring(1), True) 355 | else if not LWildStart and LWildEnd then 356 | Result := AValue.StartsWith(AIsLikeValue.Substring(0, Length(AIsLikeValue) - 1), True) 357 | else if LWildStart and LWildEnd then 358 | Result := AValue.ToLower.Contains(AIsLikeValue.Substring(1, Length(AIsLikeValue) - 2).ToLower); 359 | end; 360 | 361 | // Tweaked version of David Heffernan's answer, here: 362 | // https://stackoverflow.com/questions/5329472/conversion-between-absolute-and-relative-paths-in-delphi 363 | function ExpandPath(const ABaseDir, ARelativeDir: string): string; 364 | var 365 | LBuffer: array [0..MAX_PATH - 1] of Char; 366 | begin 367 | if PathIsRelative(PChar(ARelativeDir)) then 368 | Result := IncludeTrailingPathDelimiter(ABaseDir) + ARelativeDir 369 | else 370 | Result := ARelativeDir; 371 | if PathCanonicalize(@LBuffer[0], PChar(Result)) then 372 | Result := LBuffer; 373 | end; 374 | 375 | // "Borrowed" a couple of methods from JVCL for processing of environment variables 376 | procedure MultiSzToStrings(const Dest: TStrings; const Source: PChar); 377 | var 378 | P: PChar; 379 | begin 380 | Dest.BeginUpdate; 381 | try 382 | Dest.Clear; 383 | if Source <> nil then 384 | begin 385 | P := Source; 386 | while P^ <> #0 do 387 | begin 388 | Dest.Add(P); 389 | P := StrEnd(P); 390 | Inc(P); 391 | end; 392 | end; 393 | finally 394 | Dest.EndUpdate; 395 | end; 396 | end; 397 | 398 | procedure StrResetLength(var S: string); 399 | begin 400 | SetLength(S, StrLen(PChar(S))); 401 | end; 402 | 403 | function ExpandEnvironmentVar(var Value: string): Boolean; 404 | var 405 | R: Integer; 406 | Expanded: string; 407 | begin 408 | SetLength(Expanded, 1); 409 | R := ExpandEnvironmentStrings(PChar(Value), PChar(Expanded), 0); 410 | SetLength(Expanded, R); 411 | Result := ExpandEnvironmentStrings(PChar(Value), PChar(Expanded), R) <> 0; 412 | if Result then 413 | begin 414 | StrResetLength(Expanded); 415 | Value := Expanded; 416 | end; 417 | end; 418 | 419 | function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean; 420 | var 421 | Raw: PChar; 422 | Expanded: string; 423 | I: Integer; 424 | begin 425 | Vars.BeginUpdate; 426 | try 427 | Vars.Clear; 428 | Raw := GetEnvironmentStrings; 429 | try 430 | MultiSzToStrings(Vars, Raw); 431 | Result := True; 432 | finally 433 | FreeEnvironmentStrings(Raw); 434 | end; 435 | if Expand then 436 | begin 437 | for I := 0 to Vars.Count - 1 do 438 | begin 439 | Expanded := Vars[I]; 440 | if ExpandEnvironmentVar(Expanded) then 441 | Vars[I] := Expanded; 442 | end; 443 | end; 444 | finally 445 | Vars.EndUpdate; 446 | end; 447 | end; 448 | 449 | class function TOTAHelper.AddImage(const AResName: string): Integer; 450 | var 451 | LBitmap: TBitmap; 452 | begin 453 | Result := -1; 454 | if FindResource(HInstance, PChar(AResName), RT_BITMAP) <> 0 then 455 | begin 456 | LBitmap := TBitmap.Create; 457 | try 458 | LBitmap.LoadFromResourceName(HInstance, AResName); 459 | Result := (BorlandIDEServices as INTAServices).AddMasked(LBitmap, LBitmap.Canvas.Pixels[0, LBitmap.Height - 1]); 460 | finally 461 | LBitmap.Free; 462 | end; 463 | end; 464 | end; 465 | 466 | class procedure TOTAHelper.AddDebugMessage(const AMsg: string); 467 | begin 468 | if IsDebug then 469 | AddTitleMessage(AMsg, 'TOTAL Debug'); 470 | end; 471 | 472 | class procedure TOTAHelper.AddTitleException(const AException: Exception; const AProcess: string; const AGroupName: string = ''); 473 | begin 474 | AddTitleMessage(Format('%s - %s: %s', [AProcess, AException.ClassName, AException.Message]), AGroupName); 475 | end; 476 | 477 | class function TOTAHelper.AddTitleMessage(const AMsg: string; const AGroupName: string = ''): IOTAMessageGroup; 478 | var 479 | LServices: IOTAMessageServices; 480 | LGroup: IOTAMessageGroup; 481 | LComponent: TComponent; 482 | begin 483 | LGroup := nil; 484 | LServices := BorlandIDEServices as IOTAMessageServices; 485 | if not AGroupName.IsEmpty then 486 | begin 487 | LGroup := LServices.GetGroup(AGroupName); 488 | if LGroup = nil then 489 | LGroup := LServices.AddMessageGroup(AGroupName); 490 | LServices.AddTitleMessage(AMsg, LGroup); 491 | LComponent := FindGlobalComponent('MessageViewForm'); 492 | if LComponent <> nil then 493 | LServices.ShowMessageView(LGroup); 494 | end 495 | else 496 | LServices.AddTitleMessage(AMsg); 497 | Result := LGroup; 498 | end; 499 | 500 | class function TOTAHelper.AddToolbarButton(const AToolbarName, AButtonName: string; const AAction: TCustomAction): Boolean; 501 | var 502 | LServices: INTAServices; 503 | begin 504 | Result := False; 505 | LServices := BorlandIDEServices as INTAServices; 506 | if LServices.GetToolbar(AToolbarName) <> nil then 507 | begin 508 | LServices.AddToolButton(AToolbarName, AButtonName, AAction); 509 | Result := True; 510 | end; 511 | end; 512 | 513 | class procedure TOTAHelper.ClearMessageGroup(const AGroupName: string; const ARemove: Boolean = False); 514 | var 515 | LServices: IOTAMessageServices; 516 | LGroup: IOTAMessageGroup; 517 | begin 518 | if not AGroupName.IsEmpty then 519 | begin 520 | LServices := BorlandIDEServices as IOTAMessageServices; 521 | LGroup := LServices.GetGroup(AGroupName); 522 | if LGroup <> nil then 523 | begin 524 | LServices.ClearMessageGroup(LGroup); 525 | if ARemove then 526 | LServices.RemoveMessageGroup(LGroup); 527 | end; 528 | end 529 | end; 530 | 531 | class procedure TOTAHelper.ShowMessageView(const AGroupName: string = ''); 532 | var 533 | LServices: IOTAMessageServices; 534 | LGroup: IOTAMessageGroup; 535 | begin 536 | LServices := BorlandIDEServices as IOTAMessageServices; 537 | if not AGroupName.IsEmpty then 538 | begin 539 | LGroup := LServices.GetGroup(AGroupName); 540 | if LGroup <> nil then 541 | LServices.ShowMessageView(LGroup); 542 | end 543 | else 544 | LServices.ShowMessageView(nil); 545 | end; 546 | 547 | class function TOTAHelper.FindActionGlobal(const AActionName: string; out AAction: TCustomAction): Boolean; 548 | var 549 | LComponent: TComponent; 550 | begin 551 | Result := False; 552 | if FindComponentGlobal(AActionName, LComponent) and (LComponent is TCustomAction) then 553 | begin 554 | AAction := TCustomAction(LComponent); 555 | Result := True; 556 | end; 557 | end; 558 | 559 | class function TOTAHelper.FindForm(const AFormName: string; out AForm: TComponent; const ACheckVisible: Boolean = False): Boolean; 560 | var 561 | I: Integer; 562 | begin 563 | Result := False; 564 | for I := 0 to Screen.FormCount - 1 do 565 | begin 566 | if (Screen.Forms[I].Name = AFormName) and (not ACheckVisible or Screen.Forms[I].Visible) then 567 | begin 568 | AForm := Screen.Forms[I]; 569 | Result := True; 570 | Break; 571 | end; 572 | end; 573 | end; 574 | 575 | class function TOTAHelper.FindFormByClass(const AClassName: string; out AForm: TComponent; const ACheckVisible: Boolean = False): Boolean; 576 | var 577 | I: Integer; 578 | begin 579 | Result := False; 580 | for I := 0 to Screen.FormCount - 1 do 581 | begin 582 | if (Screen.Forms[I].ClassName = AClassName) and (not ACheckVisible or Screen.Forms[I].Visible) then 583 | begin 584 | AForm := Screen.Forms[I]; 585 | Result := True; 586 | Break; 587 | end; 588 | end; 589 | end; 590 | 591 | class function TOTAHelper.FindComponentGlobal(const AComponentName: string; out AComponent: TComponent): Boolean; 592 | var 593 | I: Integer; 594 | begin 595 | Result := False; 596 | for I := 0 to Screen.FormCount - 1 do 597 | begin 598 | if FindComponentRecurse(Screen.Forms[I], AComponentName, AComponent) then 599 | begin 600 | Result := True; 601 | Break; 602 | end; 603 | end; 604 | if not Result then 605 | begin 606 | for I := 0 to Screen.DataModuleCount - 1 do 607 | begin 608 | if FindComponentRecurse(Screen.DataModules[I], AComponentName, AComponent) then 609 | begin 610 | Result := True; 611 | Break; 612 | end; 613 | end; 614 | end; 615 | end; 616 | 617 | class function TOTAHelper.FindComponentRecurse(const AParent: TComponent; const AComponentName: string; out AComponent: TComponent): Boolean; 618 | var 619 | I: Integer; 620 | begin 621 | AComponent := AParent.FindComponent(AComponentName); 622 | Result := AComponent <> nil; 623 | if not Result then 624 | begin 625 | for I := 0 to AParent.ComponentCount - 1 do 626 | begin 627 | if FindComponentRecurse(AParent.Components[I], AComponentName, AComponent) then 628 | begin 629 | Result := True; 630 | Break; 631 | end; 632 | end; 633 | end; 634 | end; 635 | 636 | class function TOTAHelper.FindMenu(const AParentItem: TMenuItem; const AMenuName: string; out AMenuItem: TMenuItem): Boolean; 637 | var 638 | I: Integer; 639 | begin 640 | Result := False; 641 | for I := 0 to AParentItem.Count - 1 do 642 | begin 643 | if SameText(AParentItem[I].Name, AMenuName) then 644 | begin 645 | AMenuItem := AParentItem[I]; 646 | Result := True; 647 | Break; 648 | end; 649 | end; 650 | end; 651 | 652 | class function TOTAHelper.FindMenuByCaption(const AParentItem: TMenuItem; const ACaption: string; out AMenuItem: TMenuItem): Boolean; 653 | var 654 | I: Integer; 655 | begin 656 | Result := False; 657 | for I := 0 to AParentItem.Count - 1 do 658 | begin 659 | if SameText(AParentItem[I].Caption, ACaption) or IsLike(AParentItem[I].Caption, ACaption) then 660 | begin 661 | AMenuItem := AParentItem[I]; 662 | Result := True; 663 | Break; 664 | end; 665 | end; 666 | end; 667 | 668 | class function TOTAHelper.FindMenuSeparatorIndex(const AParentItem: TMenuItem; const AAfterMenuName: string): Integer; 669 | var 670 | I: Integer; 671 | LFoundMenu: Boolean; 672 | begin 673 | Result := -1; 674 | LFoundMenu := False; 675 | for I := 0 to AParentItem.Count - 1 do 676 | begin 677 | if CompareText(AParentItem[I].Name, AAfterMenuName) = 0 then 678 | LFoundMenu := True 679 | else if LFoundMenu and (AParentItem[I].Caption = '-') then 680 | begin 681 | Result := I; 682 | Break; 683 | end; 684 | end; 685 | end; 686 | 687 | class function TOTAHelper.FindMenuSeparatorIndex(const AParentItem: TMenuItem; const AOccurence: Integer): Integer; 688 | var 689 | I, LCount: Integer; 690 | begin 691 | Result := -1; 692 | LCount := 0; 693 | for I := 0 to AParentItem.Count - 1 do 694 | begin 695 | if AParentItem[I].Caption = '-' then 696 | begin 697 | Inc(LCount); 698 | if LCount = AOccurence then 699 | begin 700 | Result := I; 701 | Break; 702 | end; 703 | end; 704 | end; 705 | end; 706 | 707 | class function TOTAHelper.FindToolsMenu(out AMenuItem: TMenuItem): Boolean; 708 | begin 709 | Result := FindTopMenu(cToolsMenuItemName, AMenuItem); 710 | end; 711 | 712 | class function TOTAHelper.FindToolsSubMenu(const AMenuName: string; out AMenuItem: TMenuItem): Boolean; 713 | var 714 | LToolsMenuItem: TMenuItem; 715 | begin 716 | Result := False; 717 | if FindToolsMenu(LToolsMenuItem) then 718 | Result := FindMenu(LToolsMenuItem, AMenuName, AMenuItem); 719 | end; 720 | 721 | class function TOTAHelper.FindTopEditView(const ASourceEditor: IOTASourceEditor; out AEditView: IOTAEditView): Boolean; 722 | begin 723 | Result := False; 724 | if (ASourceEditor <> nil) and (ASourceEditor.EditViewCount > 0) then 725 | begin 726 | AEditView := ASourceEditor.EditViews[0]; 727 | Result := True; 728 | end; 729 | end; 730 | 731 | class function TOTAHelper.FindTopMenu(const AMenuName: string; out AMenuItem: TMenuItem): Boolean; 732 | var 733 | LNTAServices: INTAServices; 734 | begin 735 | Result := False; 736 | LNTAServices := BorlandIDEServices as INTAServices; 737 | if (LNTAServices <> nil) and (LNTAServices.MainMenu <> nil) then 738 | Result := FindMenu(LNTAServices.MainMenu.Items, AMenuName, AMenuItem); 739 | end; 740 | 741 | class function TOTAHelper.GetProjectGroup: IOTAProjectGroup; 742 | var 743 | LModuleServices: IOTAModuleServices; 744 | I: integer; 745 | begin 746 | Result := nil; 747 | if BorlandIDEServices <> nil then 748 | begin 749 | LModuleServices := BorlandIDEServices as IOTAModuleServices; 750 | for I := 0 To LModuleServices.ModuleCount - 1 do 751 | begin 752 | if LModuleServices.Modules[I].QueryInterface(IOTAProjectGroup, Result) = S_OK Then 753 | Break; 754 | end; 755 | end; 756 | end; 757 | 758 | class function TOTAHelper.GetProjectCurrentMobileDeviceName(const AProject: IOTAProject): string; 759 | var 760 | LProfileName, LPlatform: string; 761 | LNode: IXMLNode; 762 | begin 763 | Result := ''; 764 | if AProject <> nil then 765 | begin 766 | LProfileName := GetProjectCurrentConnectionProfile(AProject); 767 | LPlatform := AProject.CurrentPlatform; 768 | if LProfileName.IsEmpty then 769 | LProfileName := 'NoProfile' 770 | else 771 | LProfileName := 'P' + LProfileName; 772 | LNode := (BorlandIDEServices as IOTAProjectFileStorage).GetProjectStorageNode(AProject, 'ActiveMobileDevice', True); 773 | if LNode <> nil then 774 | begin 775 | LNode := LNode.ChildNodes.FindNode(LProfileName); 776 | if (LNode <> nil) and LNode.HasAttribute(LPlatform) then 777 | Result := LNode.Attributes[LPlatform]; 778 | end; 779 | end; 780 | end; 781 | 782 | class function TOTAHelper.GetActiveProject: IOTAProject; 783 | var 784 | LGroup: IOTAProjectGroup; 785 | begin 786 | Result := nil; 787 | LGroup := TOTAHelper.GetProjectGroup; 788 | if LGroup <> nil then 789 | Result := LGroup.ActiveProject; 790 | end; 791 | 792 | class function TOTAHelper.GetActiveProjectBuildPath: string; 793 | var 794 | LProject: IOTAProject; 795 | LProjectName: string; 796 | begin 797 | Result := ''; 798 | LProject := TOTAHelper.GetActiveProject; 799 | if LProject <> nil then 800 | begin 801 | LProjectName := TOTAHelper.GetProjectActiveBuildConfigurationValue(LProject, sSanitizedProjectName); 802 | Result := TPath.Combine(TOTAHelper.GetProjectOutputDir(LProject), LProjectName); 803 | end; 804 | end; 805 | 806 | class function TOTAHelper.GetActiveProjectSanitizedProjectName: string; 807 | var 808 | LProject: IOTAProject; 809 | begin 810 | Result := ''; 811 | LProject := TOTAHelper.GetActiveProject; 812 | if LProject <> nil then 813 | Result := TOTAHelper.GetProjectActiveBuildConfigurationValue(LProject, sSanitizedProjectName); 814 | end; 815 | 816 | class function TOTAHelper.GetActiveProjectFileName: string; 817 | var 818 | LProject: IOTAProject; 819 | begin 820 | Result := ''; 821 | LProject := TOTAHelper.GetActiveProject; 822 | if LProject <> nil then 823 | Result := LProject.FileName; 824 | end; 825 | 826 | class function TOTAHelper.GetProjectCurrentConnectionProfile(const AProject: IOTAProject): string; 827 | var 828 | LPlatforms: IOTAProjectPlatforms; 829 | begin 830 | Result := ''; 831 | if Supports(AProject, IOTAProjectPlatforms, LPlatforms) then 832 | Result := LPlatforms.GetProfile(AProject.CurrentPlatform); 833 | end; 834 | 835 | class function TOTAHelper.HasBuildEvents(const AProject: IOTAProject): Boolean; 836 | var 837 | LProvider: IOTABuildEventProvider; 838 | LProjectOptionsConfigs: IOTAProjectOptionsConfigurations; 839 | LPlatforms: IOTAProjectPlatforms; 840 | LPlatformConfig: IOTABuildConfiguration; 841 | LSupportedPlatform: string; 842 | I: Integer; 843 | begin 844 | Result := False; 845 | if Supports(AProject, IOTABuildEventProvider, LProvider) and Supports(AProject, IOTAProjectPlatforms, LPlatforms) then 846 | begin 847 | LProjectOptionsConfigs := GetProjectOptionsConfigurations(AProject); 848 | for LSupportedPlatform in LPlatforms.SupportedPlatforms do 849 | begin 850 | for I := 0 to LProjectOptionsConfigs.ConfigurationCount - 1 do 851 | begin 852 | LPlatformConfig := LProjectOptionsConfigs.Configurations[I].PlatformConfiguration[LSupportedPlatform]; 853 | if (LPlatformConfig <> nil) and LProvider.HasBuildEvents(LPlatformConfig.Name, LPlatformConfig.Platform) then 854 | begin 855 | Result := True; 856 | Break; 857 | end; 858 | end; 859 | end; 860 | end; 861 | end; 862 | 863 | class procedure TOTAHelper.SetProjectOutputToBase(const AProject: IOTAProject; const AOutputPath: string; const ADCUPath: string = ''); 864 | var 865 | LConfigs: IOTAProjectOptionsConfigurations; 866 | I: Integer; 867 | LConfig: IOTABuildConfiguration; 868 | begin 869 | LConfigs := GetProjectOptionsConfigurations(AProject); 870 | for I := 0 to LConfigs.ConfigurationCount - 1 do 871 | begin 872 | LConfig := LConfigs.Configurations[I]; 873 | if LConfig.Platform.IsEmpty and LConfig.Name.Equals('Base') then 874 | begin 875 | LConfig.Value[sExeOutput] := AOutputPath; 876 | if ADCUPath.IsEmpty then 877 | LConfig.Value[sDcuOutput] := AOutputPath 878 | else 879 | LConfig.Value[sDcuOutput] := ADCUPath; 880 | end; 881 | if MatchStr(LConfig.Platform, AProject.SupportedPlatforms) then 882 | begin 883 | LConfig.Value[sExeOutput] := ''; 884 | LConfig.Value[sDcuOutput] := ''; 885 | end; 886 | end; 887 | AProject.MarkModified; 888 | end; 889 | 890 | class procedure TOTAHelper.ResetProjectSearchPathToBase(const AProject: IOTAProject; const AExcludePlatforms: TArray = []); 891 | var 892 | LConfigs: IOTAProjectOptionsConfigurations; 893 | I: Integer; 894 | LConfig: IOTABuildConfiguration; 895 | LSearchPath: string; 896 | begin 897 | LSearchPath := ''; 898 | LConfigs := GetProjectOptionsConfigurations(AProject); 899 | for I := 0 to LConfigs.ConfigurationCount - 1 do 900 | begin 901 | LConfig := LConfigs.Configurations[I]; 902 | if LConfig.Platform.IsEmpty and LConfig.Name.Equals('Base') then 903 | LSearchPath := LConfig.Value[sUnitSearchPath]; 904 | end; 905 | if not LSearchPath.IsEmpty then 906 | begin 907 | for I := 0 to LConfigs.ConfigurationCount - 1 do 908 | begin 909 | LConfig := LConfigs.Configurations[I]; 910 | if MatchStr(LConfig.Platform, AProject.SupportedPlatforms) and not MatchStr(LConfig.Platform, AExcludePlatforms) then 911 | LConfig.Value[sUnitSearchPath] := LSearchPath; 912 | end; 913 | AProject.MarkModified; 914 | end; 915 | end; 916 | 917 | class procedure TOTAHelper.SetProjectSDKVersion(const AProject: IOTAProject; const APlatform, ASDKVersion: string); 918 | var 919 | LPlatforms: IOTAProjectPlatforms; 920 | begin 921 | if Supports(AProject, IOTAProjectPlatforms, LPlatforms) then 922 | LPlatforms.SetSDKVersion(APlatform, ASDKVersion); 923 | end; 924 | 925 | class function TOTAHelper.GetProjectDeployedFileName(const AProject: IOTAProject): string; 926 | var 927 | LFileName: string; 928 | begin 929 | Result := ''; 930 | LFileName := AProject.ProjectOptions.TargetName; 931 | case GetProjectCurrentPlatform(AProject) of 932 | TProjectPlatform.macOS32, TProjectPlatform.macOS64, TProjectPlatform.macOSArm64: 933 | Result := TPath.GetFileName(LFileName + '.app'); 934 | TProjectPlatform.iOSDevice32, TProjectPlatform.iOSDevice64: 935 | Result := TPath.GetFileName(LFileName + '.ipa'); 936 | else 937 | Result := LFileName; 938 | end; 939 | end; 940 | 941 | class function TOTAHelper.GetProjectDeployedPath(const AProject: IOTAProject): string; 942 | var 943 | LFileName: string; 944 | begin 945 | LFileName := AProject.ProjectOptions.TargetName; 946 | Result := LFileName.Substring(0, LFileName.LastIndexOf('\')); 947 | end; 948 | 949 | class function TOTAHelper.GetActiveProjectOptions: IOTAProjectOptions; 950 | var 951 | LProject: IOTAProject; 952 | begin 953 | Result := nil; 954 | LProject := TOTAHelper.GetActiveProject; 955 | if LProject <> nil then 956 | Result := LProject.ProjectOptions; 957 | end; 958 | 959 | class function TOTAHelper.GetProjectActiveBuildConfiguration(const AProject: IOTAProject): IOTABuildConfiguration; 960 | var 961 | LConfigs: IOTAProjectOptionsConfigurations; 962 | begin 963 | Result := nil; 964 | if AProject <> nil then 965 | begin 966 | LConfigs := GetProjectOptionsConfigurations(AProject); 967 | if LConfigs <> nil then 968 | Result := LConfigs.ActiveConfiguration; 969 | end; 970 | end; 971 | 972 | class function TOTAHelper.GetProjectActiveBuildConfigurationValue(const AProject: IOTAProject; const AKey: string): string; 973 | var 974 | LConfig: IOTABuildConfiguration; 975 | begin 976 | Result := ''; 977 | LConfig := GetProjectActiveBuildConfiguration(AProject); 978 | if LConfig <> nil then 979 | Result := LConfig.Value[AKey]; 980 | end; 981 | 982 | class function TOTAHelper.GetProjectOptionsConfigurations(const AProject: IOTAProject): IOTAProjectOptionsConfigurations; 983 | var 984 | LProjectOptions: IOTAProjectOptions; 985 | begin 986 | Result := nil; 987 | if AProject <> nil then 988 | begin 989 | LProjectOptions := AProject.ProjectOptions; 990 | if LProjectOptions <> nil then 991 | Supports(LProjectOptions, IOTAProjectOptionsConfigurations, Result); 992 | end; 993 | end; 994 | 995 | class function TOTAHelper.GetActiveProjectOptionsConfigurations: IOTAProjectOptionsConfigurations; 996 | begin 997 | Result := GetProjectOptionsConfigurations(TOTAHelper.GetActiveProject); 998 | end; 999 | 1000 | class function TOTAHelper.GetProjectCurrentBuildType(const AProject: IOTAProject): string; 1001 | var 1002 | LConfigs: IOTAProjectOptionsConfigurations; 1003 | LPlatform: TProjectPlatform; 1004 | begin 1005 | Result := ''; 1006 | LConfigs := TOTAHelper.GetProjectOptionsConfigurations(AProject); 1007 | if (LConfigs <> nil) and (LConfigs.ActiveConfiguration <> nil) then 1008 | begin 1009 | Result := LConfigs.ActiveConfiguration.Value[sBT_BuildType]; 1010 | if Result.Equals('Debug') then 1011 | begin 1012 | LPlatform := TOTAHelper.GetProjectCurrentPlatform(AProject); 1013 | Result := cProjectPlatformDefaultBuildType[LPlatform]; 1014 | end; 1015 | end; 1016 | end; 1017 | 1018 | class function TOTAHelper.ExpandConfiguration(const ASource: string; const AConfig: IOTABuildConfiguration): string; 1019 | begin 1020 | Result := StringReplace(ASource, '$(Platform)', AConfig.Platform, [rfReplaceAll, rfIgnoreCase]); 1021 | Result := StringReplace(Result, '$(Config)', AConfig.Name, [rfReplaceAll, rfIgnoreCase]); 1022 | end; 1023 | 1024 | class function TOTAHelper.ExpandProjectActiveConfiguration(const ASource: string; const AProject: IOTAProject): string; 1025 | var 1026 | LConfigs: IOTAProjectOptionsConfigurations; 1027 | begin 1028 | Result := ASource; 1029 | LConfigs := TOTAHelper.GetProjectOptionsConfigurations(AProject); 1030 | if (LConfigs <> nil) and (LConfigs.ActiveConfiguration <> nil) then 1031 | Result := ExpandConfiguration(Result, LConfigs.ActiveConfiguration); 1032 | end; 1033 | 1034 | class function TOTAHelper.GetProjectConfigurationNames(const AProject: IOTAProject): TArray; 1035 | var 1036 | LProjectOptions: IOTAProjectOptions; 1037 | LConfigs: IOTAProjectOptionsConfigurations; 1038 | I: Integer; 1039 | begin 1040 | Result := []; 1041 | LProjectOptions := AProject.ProjectOptions; 1042 | if (LProjectOptions <> nil) and Supports(LProjectOptions, IOTAProjectOptionsConfigurations, LConfigs) then 1043 | begin 1044 | for I := 0 to LConfigs.ConfigurationCount - 1 do 1045 | Result := Result + [LConfigs.Configurations[I].Name]; 1046 | end; 1047 | end; 1048 | 1049 | class function TOTAHelper.ExpandOutputDir(const ASource: string): string; 1050 | begin 1051 | Result := ExpandVars(ExpandProjectActiveConfiguration(ASource, GetActiveProject)); 1052 | end; 1053 | 1054 | class procedure TOTAHelper.ExpandPaths(const APaths: TStrings; const AProject: IOTAProject = nil); 1055 | var 1056 | LExpanded, LProjectPath: string; 1057 | I: Integer; 1058 | begin 1059 | LExpanded := ExpandVars(APaths.Text); 1060 | if AProject <> nil then 1061 | LExpanded := ExpandProjectActiveConfiguration(LExpanded, AProject); 1062 | APaths.Text := LExpanded; 1063 | LProjectPath := TPath.GetDirectoryName(AProject.FileName); 1064 | for I := 0 to APaths.Count - 1 do 1065 | APaths[I] := ExpandPath(LProjectPath, APaths[I]); 1066 | end; 1067 | 1068 | class function TOTAHelper.ExpandVars(const ASource: string): string; 1069 | var 1070 | LVars: TStrings; 1071 | I: Integer; 1072 | begin 1073 | Result := ASource; 1074 | LVars := TStringList.Create; 1075 | try 1076 | GetEnvironmentVars(LVars, True); 1077 | for I := 0 to LVars.Count - 1 do 1078 | begin 1079 | Result := StringReplace(Result, '$(' + LVars.Names[i] + ')', LVars.Values[LVars.Names[i]], [rfReplaceAll, rfIgnoreCase]); 1080 | Result := StringReplace(Result, '%' + LVars.Names[i] + '%', LVars.Values[LVars.Names[i]], [rfReplaceAll, rfIgnoreCase]); 1081 | end; 1082 | finally 1083 | LVars.Free; 1084 | end; 1085 | end; 1086 | 1087 | class function TOTAHelper.GetProjectPath(const AProject: IOTAProject): string; 1088 | begin 1089 | Result := TPath.GetDirectoryName(AProject.FileName); 1090 | end; 1091 | 1092 | class function TOTAHelper.GetProjectOutputDir(const AProject: IOTAProject): string; 1093 | var 1094 | LOptions: IOTAProjectOptions; 1095 | LOutputDir: string; 1096 | begin 1097 | Result := GetProjectPath(AProject); 1098 | LOptions := AProject.ProjectOptions; 1099 | if LOptions <> nil then 1100 | begin 1101 | LOutputDir := LOptions.Values[cProjectOptionOutputDir]; 1102 | Result := TOTAHelper.ExpandOutputDir(ExpandPath(Result, LOutputDir)); 1103 | end; 1104 | end; 1105 | 1106 | class function TOTAHelper.GetRegKey: string; 1107 | begin 1108 | Result := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey; 1109 | end; 1110 | 1111 | class function TOTAHelper.GetRemoteProfile(const APlatform, AProfileName: string): IOTARemoteProfile; 1112 | var 1113 | LServices: IOTARemoteProfileServices; 1114 | LProfile: IOTARemoteProfile; 1115 | I: Integer; 1116 | begin 1117 | Result := nil; 1118 | LServices := BorlandIDEServices as IOTARemoteProfileServices; 1119 | for I := 0 to LServices.GetProfileCount(APlatform) - 1 do 1120 | begin 1121 | LProfile := LServices.GetProfile(APlatform, I); 1122 | if LProfile.Name.Equals(AProfileName) then 1123 | Exit(LProfile); 1124 | end; 1125 | end; 1126 | 1127 | class function TOTAHelper.IsIDEClosing: Boolean; 1128 | var 1129 | LMainForm: TComponent; 1130 | begin 1131 | LMainForm := GetMainForm; 1132 | Result := Application.Terminated or (LMainForm = nil) or not TForm(LMainForm).Visible or (csDestroying in LMainForm.ComponentState); 1133 | end; 1134 | 1135 | class function TOTAHelper.IsIOSPlatform(const APlatform: string): Boolean; 1136 | begin 1137 | Result := APlatform.Equals(ciOSDevice32Platform) or APlatform.Equals(ciOSDevice64Platform) or APlatform.Equals(ciOSSimulator32Platform); 1138 | end; 1139 | 1140 | class function TOTAHelper.IsMacOSPlatform(const APlatform: string): Boolean; 1141 | begin 1142 | Result := APlatform.Equals(ciOSDevice32Platform) or APlatform.Equals(ciOSDevice64Platform) or APlatform.Equals(ciOSSimulator32Platform) 1143 | or APlatform.Equals(cOSX32Platform) or APlatform.Equals(cOSX64Platform); 1144 | end; 1145 | 1146 | class function TOTAHelper.IsMatchingProfilePlatform(const APlatform, AProfilePlatform: string): Boolean; 1147 | begin 1148 | Result := False; 1149 | if AProfilePlatform.Equals(cOSX32Platform) or AProfilePlatform.Equals(cOSX64Platform) then 1150 | begin 1151 | Result := APlatform.Equals(ciOSDevice32Platform) or APlatform.Equals(ciOSDevice64Platform) or APlatform.Equals(ciOSSimulator32Platform) 1152 | or APlatform.Equals(cOSX32Platform) or APlatform.Equals(cOSX64Platform) 1153 | end 1154 | else if AProfilePlatform.Equals(cLinux64Platform) then 1155 | Result := APlatform.Equals(cLinux64Platform); 1156 | end; 1157 | 1158 | class function TOTAHelper.OpenFile(const AFilename: string): Boolean; 1159 | var 1160 | LActionServices: IOTAActionServices; 1161 | begin 1162 | LActionServices := BorlandIDEServices as IOTAActionServices; 1163 | if AFilename.EndsWith('.dproj') then 1164 | Result := LActionServices.OpenProject(AFilename, True) 1165 | else 1166 | Result := LActionServices.OpenFile(AFilename); 1167 | end; 1168 | 1169 | class procedure TOTAHelper.ApplyTheme(const AComponent: TComponent); 1170 | var 1171 | LServices: IOTAIDEThemingServices; 1172 | begin 1173 | LServices := BorlandIDEServices as IOTAIDEThemingServices; 1174 | if AComponent is TCustomForm then 1175 | LServices.RegisterFormClass(TCustomFormClass(AComponent.ClassType)); 1176 | LServices.ApplyTheme(AComponent); 1177 | end; 1178 | 1179 | class procedure TOTAHelper.CloseCurrentModule; 1180 | var 1181 | LModule: IOTAModule; 1182 | begin 1183 | LModule := (BorlandIDEServices as IOTAModuleServices).CurrentModule; 1184 | if LModule <> nil then 1185 | LModule.Close; 1186 | end; 1187 | 1188 | class procedure TOTAHelper.MarkActiveProjectModified; 1189 | var 1190 | LProject: IOTAProject; 1191 | begin 1192 | LProject := GetActiveProject; 1193 | if LProject <> nil then 1194 | LProject.MarkModified; 1195 | end; 1196 | 1197 | class procedure TOTAHelper.MarkCurrentModuleModified; 1198 | var 1199 | LModule: IOTAModule; 1200 | begin 1201 | LModule := (BorlandIDEServices as IOTAModuleServices).CurrentModule; 1202 | if LModule <> nil then 1203 | LModule.MarkModified; 1204 | end; 1205 | 1206 | class procedure TOTAHelper.RefreshProjectTree; 1207 | var 1208 | LForm: TComponent; 1209 | LControl: TControl; 1210 | begin 1211 | if FindForm('ProjectManagerForm', LForm) then 1212 | begin 1213 | LControl := TControl(LForm.FindComponent('ProjectTree2')); 1214 | if LControl <> nil then 1215 | LControl.Invalidate; 1216 | end; 1217 | end; 1218 | 1219 | class procedure TOTAHelper.RegisterThemeForms(const AFormClasses: array of TCustomFormClass); 1220 | var 1221 | LFormClass: TCustomFormClass; 1222 | begin 1223 | for LFormClass in AFormClasses do 1224 | begin 1225 | {$IF CompilerVersion < 34} 1226 | (BorlandIDEServices as IOTAIDEThemingServices250).RegisterFormClass(LFormClass); 1227 | {$ELSE} 1228 | (BorlandIDEServices as IOTAIDEThemingServices).RegisterFormClass(LFormClass); 1229 | {$ENDIF} 1230 | end; 1231 | end; 1232 | 1233 | class function TOTAHelper.GetActiveProjectOutputDir: string; 1234 | var 1235 | LProject: IOTAProject; 1236 | begin 1237 | Result := ''; 1238 | LProject := TOTAHelper.GetActiveProject; 1239 | if LProject <> nil then 1240 | Result := TOTAHelper.GetProjectOutputDir(LProject); 1241 | end; 1242 | 1243 | class function TOTAHelper.GetActiveProjectPath: string; 1244 | var 1245 | LProject: IOTAProject; 1246 | begin 1247 | Result := ''; 1248 | LProject := TOTAHelper.GetActiveProject; 1249 | if LProject <> nil then 1250 | Result := TOTAHelper.GetProjectPath(LProject); 1251 | end; 1252 | 1253 | class function TOTAHelper.GetActiveSourceEditor: IOTASourceEditor; 1254 | begin 1255 | Result := GetSourceEditor((BorlandIDEServices as IOTAModuleServices).CurrentModule); 1256 | end; 1257 | 1258 | class function TOTAHelper.GetActiveSourceEditorFileName: string; 1259 | var 1260 | LEditor: IOTASourceEditor; 1261 | begin 1262 | Result := ''; 1263 | LEditor := GetActiveSourceEditor; 1264 | if LEditor <> nil then 1265 | Result := LEditor.FileName; 1266 | end; 1267 | 1268 | class function TOTAHelper.GetCurrentModule: IOTAModule; 1269 | begin 1270 | Result := (BorlandIDEServices as IOTAModuleServices).CurrentModule; 1271 | end; 1272 | 1273 | class function TOTAHelper.GetCurrentSelectedProject: IOTAProject; 1274 | var 1275 | LIdent: string; 1276 | begin 1277 | Result := (BorlandIDEServices as IOTAProjectManager).GetCurrentSelection(LIdent); 1278 | end; 1279 | 1280 | class function TOTAHelper.GetSourceEditor(const AModule: IOTAModule): IOTASourceEditor; 1281 | var 1282 | I: Integer; 1283 | begin 1284 | Result := nil; 1285 | if AModule <> nil then 1286 | begin 1287 | for I := 0 To AModule.GetModuleFileCount - 1 do 1288 | begin 1289 | if AModule.GetModuleFileEditor(I).QueryInterface(IOTASourceEditor, Result) = S_OK then 1290 | Break; 1291 | end; 1292 | end; 1293 | end; 1294 | 1295 | class function TOTAHelper.GetSourceEditorText(const ASourceEditor: IOTASourceEditor): string; 1296 | const 1297 | cBufferSize = 1024; 1298 | var 1299 | LReader: IOTAEditReader; 1300 | LPosition, LRead: Integer; 1301 | LBuffer: AnsiString; 1302 | begin 1303 | Result := ''; 1304 | if ASourceEditor <> nil then 1305 | begin 1306 | LReader := ASourceEditor.CreateReader; 1307 | try 1308 | LPosition := 0; 1309 | repeat 1310 | SetLength(LBuffer, cBufferSize); 1311 | LRead := LReader.GetText(LPosition, PAnsiChar(LBuffer), cBufferSize); 1312 | SetLength(LBuffer, LRead); 1313 | Result := Result + string(LBuffer); 1314 | Inc(LPosition, LRead); 1315 | until LRead < cBufferSize; 1316 | finally 1317 | LReader := nil; 1318 | end; 1319 | end; 1320 | end; 1321 | 1322 | class function TOTAHelper.GetVerInfoValue(const AVerInfo, AKey: string): string; 1323 | var 1324 | LPair: TArray; 1325 | LString: string; 1326 | begin 1327 | Result := ''; 1328 | for LString in AVerInfo.Split([';']) do 1329 | begin 1330 | LPair := LString.Split(['=']); 1331 | if (Length(LPair) = 2) and SameText(AKey, LPair[0]) then 1332 | begin 1333 | Result := LPair[1]; 1334 | Break; 1335 | end; 1336 | end; 1337 | end; 1338 | 1339 | class function TOTAHelper.GetProjectPlatform(const APlatform: string): TProjectPlatform; 1340 | var 1341 | LPlatform: TProjectPlatform; 1342 | begin 1343 | if SameText(APlatform, 'Android') then 1344 | Result := TProjectPlatform.Android32 1345 | else 1346 | begin 1347 | Result := TProjectPlatform(-1); 1348 | for LPlatform := Low(TProjectPlatform) to High(TProjectPlatform) do 1349 | begin 1350 | if SameText(APlatform, cProjectPlatforms[LPlatform]) then 1351 | begin 1352 | Result := LPlatform; 1353 | Break; 1354 | end; 1355 | end; 1356 | end; 1357 | end; 1358 | 1359 | class function TOTAHelper.GetProjectSupportedPlatforms(const AProject: IOTAProject): TProjectPlatforms; 1360 | var 1361 | LProjectPlatform: TProjectPlatform; 1362 | LPlatform: string; 1363 | begin 1364 | Result := []; 1365 | if AProject <> nil then 1366 | begin 1367 | for LPlatform in AProject.SupportedPlatforms do 1368 | begin 1369 | LProjectPlatform := GetProjectPlatform(LPlatform); 1370 | if LProjectPlatform <> TProjectPlatform(-1) then 1371 | Include(Result, LProjectPlatform); 1372 | end; 1373 | end; 1374 | end; 1375 | 1376 | class function TOTAHelper.GetProjectCurrentSDKVersion(const AProject: IOTAProject): string; 1377 | var 1378 | LPlatforms: IOTAProjectPlatforms; 1379 | begin 1380 | Result := ''; 1381 | if (AProject <> nil) and Supports(AProject, IOTAProjectPlatforms, LPlatforms) then 1382 | Result := LPlatforms.PlatformSDK[AProject.CurrentPlatform]; 1383 | end; 1384 | 1385 | class function TOTAHelper.GetProjectCurrentPlatform(const AProject: IOTAProject): TProjectPlatform; 1386 | begin 1387 | Result := TProjectPlatform(-1); 1388 | if AProject <> nil then 1389 | Result := GetProjectPlatform(AProject.CurrentPlatform); 1390 | end; 1391 | 1392 | class procedure TOTAHelper.GetProjectActiveEffectivePaths(const AProject: IOTAProject; const APaths: TStrings; const ABase: Boolean = False); 1393 | var 1394 | LProjectOptionsConfigs: IOTAProjectOptionsConfigurations; 1395 | LBuildConfig: IOTABuildConfiguration; 1396 | begin 1397 | LProjectOptionsConfigs := GetProjectOptionsConfigurations(AProject); 1398 | if ABase then 1399 | LBuildConfig := LProjectOptionsConfigs.BaseConfiguration 1400 | else 1401 | LBuildConfig := LProjectOptionsConfigs.ActiveConfiguration; 1402 | LBuildConfig.GetValues(sUnitSearchPath, APaths, True); 1403 | APaths.Insert(0, TPath.GetDirectoryName(AProject.FileName)); 1404 | end; 1405 | 1406 | class function TOTAHelper.GetProjectBuildFileName(const AProject: IOTAProject; const AFileName: string): string; 1407 | begin 1408 | Result := TPath.Combine(GetProjectPath(AProject), AFileName); 1409 | end; 1410 | 1411 | class function TOTAHelper.GetEnvironmentOptions: IOTAEnvironmentOptions; 1412 | begin 1413 | Result := (BorlandIDEServices as IOTAServices).GetEnvironmentOptions; 1414 | end; 1415 | 1416 | class function TOTAHelper.GetMainForm: TComponent; 1417 | begin 1418 | Result := Application.FindComponent('AppBuilder'); 1419 | end; 1420 | 1421 | end. 1422 | --------------------------------------------------------------------------------