unit TMS.ServerWizard.GeneralWizardForm;

{$I bcl.inc}

interface

{$IFDEF DELPHIXE2_LVL}

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, TMS.ServerWizard.Creation,
  TMS.ServerWizard.Types, Vcl.ComCtrls, Vcl.Imaging.Pngimage;

type
  TCreateClicked = function (const AServerKind : TServerKind;
    const Settings : TProjectCreationSettings; const Kinds : TProjectKinds) : Boolean of object;
  TGetServerName = function : string of object;

  TTMSGeneralWizardForm = class(TForm)
    pnlButtons: TPanel;
    btnCreate: TButton;
    btnCancel: TButton;
    Bevel1: TBevel;
    tabPages: TPageControl;
    tabServerKind: TTabSheet;
    tabServerSettings: TTabSheet;
    tabDatabase: TTabSheet;
    lblServerKind: TLabel;
    chkServerKindVCL: TCheckBox;
    chkServerKindFMX: TCheckBox;
    chkServerKindService: TCheckBox;
    chkServerKindConsole: TCheckBox;
    lblServerSettings: TLabel;
    lblHost: TLabel;
    lblPort: TLabel;
    lblPath: TLabel;
    edtHost: TEdit;
    edtPort: TEdit;
    edtPath: TEdit;
    lblDatabase: TLabel;
    pnlHeading: TPanel;
    lblHeading: TLabel;
    imgHeading: TImage;
    btnPrev: TButton;
    btnNext: TButton;
    imgLogo: TImage;
    rbAdapterMode: TRadioButton;
    rbDriverMode: TRadioButton;
    pgDatabaseConnectivity: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    lblDatabaseDriver: TLabel;
    cmbAdapter: TComboBox;
    lblSQLDialect: TLabel;
    cmbSQLDialect: TComboBox;
    lblDriver: TLabel;
    cmbDriver: TComboBox;
    procedure btnCancelClick(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
    procedure ControlExit(Sender: TObject);
    procedure cmbAdapterChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnPrevClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure rbAdapterModeClick(Sender: TObject);
    procedure rbDriverModeClick(Sender: TObject);
  private
    FServerKind : TServerKind;
    FSettings : TProjectCreationSettings;
    FProjectKinds : TProjectKinds;
    FCreateClicked : TCreateClicked;
    FGetServerName : TGetServerName;
    FLogo : TPngImage;
    function DoUIChecks: Boolean;
    procedure UpdateSettingsFromUI;
    procedure UpdateUIFromSettings;
    procedure InitUI;
    procedure UpdateNextPrevButtons;
    function GetNextTabIndex: Integer;
    function GetPrevTabIndex: Integer;
    function GetFirstTabIndex: Integer;
    procedure ShowLogoOnActiveTab;
    procedure AssignHeading(ToLabel: TLabel);
  public
    constructor Create(AOwner : TComponent; AServerKind : TServerKind;
      ACreateClicked : TCreateClicked; AGetServerName : TGetServerName); reintroduce;
    destructor Destroy; override;
  end;

var
  TMSGeneralWizardForm: TTMSGeneralWizardForm;

{$ENDIF}

implementation

{$IFDEF DELPHIXE2_LVL}

{$R *.dfm}

uses
  TMS.ServerWizard.Configuration, TMS.ServerWizard.PlatformFonts;

constructor TTMSGeneralWizardForm.Create(AOwner: TComponent; AServerKind : TServerKind;
  ACreateClicked : TCreateClicked; AGetServerName : TGetServerName);
begin
  inherited Create(AOwner);

  FLogo := TPngImage.Create;

  FServerKind := AServerKind;
  FCreateClicked := ACreateClicked;
  FGetServerName := AGetServerName;

  if (not Assigned(FCreateClicked)) or (not Assigned(FGetServerName)) then
    raise Exception.Create('TMS General Wizard form constructor: essential callbacks are nil');

  FSettings := TProjectCreationSettings.Create(FServerKind);
  FProjectKinds := [TProjectKind.pkVCL];
  InitUI;
  UpdateUIFromSettings;

  Caption := 'New ' + FGetServerName() + ' Server';
  lblHeading.Caption := 'New ' + FGetServerName();
  if FServerKind = TServerKind.skStandAloneConnModule then
    lblHeading.Caption := lblHeading.Caption + ' Module'
  else
    lblHeading.Caption := lblHeading.Caption + ' Server';
end;

destructor TTMSGeneralWizardForm.Destroy;
begin
  FLogo.Free;
  inherited;
end;

function TTMSGeneralWizardForm.DoUIChecks: Boolean;
begin
  Result := True;
  if tabPages.ActivePage = tabServerKind then
  begin
    if not (chkServerKindVCL.Checked or chkServerKindFMX.Checked or
      chkServerKindService.Checked or chkServerKindConsole.Checked) then
    begin
      ShowMessage('Please select at least one application type to create as the host for the server.');
      Exit(False);
    end;
  end;
  if tabPages.ActivePage = tabDatabase then
  begin
    if rbDriverMode.Checked and (cmbDriver.Text = '') then
    begin
      ShowMessage('Please select a driver for database connectivity.');
      Exit(False);
    end;
    if rbAdapterMode.Checked and (cmbAdapter.Text = '') then
    begin
      ShowMessage('Please select an adapter for database connectivity.');
      Exit(False);
    end;
  end;
end;

procedure TTMSGeneralWizardForm.FormShow(Sender: TObject);
const
  BORDER = 4;
var
  TabHeight : Integer;
begin
  tabPages.TabHeight := 1; // However, draws more than 1px
  TabHeight := 20; // Good safety margin

  // Arrange the page control so the tabs are not visible
  tabPages.Top := pnlHeading.Top + pnlHeading.Height - BORDER;
  tabPages.Left := -Border;
  tabPages.Width := ClientWidth + 2*BORDER;
  tabPages.Height := pnlButtons.Top - (pnlHeading.Top + pnlHeading.Height)
    + 2*BORDER
    + TabHeight;

  UpdateNextPrevButtons;
end;

procedure TTMSGeneralWizardForm.InitUI;
var
  I : Integer;
  HeadingIcon : TIcon;
  TransparentBMP : TBitmap;
  ResName: string;
begin
  lblDatabase.Visible := FServerKind <> TServerKind.skSparkle;
//  lblDatabaseDriver.Visible := FServerKind <> TServerKind.skSparkle;
//  lblSQLDialect.Visible := FServerKind <> TServerKind.skSparkle;
//  cmbSQLDialect.Visible := FServerKind <> TServerKind.skSparkle;
//  cmbDatabaseDriver.Visible := FServerKind <> TServerKind.skSparkle;
//  cmbSQLDialect.Enabled := FServerKind <> TServerKind.skSparkle;
//  cmbDatabaseDriver.Enabled := FServerKind <> TServerKind.skSparkle;
  pgDatabaseConnectivity.Visible := FServerKind <> TServerKind.skSparkle;
  rbAdapterMode.Visible := FServerKind <> TServerKind.skSparkle;
  rbDriverMode.Visible := not (FServerKind in [TServerKind.skSparkle, TServerKind.skRemoteDB]);

  tabDatabase.Enabled := FServerKind <> TServerKind.skSparkle;
  tabServerSettings.Enabled := FServerKind <> TServerKind.skStandAloneConnModule;
  tabServerKind.Enabled := FServerKind <> TServerKind.skStandAloneConnModule;

  tabPages.ActivePageIndex := GetFirstTabIndex; // Always start here

  // XE2 and 3 do not support FMX for non-Sparkle servers
  {$ifdef XE2_OR_3}
    if FServerKind <> skSparkle then begin
      chkServerKindFMX.Checked := false;
      chkServerKindFMX.Enabled := false;
      chkServerKindFMX.Caption := chkServerKindFMX.Caption + ' (XE4+)';
    end;
  {$endif}

  // Do other once-off initialisation here

  // Load the combo boxes etc
  // DB Adapters and Native Drivers
  cmbAdapter.Clear;
  cmbDriver.Clear;
  for I := Low(DatabaseDrivers) to High(DatabaseDrivers) do
    if DatabaseDrivers[i].ConnectionType <> '' then
      cmbAdapter.Items.Add(DatabaseDrivers[i].UIName)
    else
      cmbDriver.Items.Add(DatabaseDrivers[i].UIName);

  // Select FireDAC by default. Comes with XE4 and above, but works on 2010 and
  // above, so seems a reasonable default for any version
  // See http://www.embarcadero.com/products/rad-studio/firedac-faq
  // "Which versions of Delphi, C++Builder and RAD Studio does FireDAC work with?"
  cmbAdapter.ItemIndex := cmbAdapter.Items.IndexOf('FireDAC');

  // SQL dialects
  cmbSQLDialect.Clear;
  for I := Low(SQLDialects) to High(SQLDialects) do
    cmbSQLDialect.Items.Add(SQLDialects[i]);
  cmbSQLDialect.ItemIndex := -1; // Nothing selected by default (for FireDAC)

  UpdateNextPrevButtons;

  // Load the logo for the kind of server
  case FServerKind of
    TServerKind.skSparkle: FLogo.LoadFromResourceName(HInstance, 'SPARKLEIMAGE');
    TServerKind.skXData: FLogo.LoadFromResourceName(HInstance, 'XDATAIMAGE');
    TServerKind.skRemoteDB: FLogo.LoadFromResourceName(HInstance, 'REMOTEDBIMAGE');
    TServerKind.skStandAloneConnModule: FLogo.LoadFromResourceName(HInstance, 'CONNECTIONIMAGE');
  end;

  // Draw the logo semitransparently
  // TPNGImage doesn't override TGraphic.DrawTransparent, so
  //   imgLogo.Picture.Bitmap.Canvas.Draw(0, 0, FLogo, 128);
  // doesn't work. Draw to an intermediate transparent bitmap.
  TransparentBMP := TBitmap.Create;
  try
    TransparentBMP.PixelFormat := pf32bit;
    TransparentBMP.Width := FLogo.Width;
    TransparentBMP.Height := FLogo.Height;
    TransparentBMP.Canvas.Draw(0, 0, FLogo);

    imgLogo.Picture.Bitmap.Width := FLogo.Width;
    imgLogo.Picture.Bitmap.Height := FLogo.Height;
    imgLogo.Picture.Bitmap.Canvas.Brush.Color := clWindow;
    imgLogo.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, FLogo.Width, FLogo.Height));
    imgLogo.Picture.Bitmap.Canvas.Draw(0, 0, TransparentBMP, 128);
  finally
    TransparentBMP.Free;
  end;
  imgLogo.Stretch := true;
//  imgLogo.Left := 10;
//  imgLogo.Top := pnlButtons.Top - (pnlHeading.Top + pnlHeading.Height) - 10 - imgLogo.Height;
  ShowLogoOnActiveTab;

  // and the icon next to the big heading
  HeadingIcon := TIcon.Create;
  try
    case FServerKind of
      TServerKind.skSparkle: ResName := 'SPARKLEICON';
      TServerKind.skXData: ResName := 'XDATAICON';
      TServerKind.skRemoteDB: ResName := 'REMOTEDBICON';
      TServerKind.skStandAloneConnModule: ResName := 'CONNECTIONICON';
    end;
    HeadingIcon.Handle :=
      LoadImage(HInstance, PChar(ResName), IMAGE_ICON, imgHeading.Width, imgHeading.Height, LR_DEFAULTCOLOR);
    imgHeading.Picture.Assign(HeadingIcon);
  finally
    HeadingIcon.Free;
  end;

  // Some labels are headings. Assign appropriate fonts for XP/Vista+
  // Note that if labels are aligned as headings, you don't want them to expand
  // down as they resize, so set Align to alBottom and Layout to tlBottom
  lblHeading.Font.Assign(TWindowsPlatformFonts.SuperHeadingFont);
  AssignHeading(lblServerKind);
  AssignHeading(lblServerSettings);
  AssignHeading(lblDatabase);
end;

procedure TTMSGeneralWizardForm.rbAdapterModeClick(Sender: TObject);
begin
  pgDatabaseConnectivity.ActivePage := TabSheet1;
end;

procedure TTMSGeneralWizardForm.rbDriverModeClick(Sender: TObject);
begin
  pgDatabaseConnectivity.ActivePage := TabSheet2;
end;

procedure TTMSGeneralWizardForm.AssignHeading(ToLabel : TLabel);
var
  OldBottom : Integer;
begin
  // Make labels resize upwards. They're positioned with correct vertical space
  // between them and whatever they are a heading for already
  // Using Anchors and Layout here doesn't give the desired result
  OldBottom := ToLabel.Top + ToLabel.Height;

  ToLabel.Font.Assign(TWindowsPlatformFonts.HeadingFont);
  ToLabel.Repaint;
  ToLabel.Top := OldBottom - ToLabel.Height;
end;

procedure TTMSGeneralWizardForm.ShowLogoOnActiveTab;
begin
  // Just have one TImage, and make sure it's on the current tab
  imgLogo.Parent := tabPages.ActivePage;
end;

procedure TTMSGeneralWizardForm.UpdateNextPrevButtons;
begin
  // Position the buttons. Next morphs into Create, because they are in the same place
  btnNext.Left := btnCreate.Left;
  btnNext.Top := btnCreate.Top;
  btnPrev.Left := btnNext.Left - btnPrev.Width - 6;
  btnPrev.Top := btnNext.Top;

  // Are Next/Prev enabled?
  btnPrev.Enabled := GetPrevTabIndex <> -1;
  btnNext.Enabled := GetNextTabIndex <> -1;

  // If Next is not enabled, it should be Create
  btnNext.Visible := btnNext.Enabled;
  btnCreate.Visible := not btnNext.Enabled;
  btnCreate.Enabled := btnCreate.Visible;

  // And make sure the logo is visible
  ShowLogoOnActiveTab;
end;

function TTMSGeneralWizardForm.GetFirstTabIndex : Integer;
var
  I : Integer;
begin
  Result := -1;

  // Find the first enabled tabsheet after the current one
  for I := 0 to Pred(tabPages.PageCount) do
    if tabPages.Pages[i].Enabled then
      Exit(i);
end;

function TTMSGeneralWizardForm.GetNextTabIndex : Integer;
var
  I : Integer;
begin
  Result := -1;

  // Find the first enabled tabsheet after the current one
  for I := tabPages.ActivePageIndex+1 to Pred(tabPages.PageCount) do
    if tabPages.Pages[i].Enabled then
      Exit(i);
end;

function TTMSGeneralWizardForm.GetPrevTabIndex : Integer;
var
  I : Integer;
begin
  Result := -1;

  // Find the first enabled tabsheet before the current one
  for I := tabPages.ActivePageIndex-1 downto 0 do
    if tabPages.Pages[i].Enabled then
      Exit(i);
end;


procedure TTMSGeneralWizardForm.UpdateSettingsFromUI;
begin
  FSettings.ServerHostname := edtHost.Text;
  FSettings.ServerPort := edtPort.Text;
  FSettings.ServerPath := edtPath.Text;

  FProjectKinds := [];
  if chkServerKindVCL.Checked then
    Include(FProjectKinds, TProjectKind.pkVCL);
  if chkServerKindFMX.Checked then
    Include(FProjectKinds, TProjectKind.pkFMX);
  {$ifdef XE2_OR_3}
    // XE2 and 3 do not support FMX for non-Sparkle servers
    if FServerKind <> skSparkle then begin
      assert(not (pkFMX in FProjectKinds)); // Shouldn't be able to put it in the set, anyway
      Exclude(FProjectKinds, pkFMX);
    end;
  {$endif}
  if chkServerKindService.Checked then
    Include(FProjectKinds, TProjectKind.pkService);
  if chkServerKindConsole.Checked then
    Include(FProjectKinds, TProjectKind.pkConsole);

  if FServerKind <> TServerKind.skSparkle then
  begin
    if rbDriverMode.Checked then
      FSettings.DatabaseDriver := cmbDriver.Text
    else
      FSettings.DatabaseDriver := cmbAdapter.Text;

    FSettings.DatabaseDriverType := GetDataBaseDriverTypeFromUI(FSettings.DatabaseDriver);
    FSettings.DatabaseDriverUses := GetDriverNameForDatabaseUIName(FSettings.DatabaseDriver);
    FSettings.SQLDialect := cmbSQLDialect.Text;
  end;
end;

procedure TTMSGeneralWizardForm.UpdateUIFromSettings;
begin
  edtHost.Text := FSettings.ServerHostname;
  edtPort.Text := FSettings.ServerPort;
  edtPath.Text := FSettings.ServerPath;

  chkServerKindVCL.Checked := TProjectKind.pkVCL in FProjectKinds;
  chkServerKindFMX.Checked := TProjectKind.pkFMX in FProjectKinds;
  chkServerKindService.Checked := TProjectKind.pkService in FProjectKinds;
  chkServerKindConsole.Checked := TProjectKind.pkConsole in FProjectKinds;
end;

procedure TTMSGeneralWizardForm.ControlExit(Sender: TObject);
begin
  UpdateSettingsFromUI;
end;

procedure TTMSGeneralWizardForm.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TTMSGeneralWizardForm.btnCreateClick(Sender: TObject);
begin
  if not DoUIChecks then Exit;
  UpdateSettingsFromUI;

  if FCreateClicked(FServerKind, FSettings, FProjectKinds) then
    ModalResult := mrOk; // Close window
end;

procedure TTMSGeneralWizardForm.btnNextClick(Sender: TObject);
begin
  if not DoUIChecks then Exit;

  try
    // Moving the logo around and changing tabs can flicker
    SendMessage(tabPages.Handle, WM_SETREDRAW, 0, 0);

    tabPages.ActivePageIndex := GetNextTabIndex;
    ShowLogoOnActiveTab;
  finally
    SendMessage(tabPages.Handle, WM_SETREDRAW, 1, 0);
    tabPages.Repaint;
  end;

  UpdateNextPrevButtons;
end;

procedure TTMSGeneralWizardForm.btnPrevClick(Sender: TObject);
begin
  try
    // Moving the logo around and changing tabs can flicker
    SendMessage(tabPages.Handle, WM_SETREDRAW, 0, 0);

    tabPages.ActivePageIndex := GetPrevTabIndex;
    ShowLogoOnActiveTab;
  finally
    SendMessage(tabPages.Handle, WM_SETREDRAW, 1, 0);
    tabPages.Repaint;
  end;

  UpdateNextPrevButtons;
end;

procedure TTMSGeneralWizardForm.cmbAdapterChange(Sender: TObject);
var
  SQLDialect : string;
begin
  // Automatically choose the best SQL dialect for the database driver
  SQLDialect := GetPreferredSQLDialectForDatabase(cmbAdapter.Text);
  if SQLDialect <> '' then
    cmbSQLDialect.ItemIndex := cmbSQLDialect.Items.IndexOf(SQLDialect)
  else begin
    cmbSQLDialect.ItemIndex := -1;
    cmbSQLDialect.Text := '';
  end;
end;
{$ENDIF}

end.
