Subversion Repositories spacemission

Rev

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

Rev Author Line No. Line
63 daniel-mar 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);
68 daniel-mar 15 
  private
16 
    FDirectory: string;
63 daniel-mar 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
67 daniel-mar 28 
  MarkDownProcessor, ShellAPI, Global;
63 daniel-mar 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
79 daniel-mar 37 
    WebBrowser1.Navigate('about:blank'); // do not localize
63 daniel-mar 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;
67 daniel-mar 48 
  slHtml, slCss: TStringList;
49 
  cssFile: string;
63 daniel-mar 50 
begin
68 daniel-mar 51 
  FDirectory := ExtractFilePath(AMarkDownFile);
67 daniel-mar 52 
  slHtml := TStringList.Create();
53 
  slCss := TStringList.Create();
64 daniel-mar 54 
  try
67 daniel-mar 55 
    slHtml.LoadFromFile(AMarkDownFile);
79 daniel-mar 56 
    cssFile := IncludeTrailingPathDelimiter(FDirectory) + 'Style.css'; // do not localize
67 daniel-mar 57 
    if FileExists(cssFile) then
58 
      slCss.LoadFromFile(cssFile);
64 daniel-mar 59 
    md := TMarkdownProcessor.CreateDialect(mdCommonMark);
60 
    try
61 
      //md.AllowUnsafe := true;
67 daniel-mar 62 
      ShowHTMLHelp(
79 daniel-mar 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
67 daniel-mar 69 
        md.process(UTF8ToString(RawByteString(slHtml.Text)))+
79 daniel-mar 70 
        '</body>'+                                                               // do not localize
71 
        '</html>');                                                              // do not localize
64 daniel-mar 72 
    finally
73 
      FreeAndNil(md);
74 
    end;
75 
  finally
67 daniel-mar 76 
    FreeAndNil(slHtml);
77 
    FreeAndNil(slCss);
64 daniel-mar 78 
  end;
63 daniel-mar 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
79 daniel-mar 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
63 daniel-mar 88 
  begin
89 
    // Links in default Browser anzeigen
79 daniel-mar 90 
    ShellExecute(handle, 'open', PChar(string(URL)), '', '', SW_NORMAL);  // do not localize
63 daniel-mar 91 
    Cancel := true;
92 
  end
79 daniel-mar 93 
  else if SameText(ExtractFileExt(URL), '.md') then // do not localize
67 daniel-mar 94 
  begin
79 daniel-mar 95 
    if SameText(Copy(URL,1,6), 'about:') then // do not localize
68 daniel-mar 96 
      ShowMarkDownHelp(IncludeTrailingPathDelimiter(FDirectory) + Copy(URL,7,Length(URL)))
67 daniel-mar 97 
    else
98 
      ShowMarkDownHelp(URL);
99 
    Cancel := true;
100 
  end
63 daniel-mar 101 
  else
102 
  begin
103 
    Cancel := false;
104 
  end;
105 
end;
106 
 
107 
end.