Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/IDE/fServerProjectOptionsKylix.pas

unit fServerProjectOptionsKylix;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Delphi IDE Integration
{
{ compiler: Delphi 5 and up
{ platform: Win32
{
{ (c)opyright RemObjects Software. all rights reserved.
{
{ Using this code requires a valid license of the RemObjects SDK
{ which can be obtained at http://www.remobjects.com.
{----------------------------------------------------------------------------}

{$I ../RemObjects.inc}

interface

uses
  Windows, Messages, SysUtils,
  {$IFDEF DELPHI6UP} Variants, {$ENDIF}
  Classes, QGraphics, QControls, QForms,
  QDialogs, QStdCtrls, QButtons, QComCtrls, QImgList, uROIDEPrjWizard, QExtCtrls;

type
  TServerProjectOptions = class(TForm)
    Label1: TLabel;
    eSvcLibName: TEdit;
    eSvcName: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    ePrjName: TEdit;
    Label5: TLabel;
    ePrjDir: TEdit;
    Bevel1: TBevel;
    Label4: TLabel;
    eTemplateName: TEdit;
    btn_Ok: TBitBtn;
    Button2: TBitBtn;
    BitBtn1: TBitBtn;
    Label6: TLabel;
    cbMessageClass: TComboBox;
    Label7: TLabel;
    cbServerClass: TComboBox;
    Label8: TLabel;
    procedure sbBrowseForDirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    fTemplateDir,
    fInvalidServers,
    fDefaultServer : string;

    procedure LoadConfig;

  public
    constructor Create(const aTemplateDir : string); reintroduce;
  end;

var
  ServerProjectOptions: TServerProjectOptions;

function PromptProjectOptions(
  const aTemplateDir : string;
  out someProjectOptions : TROIDEProjectOptions) : boolean;

implementation

uses FileCtrl, INIFiles, uRODLGenTools, uROClient, uROServer;

{$R *.dfm}

function PromptProjectOptions(
  const aTemplateDir : string;
  out someProjectOptions : TROIDEProjectOptions) : boolean;
begin
  with TServerProjectOptions.Create(aTemplateDir) do try
    result := (ShowModal=mrOK);

    if result then with someProjectOptions do begin
      TemplateDir := aTemplateDir;
      ServiceLibraryName := eSvcLibName.Text;
      ServiceName := eSvcName.Text;
      ProjectName := ChangeFileExt(ExtractFileName(ePrjName.Text), '');
      ProjectDir := IncludeTrailingBackslash(ePrjDir.Text);
      MessageClassName := Copy(cbMessageClass.Text,4,Length(cbMessageClass.Text));
      ServerClassName := Copy(cbServerClass.Text,4,Length(cbServerClass.Text));

      // Saves last path entered
      with TIniFile.Create(GetTemplateConfigFileName) do try
        WriteString(sect_ProjectGeneration, id_PrjDir, ExtractFilePath(ProjectDir));
      finally
        Free;
      end;
    end;
  finally
    Free;
  end;
end;

{ TServerProjectOptions }
constructor TServerProjectOptions.Create(const aTemplateDir: string);
begin
  inherited Create(NIL);

  fTemplateDir := aTemplateDir;
  LoadConfig;
end;

procedure TServerProjectOptions.LoadConfig;
var s   : TStringList;
    tmpldir : string;
begin
  s := TStringList.Create;

  with TIniFile.Create(GetTemplateConfigFileName) do try
    ReadSection(sect_ClassFactories, s);

    eTemplateName.Text := fTemplateDir;
    eSvcLibName.Text := ReadString(sect_ProjectGeneration, id_SvcLibName, '');
    eSvcName.Text := ReadString(sect_ProjectGeneration, id_SvcName, '');
    ePrjName.Text := ReadString(sect_ProjectGeneration, id_PrjName, '');

    tmpldir := GetTemplateDir;
    Delete(tmpldir, Pos('Templates', tmpldir), 9);
    Insert('Projects', tmpldir, Length(tmpldir));

    ePrjDir.Text := ReadString(sect_ProjectGeneration, id_PrjDir, tmpldir);
  finally
    Free;
    s.Free;
  end;

  with TIniFile.Create(fTemplateDir+InfoName) do try
    Caption := ReadString(sect_Information, id_Description, Caption);
    fInvalidServers := ReadString(sect_Information, id_InvalidServers, '');
    fInvalidServers := StringReplace(fInvalidServers,' ', '',[rfReplaceAll])+',';

    fDefaultServer := Trim(ReadString(sect_Information, id_DefaultServer, ''));
  finally
    Free;
  end;
end;

procedure TServerProjectOptions.sbBrowseForDirClick(Sender: TObject);
var dir : string;
begin
  dir := ePrjDir.Text;
  if SelectDirectory('Select Project Directory','', Dir) then ePrjDir.Text := Dir;
  //if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0{SELDIRHELP}) then ePrjDir.Text := Dir;
end;

procedure TServerProjectOptions.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var errmsg : string;
begin
  if (ModalResult=mrCancel) then begin
    CanClose := TRUE;
    Exit;
  end
  else CanClose := FALSE;

  if (Trim(eSvcLibName.Text)='') then errmsg := 'Service Library Name cannot be blank'
  else if (Trim(eSvcName.Text)='') then errmsg := 'Service Name cannot be blank'
  else if (Trim(ePrjName.Text)='') then errmsg := 'Project name cannot be blank'
  else if not DirectoryExists(ePrjDir.Text) and
          not ForceDirectories(ePrjDir.Text) then errmsg := 'Specified directory does not exist or cannot be created'

  else begin
    CanClose := TRUE;
    Exit;
  end;

  MessageDlg(errmsg, mtError, [mbOK], 0);
end;

procedure TServerProjectOptions.FormCreate(Sender: TObject);
var i : integer;
    svrclsname : string;
begin
  cbMessageClass.Items.Clear;
  for i := 0 to (GetMessageClassCount-1) do
    cbMessageClass.Items.Add(GetMessageClass(i).ClassName);

  cbMessageClass.ItemIndex := 0;

  cbServerClass.Items.Clear;

  for i := 0 to (GetServerClassCount-1) do begin
    svrclsname := GetServerClass(i).ClassName;

    if (Pos(svrclsname+',', fInvalidServers)=0)
      then cbServerClass.Items.Add(svrclsname);
  end;

  cbServerClass.Enabled := (cbServerClass.Items.Count>1);
  if (cbServerClass.Items.Count=0) then begin
    cbServerClass.Visible := FALSE;
    Exit;
  end;

  if (cbServerClass.Items.IndexOf(fDefaultServer)>0)
    then cbServerClass.ItemIndex := cbServerClass.Items.IndexOf(fDefaultServer)
    else cbServerClass.ItemIndex := 0;
end;

end.