unit U_HintBar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  FastStrings, Dialogs, StdCtrls, OleCtrls, SHDocVw, ucCustomizedWebBrowser, ActiveX, //MSHTML_TLB,
  U_LNG, U_Common, U_ResourceReport, U_BaseCommon, U_SCSComponent, U_ESCadClasess;

type
  TF_HintBar = class(TForm)
    WebBrowser: TCustomizedWebBrowser;
    procedure WebBrowserBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowserEnter(Sender: TObject);
    function WebBrowserPressAccelerator(Sender: TObject;
      const lpMsg: tagMSG): Boolean;
  protected
    FBNext: String;
    FBBack: String;
    FBFirst: String;
    FTplPath: String;

    procedure AssignEmptyDocument;
    procedure Go(Url: string);
    procedure HideHints;
    function LoadFromStream(const AStream: TStream): HRESULT;
    function LoadFromStrings(const AStrings: TStrings): HRESULT;
    function LoadFromString(const S: string): HRESULT;
    function LoadFromFile(const FileName: string): HRESULT;
    procedure LoadNavButton(var aBtCode: String; const aTplDir, aTpl, aDefText: String);
    procedure StepWizard(aDirection: Integer);
  public
    FCurrStep: Integer;
    FStepCount: Integer;
    function GetPathTpl(aRelative: Boolean=false): String;
    procedure FirstWizard;
    procedure NextWizard;
    procedure BackWizard;
    procedure StartWizard;
  end;

var
  F_HintBar: TF_HintBar;
  //F_ResourceReport: TF_ResourceReport;

implementation

Uses USCS_Main, U_Main;

{$R *.dfm}



{ TF_HintBar }

procedure TF_HintBar.AssignEmptyDocument;
begin
  Go('about:blank');
end;

procedure TF_HintBar.BackWizard;
begin
  StepWizard(-1);
end;

procedure TF_HintBar.Go(Url: string);
var
   _URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
   //WebBrowser._URL := Url;
   Flags := 0;
   TargetFrameName := 0;
   Postdata := 0;
   Headers := 0;
   if (Trim(Url) <> '') then
      //WebBrowser.Navigate2(Url, Flags, TargetFrameName, PostData, Headers);
      WebBrowser.Navigate(Url, Flags, TargetFrameName, PostData, Headers);
end;

procedure TF_HintBar.HideHints;
begin
  HideHintRz;
  HideHintImg;
end;

function TF_HintBar.LoadFromFile(const FileName: string): HRESULT;
var
   Stream: TStream;
begin
   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
   try
      Result := LoadFromStream(Stream);
   finally
      Stream.Free;
   end;
end;


function TF_HintBar.LoadFromStream(const AStream: TStream): HRESULT;
begin
  if not Assigned(WebBrowser.Document) then
      AssignEmptyDocument;
   AStream.seek(0, 0);
   Result := (WebBrowser.Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
end;

function TF_HintBar.LoadFromStrings(const AStrings: TStrings): HRESULT;
var
   M: TMemoryStream;
begin
   if not Assigned(WebBrowser.document) then
      AssignEmptyDocument;
   M := TMemoryStream.Create;
   try
      AStrings.SaveToStream(M);
      Result := LoadFromStream(M);
   except
      Result := S_False;
   end;
   M.free;
end;

function TF_HintBar.LoadFromString(const S: string): HRESULT;
var
   Strings: TStringList;
begin
   Strings := TStringList.Create;
   try
      Strings.Text := S;
      Result := LoadFromStrings(Strings);
   finally
      FreeAndNil(Strings);
   end;
end;
//Tolik 13/04/2022 --
{
function TF_HintBar.GetPathTpl(aRelative: Boolean=false): String;
begin
  Result := GetPathToHelp(aRelative) + '\HintBox\';
  if F_LNG.siLangDisp.Language = 'ENG' then
    Result := Result + 'en\'
  else
    Result := Result + 'ru\';
end;
}
function TF_HintBar.GetPathTpl(aRelative: Boolean=false): String;
begin
  Result := GetPathToHelp(aRelative) + '\HintBox\';
  if F_LNG.siLangDisp.Language = 'ENG' then
    Result := Result + 'en\'
  else
  if F_LNG.siLangDisp.Language = 'RUS' then
    Result := Result + 'ru\'
  else
  if F_LNG.siLangDisp.Language = 'UKR' then
    Result := Result + 'ukr\';
end;
//

procedure TF_HintBar.FirstWizard;
begin
  StepWizard(1-FCurrStep);
end;

procedure TF_HintBar.NextWizard;
begin
  StepWizard(1);
end;

procedure TF_HintBar.StartWizard;
var
  TplDir: String;
  TplDirRel: String;
  Files: TStringList;
begin
  TplDir := GetPathTpl;
  if DirectoryExists(TplDir) then
  begin
    Files := GetDirFiles(TplDir);
    if Files.Count > 0 then
    begin
      //LoadNavButton(FBNext, TplDir, 'bNext.tpl', 'Next');
      //LoadNavButton(FBBack, TplDir, 'bBack.tpl', 'Back');

      //TplDirRel := GetPathTpl(true);
      //FBNext := '<img alt="" src="'+ FilePathToURL(TplDirRel+'next.png')+'" />';
      //FBBack := '<img alt="" src="'+ FilePathToURL(TplDirRel+'back.png')+'" />';

      TplDirRel := GetPathTpl(false)+'nav\';
      //FBNext := '<img alt="" style="width: 59px; height: 27px; border: none;" src="file:///'+ TplDirRel+'next_min.png'+'" />';
      //FBBack := '<img alt="" style="width: 59px; height: 27px; border: none;" src="file:///'+ TplDirRel+'back_min.png'+'" />';
      FBNext := '<img alt="" style="margin-top:0px; border: none;" src="file:///'+ TplDirRel+'next_min.png'+'" />';
//      FBBack := '<img alt="" style="margin-top:0px; border: none;" src="file:///'+ TplDirRel+'back_min.png'+'" />';
      FBBack := '<'; //15.07.2013 FBBack := '<<';
      FBFirst := '<<';

      //FBNext := 'Next';
      //FBBack := 'Back';

      FCurrStep := 1;
      FStepCount := Files.Count;
      StepWizard(0);
    end;
    FreeAndNil(Files);
  end;
end;

procedure TF_HintBar.StepWizard(aDirection: Integer);
const
  tplBegin = '<HTML><HEAD><meta http-equiv="Content-Type" content="text/html; charset=Windows-1251"><TITLE></TITLE>'+
             '<STYLE type="text/css">'+
             'body{font: 12pt Arial; font-weight: bold; margin: 4px;}'+
             ////Tolik 15/02/2022 -- Roma сказал поменять цвета
             //'.act{color:clgreen}'+ // green color for action links // old 4EBA71
             '.act{color:#00E8731A}'+ // green color for action links // old 4EBA71
             //'.tooltip{color:#6C86EB}'+ // blue color for Learn Nore
             '.tooltip{color:#00E8731A}'+ // blue color for Learn Nore
             //'.nav{color:#17479F}'+ // dark blue for navigation links as "<<" and "<"
             '.nav{color:#00E8731A}'+ // dark blue for navigation links as "<<" and "<"
             //

             '.Wrapper{background-color:#F3F3F3; margin-top: 0px; height: 100%;}'+
             //'/*.Content{background-color:#F9EDBE; margin: 2px 5px 1px 2px; padding-top: 3px; height: 99%; border: 2px solid #F0C36D;} */'+
             '.Content{background-color:#F9EDBE; height: 100%; border: 2px solid #F0C36D;}'+
             //'.spLearnMore{display:none;}'+
             '.ttContent{display:none;}'+ // tooltip content
             '</STYLE>'+
             '</HEAD><BODY LEFTMARGIN=0 TOPMARGIN="0" MARGINHEIGHT="0" MARGINWIDTH="0" MARGINRIGHT="0" STYLE="overflow: auto;">'+
             '<DIV CLASS="Wrapper">'+
             '<DIV CLASS="Content" align=center>';

  tplEnd =
      '</DIV>'+
      '</DIV>'+
      '</BODY></HTML>';

  //Tpls : array[1..7] of string =
  //  (
  //    'Create a <A HREF="actNewProj" CLASS="act">new project</A>.',
  //  ) ;

var
  NewStep: Integer;
  TplPath: String;
  Tpl: String;
  TplNav: String;
  StringList: TStringList;
begin
  if aDirection <> 0 then
  begin
    NewStep := FCurrStep + aDirection;
    if (NewStep > 0) and (NewStep <= FStepCount) then
      FCurrStep := NewStep;
  end;

  //Tpl := Tpls[FCurrStep];
  FTplPath := GetPathTpl;
  TplPath := FTplPath +'\'+IntToStr(FCurrStep)+'.tpl';
  Tpl := '';
  if FileExists(TplPath) then
    Tpl := GetFileContents(TplPath);

  // TplNav
  TplNav := '';
  if FCurrStep > 1 then
  begin
    if TplNav <> '' then
      TplNav := TplNav + '  ';
    //TplNav := TplNav + '<A HREF="navBack" STYLE="color:Red">'+FBBack+'</A>';
    if FCurrStep > 2 then
    begin
      TplNav := TplNav + '<A CLASS="nav" HREF="navFirst" TITLE="turn to first step" >'+FBFirst+'</A>';
      TplNav := TplNav + ' ';
    end;
    TplNav := TplNav + '<A CLASS="nav" HREF="navBack" TITLE="turn to previous step" >'+FBBack+'</A>';
  end;

  if FCurrStep < FStepCount then
  begin
    if TplNav <> '' then
      TplNav := TplNav + '  ';
    //TplNav := TplNav + '<A HREF="navNext" STYLE="background-color: green; color:white">'+FBNext+'</A>';
    TplNav := TplNav + '<A CLASS="nav" HREF="navNext" TITLE="turn to next step" >'+FBNext+'</A>';
  end;
  if TplNav <> '' then
    TplNav := '  '+ TplNav;

  LoadFromString(tplBegin + Tpl +TplNav + tplEnd);
  {StringList := TStringList.Create;
  StringList.Text := tplBegin + Tpl +TplNav + tplEnd;
  FreeAndNil(StringList);}
end;

procedure TF_HintBar.WebBrowserBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  PosAbout: Integer;
  UrlParts: TStringList;
  UrlCmd: String;
  ovElem: OleVariant;
  Str: String;

  //SprComponentType: TNBComponentType;
  SCSCompon: TSCSComponent;
  ComponOwner: TSCSCatalog;
  FileName: String;

  function DefineWorkList: Boolean;
  var
    ListParams: TListParams;
  begin
    Result := false;
    if GCadForm <> nil then
    begin
      if GCadForm.FListType <> lt_Normal then
        if GCadForm.FListType <> lt_Normal then
        begin
          ListParams := GetListParams(GCadForm.FCADListID);
          if ListParams.Settings.IDListForDesignList <> 0 then
            SwitchListInCAD(ListParams.Settings.IDListForDesignList, '');
        end;
      Result := GCadForm.FListType = lt_Normal;
    end;
  end;

begin
  if (URL <> 'about:blank') then
  begin
    URL := FastReplace(URL, 'about:blank', 'about:', false);
    PosAbout := Pos('about:', URL);
    if PosAbout = 1 then
    begin
      UrlParts := SplitString(Copy(URL, Length('about:')+1, Length(URL)-(Length('about:'))), '_', false);
      if UrlParts.Count > 0 then
      begin
        HideHints;
        UrlCmd := UrlParts[0];
        if UrlCmd = 'navFirst' then
          FirstWizard
        else if UrlCmd = 'navBack' then
          BackWizard
        else if UrlCmd = 'navNext' then
          NextWizard
        else if UrlCmd = 'actToolTip' then //else if UrlCmd = 'actLearnMore' then
        begin
          if UrlParts.Count > 1 then
          begin
            ovElem := WebBrowser.OleObject.document.getElementbyId('ttContent'+UrlParts[1]); //ovElem := WebBrowser.OleObject.document.getElementbyId('lmContent'+UrlParts[1]);
            //ShowMessage(ovElem.tagName);
            //if ovElem <> null then
            if ovElem.tagName = 'SPAN' then
            begin
              Str := ovElem.InnerHTML; //ovElem.textContent;
              Str := FastReplace(Str, 'about:blank', 'about:', false);
              ShowHintRz(Str, 60000);
            end
            else
            if ovElem.tagName = 'IMG' then
            begin
              //ShowMessage((ovElem as IHTMLImgElement).Href);
              //ShowMessage(ovElem.url);
              FileName := ovElem.href;
              FileName := FastReplace(FileName, 'about:blank', 'about:', false);
              FileName := Copy(FileName, Length('about:')+1, Length(URL)-(Length('about:')));
              //TplDirRel := GetPathTpl(false)+'nav\';
              try
                ShowHintImg(FTplPath + 'img\'+ FileName, 0);
              except
                on E: Exception do AddExceptionToLogEx('', E.Message);
              end;
            end;
          end;
        end
        else if UrlCmd = 'actNewProj' then
          FSCS_Main.aNew.Execute
        else if UrlCmd = 'actFloorPlan' then
          FSCS_Main.aLoadSubstrate.Execute
        else if UrlCmd = 'actRackDesign' then
        begin
          if F_ProjMan <> nil then
            if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then
            begin
              SCSCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences.GetComponentByType(ctsnCupboard);
              if SCSCompon <> nil then
              begin
                ComponOwner := SCSCompon.GetFirstParentCatalog;
                if Assigned(ComponOwner) then
                  CreateOpenDesignListFromPM(ComponOwner.ListID, ComponOwner.SCSID);
              end;
            end;
        end
        else if UrlCmd = 'act3DView' then
        begin
          if DefineWorkList then
            //FSCS_Main.tb3D.Click
            FSCS_Main.n3DModelForProjectClick(nil);
        end
        else if UrlCmd = 'actSpecification' then
        begin
          if DefineWorkList then
          begin
            //RepWizard;
            if F_ProjMan.F_ResourceReport = nil then
            begin
              F_ProjMan.F_ResourceReport := TF_ResourceReport.Create(F_ProjMan, TForm(F_ProjMan));
              {$IF Defined(SCS_RF)}
                F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false;
              {$IFEND}
              {$IF Defined(SCS_PE) or Defined(SCS_SPA)}
                F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false;
              {$IFEND}
            end;
            F_ProjMan.F_ResourceReport.Timer_TimeOutExec.Enabled := True;
            F_ProjMan.F_ResourceReport.Timer_TimeOutExec.Tag := 1;
            F_ProjMan.F_ResourceReport.ShowWizard([rkProject]);
            FreeAndNil(F_ProjMan.F_ResourceReport);
          end;
        end
        else if UrlCmd = 'actWiringLogBook' then
        begin
          if DefineWorkList then
          begin
            if F_ProjMan.F_ResourceReport = nil then
            begin
              F_ProjMan.F_ResourceReport := TF_ResourceReport.Create(F_ProjMan, TForm(F_ProjMan));
              {$IF Defined(SCS_RF)}
                F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false;
              {$IFEND}
              {$IF Defined(SCS_PE) or Defined(SCS_SPA)}
                F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false;
              {$IFEND}
            end;
            F_ProjMan.F_ResourceReport.Timer_TimeOutExec.Enabled := True;
            F_ProjMan.F_ResourceReport.Timer_TimeOutExec.Tag := 3;
            F_ProjMan.F_ResourceReport.ShowWizard([rkProject]);
            FreeAndNil(F_ProjMan.F_ResourceReport);
          end;
        end
        else if UrlCmd = 'actProjTopology' then
        begin
          FSCS_Main.aCreateProjectPlan.Execute
        end
        else if UrlCmd = 'actOtherReports' then
        begin
          if DefineWorkList then
            RepWizard;
        end
        else if UrlCmd = 'actExpProjPDF' then
          FSCS_Main.aSaveProjectToPDF.Execute
        else if UrlCmd = 'actExpProjDXF' then
          FSCS_Main.aSaveVectorDrawing.Execute
        else if UrlCmd = 'actExpProjOtherFormat' then
          FSCS_Main.aSaveAsSCSProject.Execute;

      end;
      Cancel := true;
    end;
  end;
end;

procedure TF_HintBar.WebBrowserEnter(Sender: TObject);
begin
  HideHints;
end;

function TF_HintBar.WebBrowserPressAccelerator(Sender: TObject;
  const lpMsg: tagMSG): Boolean;
begin
  //
end;

procedure TF_HintBar.LoadNavButton(var aBtCode: String; const aTplDir, aTpl, aDefText: String);
var
  btPath: String;
begin
  if aBtCode = '' then
  begin
    btPath := aTplDir + aTpl;
    if FileExists(btPath) then
      aBtCode := GetFileContents(btPath)
    else
      aBTCode := aDefText;
  end;
end;

end.