Afficher page HTML dans Delphi

**yamino** · 26/12/2007, 10h17

Bonjour à tous et Joyeuses Fêtes de Fin d'Année,

J'utilise un DBGrid qui m'affiche une liste de médicaments et je voudrais qu'en fonction du médicament sélectionné afficher dans une page html la composition, la posologie, ...

J'ai vu le composant TWebBrowser mais je ne sais pas s'il y a la possibilité d'intégrer directement du code html sans passer par un fichier texte...

**ShaiLeTroll** · 26/12/2007, 12h25

Tient, j'ai écrit cette fonction pour modifier le HTML du TWebBrowser sans passer par un fichier

Avec IE 4 ou 5, c'est facile, mais depuis la version 6 fourni avec XP, cela plante, j'ai donc bidouillé une variante WB_INTERFACED_BODY

faut appeler InitBrowser pour créer les interfaces nécessaires, puis appeler WriteBrowserBody pour remplacer le Body par un autre ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
procedure InitBrowser(const WebBrowser: TWebBrowser);
{$IFDEF WB_INTERFACED_BODY}
var
   Doc: IHTMLDocument2;
   EmptyBodyText: WideString;
   EmptyBodyVarData: PSafeArray;
begin
     try
        // "Connexion" sur une Page Vierge
        WebBrowser.Navigate('about:blank');
        // Stockage du Document dans une Variable Temporaire
        Doc := WebBrowser.Document as IHTMLDocument2;
        // Texte d'un Corps Vierge
        EmptyBodyText := '<html><body></body></html>';
 
        // VarArrayOf([InnerHtm]) - On Obtient un Tableau de Variant d'un Seul Elément
        // TVarData(...) - On Obtient la forme système d'un Variant
        // TVarData(...).VArray - On Obtient les Données du Tableau sous la Forme d'un Pointeur de TVarArray (PVarArray)
        // PSafeArray(...) - On Transtype le PVarArray en PSafeArray
        EmptyBodyVarData := PSafeArray(TVarData(VarArrayOf([EmptyBodyText])).VArray);
 
 
        Doc.Open('about:blank', '_self', '', True);
        Doc.Write(EmptyBodyVarData);
        Doc.Close();
     except
           Exit;
     end;
end;
{$ELSE}
var
   URL, Flags, Target, Post, Header : OleVariant;
begin
     try
        WebBrowser.Navigate('about:<html><head></head><body></body></html>', Flags, Target, Post, Header);
     except
           Exit;
     end;
end;
{$ENDIF}
 
// -----------------------------------------------------------------------------
procedure WriteBrowserBody(const WebBrowser: TWebBrowser; const Body: WideString);
{$IFDEF WB_INTERFACED_BODY}
var
   Doc : IHTMLDocument2;
   InnerHtm: WideString;
begin
     try
        // Stockage du Document dans une Variable Temporaire
        Doc := WebBrowser.Document as IHTMLDocument2;
        // Texte d'un Corps et de son Contenu
        InnerHtm := '<html><body>' + Body + '</body></html>';
        // VarArrayOf([InnerHtm]) - On Obtient un Tableau de Variant d'un Seul Elément
        // TVarData(...) - On Obtient la forme système d'un Variant
        // TVarData(...).VArray - On Obtient les Données du Tableau sous la Forme d'un Pointeur de TVarArray (PVarArray)
        // PSafeArray(...) - On Transtype le PVarArray en PSafeArray
 
        Doc.Open('about:blank', '_self', '', True);
        Doc.Write(PSafeArray(TVarData(VarArrayOf([InnerHtm])).VArray));
        Doc.Close();
     except
           Exit;
     end;
end;
{$ELSE}
begin
     try
        WebBrowser.OleObject.Document.Body.InnerHTML := Body;
     except
           Exit;
     end;
end;
{$ENDIF}

**yamino** · 26/12/2007, 13h38

Bonjour ShaiLeTroll et merci pour ta réponse

J'ai essayé ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
InitBrowser(myWebBrowser);
WriteBrowserBody(myWebBrowser, '<b><i>Petit test</i></b>');

mais il se plante sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

WebBrowser.OleObject.Document.Body.InnerHTML := Body;

La variable Body contenant : <b><i>Petit test</i></b>

Je me suis planté quelque part ???

**ShaiLeTroll** · 26/12/2007, 15h28

Comme, je l'ai dit cela dépend de la version de IE, essaye en ajoute au début de l'unité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

{$DEFINE WB_INTERFACED_BODY}

Faudrait un jour, que je fasse l'effort de tester la version en cours du système au lieu de directive de compilation

Si cela ne fonctionne toujours pas, vu que le TWebBrowser fonctionne en Asynchrone, c'est parfois trop lent, IE ne réagit pas assez vite (parce que l'on ne lui donne pas le temps non plus), tu peux essayer d'ajouter WaitWebAssigned, en général, 10 ms pour un about:blank suffit, ainsi on laisse IE charger en mémoire les objets ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
InitBrowser(myWebBrowser);
WaitWebAssigned(myWebBrowser, 10);
WriteBrowserBody(myWebBrowser, '<b><i>Petit test</i></b>');

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
// -----------------------------------------------------------------------------
procedure WaitWebAssigned(const WebBrowser: TWebBrowser; TimeOut: Cardinal);
var
   StartTime, PointTime(*, DiffTime*): Cardinal;
begin
     try
        StartTime := GetTickCount();
        repeat
          Sleep(1); // Il laisse une Milliseconde Entière aux Autres Processus
          Application.ProcessMessages();
          PointTime := GetTickCount();
        // Continue tant que l'Objet est vide ou que le Délai Maximum soit écoulé
        until not VarIsEmpty(WebBrowser.OleObject.Document) or (PointTime >= StartTime+TimeOut);
 
        if not VarIsEmpty(WebBrowser.OleObject.Document) then begin
           StartTime := GetTickCount();
           repeat
             Sleep(1); // Il laisse une Milliseconde Entière aux Autres Processus
             Application.ProcessMessages();
             PointTime := GetTickCount();
           until not VarIsEmpty(WebBrowser.OleObject.Document.Body) or (PointTime >= StartTime+TimeOut);
        end;
     except
        ShowMessage('L''Affichage HTML ne sera pas disponible avant quelques secondes !');
     end;
end;

**yamino** · 26/12/2007, 15h33

Je viens de trouver ceci qui, à première vue, répond à mes besoins...

Merci pour ton aide

Afficher page HTML dans Delphi

Web & réseau Delphi

Discussions similaires

Partager

Partager