Subversion Repositories spacemission

Rev

Rev 76 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit ComHilfe;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw;
  8.  
  9. type
  10.   THilfeForm = class(TForm)
  11.     WebBrowser1: TWebBrowser;
  12.     procedure WebBrowser1BeforeNavigate2(ASender: TObject;
  13.       const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  14.       Headers: OleVariant; var Cancel: WordBool);
  15.   private
  16.     FDirectory: string;
  17.   public
  18.     procedure ShowHTMLHelp(AHTML: string);
  19.     procedure ShowMarkDownHelp(AMarkDownFile: string);
  20.   end;
  21.  
  22. var
  23.   HilfeForm: THilfeForm;
  24.  
  25. implementation
  26.  
  27. uses
  28.   MarkDownProcessor, ShellAPI, Global;
  29.  
  30. {$R *.dfm}
  31.  
  32. procedure THilfeForm.ShowHTMLHelp(AHTML: string);
  33. var
  34.   DOC: Variant;
  35. begin
  36.   if not Assigned(WebBrowser1.Document) then
  37.     WebBrowser1.Navigate('about:blank'); // do not localize
  38.  
  39.   DOC := WebBrowser1.Document;
  40.   DOC.Clear;
  41.   DOC.Write(AHTML);
  42.   Doc.Close;
  43. end;
  44.  
  45. procedure THilfeForm.ShowMarkDownHelp(AMarkDownFile: string);
  46. var
  47.   md: TMarkdownProcessor;
  48.   slHtml, slCss: TStringList;
  49.   cssFile: string;
  50. begin
  51.   FDirectory := ExtractFilePath(AMarkDownFile);
  52.   slHtml := TStringList.Create();
  53.   slCss := TStringList.Create();
  54.   try
  55.     slHtml.LoadFromFile(AMarkDownFile);
  56.     cssFile := IncludeTrailingPathDelimiter(FDirectory) + 'Style.css'; // do not localize
  57.     if FileExists(cssFile) then
  58.       slCss.LoadFromFile(cssFile);
  59.     md := TMarkdownProcessor.CreateDialect(mdCommonMark);
  60.     try
  61.       //md.AllowUnsafe := true;
  62.       ShowHTMLHelp(
  63.         '<html>'+                                                                // do not localize
  64.         '<head>'+                                                                // do not localize
  65.         '<meta http-equiv="Content-Type" content="text/html; charset=utf-8">'+   // do not localize
  66.         '<style>'+slCss.Text+'</style>'+                                         // do not localize
  67.         '</head>'+                                                               // do not localize
  68.         '<body>'+                                                                // do not localize
  69.         md.process(UTF8ToString(RawByteString(slHtml.Text)))+
  70.         '</body>'+                                                               // do not localize
  71.         '</html>');                                                              // do not localize
  72.     finally
  73.       FreeAndNil(md);
  74.     end;
  75.   finally
  76.     FreeAndNil(slHtml);
  77.     FreeAndNil(slCss);
  78.   end;
  79. end;
  80.  
  81. procedure THilfeForm.WebBrowser1BeforeNavigate2(ASender: TObject;
  82.   const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  83.   Headers: OleVariant; var Cancel: WordBool);
  84. begin
  85.   if SameText(Copy(URL,1,7),'http://') or      // do not localize
  86.      SameText(Copy(URL,1,8),'https://') or     // do not localize
  87.      SameText(Copy(URL,1,7),'mailto:') then    // do not localize
  88.   begin
  89.     // Links in default Browser anzeigen
  90.     ShellExecute(handle, 'open', PChar(string(URL)), '', '', SW_NORMAL);  // do not localize
  91.     Cancel := true;
  92.   end
  93.   else if SameText(ExtractFileExt(URL), '.md') then // do not localize
  94.   begin
  95.     if SameText(Copy(URL,1,6), 'about:') then // do not localize
  96.       ShowMarkDownHelp(IncludeTrailingPathDelimiter(FDirectory) + Copy(URL,7,Length(URL)))
  97.     else
  98.       ShowMarkDownHelp(URL);
  99.     Cancel := true;
  100.   end
  101.   else
  102.   begin
  103.     Cancel := false;
  104.   end;
  105. end;
  106.  
  107. end.
  108.