unit uDAIDEMenu; {----------------------------------------------------------------------------} { Data Abstract Library - IDE Library { { compiler: Delphi 6 and up, Kylix 3 and up { platform: Win32, Linux { { (c)opyright RemObjects Software. all rights reserved. { { Using this code requires a valid license of the Data Abstract { which can be obtained at http://www.remobjects.com. {----------------------------------------------------------------------------} {$IFDEF MSWINDOWS} {$I ..\DataAbstract.inc} {$ENDIF MSWINDOWS} {$IFDEF LINUX} {$I ../DataAbstract.inc} {$ENDIF LINUX} interface uses Forms, Classes, Windows, SysUtils,{$IFDEF DELPHI6UP}DesignEditors, DesignIntf, {$ELSE} {$IFDEF LINUX} DesignEditors, DesignIntf, {$ELSE} DsgnIntf,{$ENDIF}{$ENDIF} ToolsApi, Menus, Contnrs, ComObj, Graphics; type { TMenuItemInfo } TMenuItemInfo = record Caption, ShortCut : string; Menu:TMenuItem; ImageIndex:integer; end; const MAX_MENU_ITEM = 0; var MenuItems : array[0..MAX_MENU_ITEM] of TMenuItemInfo = ( //(Caption: '-'; ShortCut: ''; Menu:nil; ImageIndex: -1), (Caption: 'Schema &Modeler'; ShortCut: ''; Menu:nil; ImageIndex: 0) ); const mi_SchemaModeler = 0; type { TDAMenuWizard } TDAMenuWizard = class(TInterfacedObject, IOTAWizard, IOTANotifier) private fDAMenuItems : TList; protected { Misc } procedure CreateMenuItems; procedure LaunchSchemaModeler(Sender : TObject); function FindROMenu : TMenuItem; { IOTANotifier} procedure AfterSave; procedure BeforeSave; procedure Destroyed; procedure Execute; procedure Modified; { IOTAWizard } function GetState: TWizardState; function GetIDString: string; function GetName: string; public constructor Create; destructor Destroy; override; end; function GetSchemaModelerPath: string; function GetDllPath: String; function GetBinDir: string; procedure LaunchSchemaModeler(const aProjectName, someParams : string; aWait: boolean=false); procedure Register; implementation uses ShellAPI, Controls, Registry, Dialogs, uRODL, uROIDETools, uRODLToXML, uRODLToPascalIntf, uRODLGenTools, uRORODLNotifier, uROPleaseWaitForm, uDAIDEData, fROAbout, fCustomIDEMessagesForm, uROProductVersionInfo, uROClasses, uROIDEMenu; {$R Resources.BDS.res} procedure RegisterAboutInfo; const lProductName = 'RemObjects Data Abstract ''Vinci'' for Delphi'; begin {$IFDEF BDS} {$IFDEF BDS3} SplashScreenServices.AddPluginBitmap(, LoadBitmap(HInstance, 'SPLASH2005')); {$ELSE} if (BorlandIDEServices as IOTAServices).GetProductIdentifier = 'CodeGear Delphi for Microsoft Windows' then SplashScreenServices.AddPluginBitmap(lProductName, LoadBitmap(HInstance, 'SPLASH2007')) else SplashScreenServices.AddPluginBitmap(lProductName, LoadBitmap(HInstance, 'SPLASH2006')); {$ENDIF} (BorlandIDEServices as IOTAAboutBoxServices).AddPluginInfo(lProductName, lProductName+#13#10'Copyright RemObjects Software 2002-2007.'#13#10'All rights reserved.'#13#10'http://www.remobjects.com/da.', LoadBitmap(HInstance, 'ABOUT')); {$ENDIF BDS} end; procedure Register; begin RegisterAboutInfo(); RegisterPackageWizard(TDAMenuWizard.Create); end; { TDAMenuWizard } constructor TDAMenuWizard.Create; begin inherited Create; fDAMenuItems := TList.Create; CreateMenuItems; end; destructor TDAMenuWizard.Destroy; var romenu : TMenuItem; i, x : integer; begin romenu := FindROMenu; if (romenu<>NIL) then begin for i := (romenu.Count-1) downto 0 do begin for x := (fDAMenuItems.Count-1) downto 0 do if (romenu.Items[i]=fDAMenuItems[x]) then begin TObject(fDAMenuItems[x]).Free; Break; end; end; end; fDAMenuItems.Free; end; function TDAMenuWizard.GetIDString: string; begin Result := '{FE46996E-0AFA-4C8D-AF59-192F1D581FD1}' end; function TDAMenuWizard.GetName: string; begin Result := 'DAMenuWizard'; end; // The following are stubs that Delphi never calls. procedure TDAMenuWizard.AfterSave; begin end; procedure TDAMenuWizard.BeforeSave; begin end; procedure TDAMenuWizard.Destroyed; begin end; procedure TDAMenuWizard.Execute; begin end; function TDAMenuWizard.GetState: TWizardState; begin Result := []; end; procedure TDAMenuWizard.Modified; begin end; function TDAMenuWizard.FindROMenu: TMenuItem; {var mainmenu : TMainMenu; i : integer;} begin result := gRemObjectsMenu; {result := NIL; mainmenu := (BorlandIDEServices as INTAServices).MainMenu; for i := 0 to (mainmenu.Items.Count-1) do if SameText('Rem&Objects', mainmenu.Items[i].Caption) then begin result := mainmenu.Items[i]; Break; end;} end; procedure TDAMenuWizard.CreateMenuItems; var romenu, item : TMenuItem; i : Integer; lBitmap : TBitmap; begin romenu := FindROMenu; if (romenu=NIL) then Exit; with TDAIdeData.Create(nil) do try lBitmap := TBitmap.Create(); try for i := 0 to High(MenuItems) do begin item := TMenuItem.Create(romenu); item.Caption := MenuItems[i].Caption; item.ShortCut := TextToShortCut(MenuItems[i].ShortCut); item.Tag := i; fDAMenuItems.Add(item); if MenuItems[i].ImageIndex > -1 then begin iml_Actions.GetBitmap(MenuItems[i].ImageIndex,lBitmap); item.ImageIndex := (BorlandIDEServices as INTAServices).AddMasked(lBitmap, clFuchsia); end; MenuItems[i].Menu := item; case i of mi_SchemaModeler : item.OnClick := LaunchSchemaModeler; else item.OnClick := NIL; end; romenu.Insert(6+i, item);// Add(item); end; finally lBitmap.Free(); end; finally Free(); end; end; function GetDllPath: String; var TheFileName : array[0..MAX_PATH] of char; begin FillChar(TheFileName, SizeOf(TheFileName), #0); {$IFDEF KYLIX}System.{$ENDIF}GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName)); Result := ExtractFilePath(TheFileName); end; function GetBinDir: string; begin // This function strips the "DCU\Dx" part of the path where the BPL is result := ExtractFilePath(GetDllPath); {$IFDEF DELPHI10UP} result := IncludeTrailingBackslash(Copy(result,1,Length(result)-8))+'Bin\'; {$ELSE} result := IncludeTrailingBackslash(Copy(result,1,Length(result)-7))+'Bin\'; {$ENDIF} end; function GetSchemaModelerPath: string; var reg: TRegIniFile; begin reg := TRegIniFile.Create('Software\RemObjects\Data Abstract'); try result := reg.ReadString('Schema Modeler', 'FullPath', GetBinDir+'DASchemaModeler.exe'); finally reg.Free; end; end; procedure LaunchSchemaModeler(const aProjectName, someParams : string; aWait: boolean=false); var exename : string; begin exename := GetSchemaModelerPath; if not FileExists(exename) then MessageDlg(Format('Cannot find "%s"', [exename]), mtError, [mbOK], 0) else begin if aWait then begin ExecuteAndWait(exename, someParams); end else begin ShellExecute(0, 'open', PChar(exename), PChar(someParams), PChar(ExtractFilePath(aProjectName)), SW_NORMAL); end; end; end; procedure TDAMenuWizard.LaunchSchemaModeler(Sender: TObject); begin uDAIDEMenu.LaunchSchemaModeler('', '/ns /platform:Delphi'); end; end.