{*******************************************************}
{                                                       }
{       ZaphodsMap                                      }
{       Design Time Project Options                     }
{       (Language: English)                             }
{                                                       }
{       Developed by HREF Tools Corp. 2005-2011         }
{                                                       }
{       v1.041                                          }
{*******************************************************}

unit ZaphodDTProjectOptions;

interface

uses
  Classes,
  DesignIntf,
  ZaphodProjectOptions;

type
  TZaphodProjectOptions = class(TInterfacedObject, IZaphodProjectOptions,
    IDesignNotification)
  private
    procedure ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent);
    procedure ItemInserted(const ADesigner: IDesigner; AItem: TPersistent);
    procedure ItemsModified(const ADesigner: IDesigner);
    procedure SelectionChanged(const ADesigner: IDesigner;
      const ASelection: IDesignerSelections);
    procedure DesignerOpened(const ADesigner: IDesigner;
      AResurrecting: Boolean);
    procedure DesignerClosed(const ADesigner: IDesigner;
      AGoingDormant: Boolean);
  public
    function GetProjectOption(RootComponent: TComponent;
      OptionName: string): string;
    procedure GetProjectOptions(RootComponent: TComponent; Options: TStrings);
    function GetProjectOutputDir(RootComponent: TComponent): string;
    function GetPackageDLLOutputDir(RootComponent: TComponent): string;
    function GetPackageDCPOutputDir(RootComponent: TComponent): string;
    function GetProjectFileName(RootComponent: TComponent): string;
    function ProjectIsPackage(RootComponent: TComponent): Boolean;
    function ProjectIsALibrary(RootComponent: TComponent): Boolean;
  end;

procedure RegisterZaphodDTProjectOptions;
procedure UnregisterZaphodDTProjectOptions;

implementation

uses
  SysUtils,
{$IFDEF CLR}
  Borland.Studio.ToolsAPI, Variants,
{$ELSE}
  ToolsAPI,
{$ENDIF}
  ZaphodsMap;

var
  ProjectOptions: IDesignNotification;

{ Global }

function GetOwnerModule(RootComponent: TComponent): IOTAModule;

  function FoundInModule(Module: IOTAModule): Boolean;
  var
    idx: Integer;
    FormEditor: IOTAFormEditor;
  {$IFDEF CLR}
    FormName: TObject;
  {$ELSE}
    NTAComponent: INTAComponent;
  {$ENDIF}
  begin
    Result := False;
  {$IFDEF CLR}
    for idx := 0 to Module.ModuleFileCount - 1 do
      if Supports(Module.ModuleFileEditors(idx), IOTAFormEditor, FormEditor) then
        if FormEditor.GetRootComponent <> nil then
          if FormEditor.GetRootComponent.GetPropValueByName('Name', FormName) and
            (string(FormName) = RootComponent.Name) then
          begin
            Result := True;
            Break;
          end;
  {$ELSE}
    for idx := 0 to Module.GetModuleFileCount - 1 do
      if Supports(Module.GetModuleFileEditor(idx), IOTAFormEditor, FormEditor) then
        if Supports(FormEditor.GetRootComponent, INTAComponent, NTAComponent) then
          if NTAComponent.GetComponent = RootComponent then
          begin
            Result := True;
            Break;
          end;
  {$ENDIF}
  end;

var
  ModuleServices: IOTAModuleServices;
  idx: Integer;
begin
  Result := nil;
  if RootComponent = nil then Exit;
{$IFDEF CLR}
  ModuleServices := BorlandIDE.ModuleServices;
{$ELSE}
  if not Assigned(BorlandIDEServices) then Exit;
  ModuleServices := BorlandIDEServices as IOTAModuleServices;
{$ENDIF}
  if not Assigned(ModuleServices) then Exit;
  for idx := 0 to ModuleServices.ModuleCount - 1 do
    if FoundInModule(ModuleServices.GetModule(idx)) then
    begin
      Result := ModuleServices.GetModule(idx);
      Break;
    end;
end;

function GetOwnerProject(RootComponent: TComponent): IOTAProject;
var
  Module: IOTAModule;
  idx: Integer;
begin
  Result := nil;
  Module := GetOwnerModule(RootComponent);
  if Assigned(Module) then
  begin
  {$IFDEF CLR}
    for idx := 0 to Module.OwnerModuleCount - 1 do
  {$ELSE}
    for idx := 0 to Module.GetOwnerModuleCount - 1 do
  {$ENDIF}
      if Supports(Module.GetOwnerModule(idx), IOTAProject, Result) then
        Break;
  end;
end;

procedure RegisterZaphodDTProjectOptions;
begin
  if ProjectOptions = nil then
  begin
    ProjectOptions := TZaphodProjectOptions.Create;
    RegisterDesignNotification(ProjectOptions);
  end;  
end;

procedure UnregisterZaphodDTProjectOptions;
begin
  if ProjectOptions <> nil then
  begin
    UnregisterDesignNotification(ProjectOptions);
    ProjectOptions := nil;
  end;
end;

{ TZaphodProjectOptions }

function TZaphodProjectOptions.GetProjectOption(RootComponent: TComponent;
  OptionName: string): string;
var
  Project: IOTAProject;
{$IFDEF CLR}
  OptionValue: TObject;
{$ENDIF}
begin
  Project := GetOwnerProject(RootComponent);
  if Assigned(Project) then
  {$IFDEF CLR}
  begin
    OptionValue := Project.ProjectOptions.GetOptionValue(OptionName);
    if OptionValue <> nil then
      Result := OptionValue.ToString
    else
      Result := '';
  end
  {$ELSE}
    Result := Project.ProjectOptions.GetOptionValue(OptionName)
  {$ENDIF}
  else
    Result := '';
end;

procedure TZaphodProjectOptions.GetProjectOptions(RootComponent: TComponent;
  Options: TStrings);
var
  Project: IOTAProject;
{$IFDEF CLR}
  OptionNames: IOTAOptionNames;
  OptionValue: TObject;
{$ELSE}
  OptionNames: TOTAOptionNameArray;
  OptionValue: string;
{$ENDIF}
  idx: Integer;
begin
  OptionNames := nil;
  Project := GetOwnerProject(RootComponent);
  if Assigned(Project) then
  begin
  {$IFDEF CLR}
    OptionNames := Project.ProjectOptions.OptionNames;
    for idx := 0 to OptionNames.Count - 1 do
    begin
      OptionValue := Project.ProjectOptions.GetOptionValue(OptionNames.GetName(idx));
      if OptionValue <> nil then
        Options.Values[OptionNames.GetName(idx)] := OptionValue.ToString
      else
        Options.Values[OptionNames.GetName(idx)] := '';
    end;
  {$ELSE}
    OptionNames := Project.ProjectOptions.GetOptionNames;
    for idx := 0 to Length(OptionNames) - 1 do
    begin
      OptionValue := Project.ProjectOptions.GetOptionValue(OptionNames[idx].Name);
      Options.Values[OptionNames[idx].Name] := OptionValue;
    end;
  {$ENDIF}
  end;
end;

function TZaphodProjectOptions.GetProjectOutputDir(
  RootComponent: TComponent): string;
begin
  Result := GetProjectOption(RootComponent, 'OutputDir');
  if Result <> '' then
    Result := IncludeTrailingPathDelimiter(Result);
end;

function TZaphodProjectOptions.GetPackageDLLOutputDir(
  RootComponent: TComponent): string;
begin
  Result := GetProjectOption(RootComponent, 'PkgDcpDir');
  if Result <> '' then
    Result := IncludeTrailingPathDelimiter(Result);
end;

function TZaphodProjectOptions.GetPackageDCPOutputDir(
  RootComponent: TComponent): string;
begin
  Result := GetProjectOption(RootComponent, 'PkgDllDir');
  if Result <> '' then
    Result := IncludeTrailingPathDelimiter(Result);
end;

function TZaphodProjectOptions.GetProjectFileName(
  RootComponent: TComponent): string;
var
  Project: IOTAProject;
begin
  Project := GetOwnerProject(RootComponent);
  if Assigned(Project) then
    Result := string(Project.FileName)
  else
    Result := '';
end;

function TZaphodProjectOptions.ProjectIsPackage(
  RootComponent: TComponent): Boolean;
begin
  Result := SameText(ExtractFileExt(GetProjectFileName(RootComponent)), '.dpk');
end;

function TZaphodProjectOptions.ProjectIsALibrary(
  RootComponent: TComponent): Boolean;
begin
  Result := ProjectIsPackage(RootComponent);
end;

procedure TZaphodProjectOptions.ItemDeleted(const ADesigner: IDesigner;
  AItem: TPersistent);
begin
  if AItem is TZaphodsMap then
    TZaphodsMap(AItem).ProjectOptions := nil;
end;

procedure TZaphodProjectOptions.ItemInserted(const ADesigner: IDesigner;
  AItem: TPersistent);
begin
  if AItem is TZaphodsMap then
    TZaphodsMap(AItem).ProjectOptions := Self;
end;

procedure TZaphodProjectOptions.ItemsModified(const ADesigner: IDesigner);
begin
end;

procedure TZaphodProjectOptions.SelectionChanged(const ADesigner: IDesigner;
  const ASelection: IDesignerSelections);
begin
end;

procedure TZaphodProjectOptions.DesignerOpened(const ADesigner: IDesigner;
  AResurrecting: Boolean);
begin
end;

procedure TZaphodProjectOptions.DesignerClosed(const ADesigner: IDesigner;
  AGoingDormant: Boolean);
begin
end;

initialization

finalization
  UnregisterZaphodDTProjectOptions;

end.
