Subversion Repositories spacemission

Rev

Rev 64 | Rev 67 | Go to most recent revision | 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.   public
  16.     procedure ShowHTMLHelp(AHTML: string);
  17.     procedure ShowMarkDownHelp(AMarkDownFile: string);
  18.   end;
  19.  
  20. var
  21.   HilfeForm: THilfeForm;
  22.  
  23. implementation
  24.  
  25. uses
  26.   MarkDownProcessor, ShellAPI;
  27.  
  28. {$R *.dfm}
  29.  
  30. procedure THilfeForm.ShowHTMLHelp(AHTML: string);
  31. var
  32.   DOC: Variant;
  33. begin
  34.   if not Assigned(WebBrowser1.Document) then
  35.     WebBrowser1.Navigate('about:blank');
  36.  
  37.   DOC := WebBrowser1.Document;
  38.   DOC.Clear;
  39.   DOC.Write(AHTML);
  40.   Doc.Close;
  41. end;
  42.  
  43. procedure THilfeForm.ShowMarkDownHelp(AMarkDownFile: string);
  44. var
  45.   md: TMarkdownProcessor;
  46.   sl: TStringList;
  47. begin
  48.   sl := TStringList.Create();
  49.   try
  50.     sl.LoadFromFile(AMarkDownFile);
  51.     md := TMarkdownProcessor.CreateDialect(mdCommonMark);
  52.     try
  53.       //md.AllowUnsafe := true;
  54.       sl.Text := md.process(UTF8ToString(RawByteString(sl.Text)));
  55.       ShowHTMLHelp(sl.Text);
  56.     finally
  57.       FreeAndNil(md);
  58.     end;
  59.   finally
  60.     FreeAndNil(sl);
  61.   end;
  62. end;
  63.  
  64. procedure THilfeForm.WebBrowser1BeforeNavigate2(ASender: TObject;
  65.   const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  66.   Headers: OleVariant; var Cancel: WordBool);
  67. begin
  68.   if SameText(Copy(URL,1,7),'http://') or
  69.      SameText(Copy(URL,1,8),'https://') or
  70.      SameText(Copy(URL,1,7),'mailto:') then
  71.   begin
  72.     // Links in default Browser anzeigen
  73.     ShellExecute(handle, 'open', PChar(string(URL)), '', '', SW_NORMAL);
  74.     Cancel := true;
  75.   end
  76.   else
  77.   begin
  78.     Cancel := false;
  79.   end;
  80. end;
  81.  
  82. end.
  83.