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