mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
489 lines
16 KiB
ObjectPascal
489 lines
16 KiB
ObjectPascal
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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
//'.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. |