Componentes.Terceros.RemObjects/internal/5.0.23.613/1/Data Abstract for Delphi/Source/IDE/uDAIDEMenu.pas

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.