unit uViewer;
interface
uses
Windows .......,
ActiveX, mshtml, ShellApi, SHDocVw, AbUnzper, AbArcTyp;
type
TViewer =
class(TForm)
PanelTop: TPanel;
ShowEpub: TTimer;
......
private
{ Private-Deklarationen }
function IsInteger(str:
string): Boolean;
function deldir(dir:
string): Boolean;
function WB_GetScrollPosition(WB: TWebBrowser;
var ScrollPos: TPoint): Boolean;
public
{ Public-Deklarationen }
end;
var
Viewer: TViewer;
implementation
uses uEpub;
// die Unit uEpub aus Teil 2 wird benötigt
{$R *.dfm}
var
//Variablen für die Steuerung im Buch
PageNr, KapitelNr: integer;
MaxPage, ThisPage, MaxLines, VisibleLines, FirstVisibleLine, LastVisibleLine: integer;
//Variable für das Vergrößern und Verkleinern der Schrift
wbZoom: OleVariant;
tempPath:
string;
//Strukturierter Datentyp aus uEpub
cr: contentRec;
procedure TViewer.FormCreate(Sender: TObject);
begin
wbZoom := 100;
PageNr := 1;
KapitelNr := 1;
tempPath := SysUtils.GetEnvironmentVariable('
temp') + '
\unzip\';
//hierhin wird das Epub entzippt
end;
//Erst wird die Applicatin mit dem Webbrowser angezeigt.
//Der Timer verzögert das Laben des Epub, sonst wird die Application erst danach sichtbar
procedure TViewer.ShowEpubTimer(Sender: TObject);
var
UnZip: TAbUnZipper;
// diesesmal benutze ich die Abbrevia-Komponente
s:
string;
i, j, k,
index, posEnd: integer;
WebDoc: HTMLDocument;
WebBody: HTMLBody;
Range: IHTMLTxtRange;
begin
ShowEpub.Interval := 0;
// sonst macht der Timer eine Endlosschleife
//Das Epub wird in das temporäre Verzeichnis entpackt
UnZip:= TAbUnZipper.create(
nil);
//uses AbUnzper
UnZip.FileName:= '
MeinNeuesEbook.epub';
UnZip.BaseDirectory:= ExtractFilePath(tempPath);
UnZip.ExtractOptions := [eoCreateDirs, eoRestorePath];
//uses AbArcTyp
UnZip.ExtractFiles('
*.*');
UnZip.OpenArchive(Form1.filename);
//für ExtractToStream weiter unten
cr.ms := TMemoryStream.Create;
//vor Aufruf von Epub.ParseEpub(filename, cr) initialisieren
Epub.ParseEpub('
MeinNeuesEbook.epub', cr);
//Erste Seite per Navigate anzeigen. Im cr.html-Array aus uEpub stehen alle html-Seiten des Epub zur Verfügung
WB.Navigate(tempPath + cr.opfDir + cr.html[1, 1]);
Application.ProcessMessages;
//statt WB.Navigate werden die restlichen Seiten so angefügt.
//so hat man das komplette Ebook im Webbrowser als eine fortlaufende Seite geladen
for i := low(cr.html)
to high(cr.html)
do
begin
cr.ms.Clear;
UnZip.ExtractToStream(cr.opfDir + cr.html[i,1], cr.ms);
cr.ms.seek(0,sofromBeginning);
SetString(s, PAnsiChar(cr.ms.Memory), cr.ms.Size);
{set string to get memory}
//Utf8Decode führt häufig zu einem leeren String, wenn am Schluss sogenannte "invalide byte sequence" vorhanden sind
//daher Ende der html-Datei bestimmen und string dahinter abschneiden
posEnd := pos('
</html>', s) + Length('
</html>');
s := Utf8Decode(Copy(s, 1, posEnd)) + '
<p> </p>';
//Warten bis eine Seite fertig geladen wurde...
while (WB.ReadyState < READYSTATE_INTERACTIVE)
do Application.ProcessMessages;
if Assigned(WB.Document)
then
begin
//http://www.swissdelphicenter.ch/torry/showcode.php?id=2148
Range := ((WB.Document
as IHTMLDocument2).body
as IHTMLBodyElement).createTextRange;
Range.collapse(False);
Range.pasteHTML(s);
//hier füge ich bei jeder neuen html-Seite ein unsichtbaren Text ekapitel1 bis x ein
//damit kann ich später durch die Kapitel navigieren
Range.pasteHTML('
<span style="color:white">ekapitel' + IntToStr(i) + '
</span><span style="color:black"> </span>');
end;
Application.ProcessMessages;
end;
UnZip.Free;
BerechneSeiten.Interval := 500;
//Seitenzähler aktivieren, ohne Verzögerung Errormeldung
end;
procedure TViewer.WBDocumentComplete(Sender: TObject;
const pDisp: IDispatch;
var URL: OleVariant);
var
RefreshLevel: OleVariant;
begin
//in Delphi7 gibt es ein Problem mit Unicode. Diese Zeilen lösen das Problem leider nur
//bei Seiten die mit Webbrowser.Navigate geladen wurden.
if Assigned(WB)
then
try
IHTMLDocument2(WB.Document).Set_CharSet('
utf-8');
//'utf-8' iso-8859-1 oder 'iso-8859-2'
RefreshLevel := 7;
WB.Refresh2(RefreshLevel);
except
end;
end;
//So kann der Text verkleinert werden
procedure TViewer.BitBtnFontDownsizeClick(Sender: TObject);
begin
wbZoom:= wbZoom - 10;
WB.ExecWB(63, OLECMDEXECOPT_PROMPTUSER, wbZoom);
end;
//und so vergößert werden
procedure TViewer.BitBtnFontUpsizeClick(Sender: TObject);
begin
wbZoom:= wbZoom + 10;
WB.ExecWB(63, OLECMDEXECOPT_PROMPTUSER, wbZoom);
end;
//Ab hier geht es nur noch um das Navigieren im Ebook
procedure TViewer.BitBtnForwardsClick(Sender: TObject);
var
i: integer;
anchor: OleVariant;
begin
//Im Text scrollen, falls die Seite nicht verlassen wurde
if pos(cr.opfDir + cr.html[PageNr, 1], WB.LocationURL)>0
then
WB.OleObject.Document.ParentWindow.ScrollBy(0, WB.Height)
//funktioniert nicht immer: OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop := OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop + WB.Height;
else
WB.GoForward;
//falls Seite über Link verlassen wurde, muss normale Browser-Navigation aktiviert werden
end;
procedure TViewer.BitBtnBackwardsClick(Sender: TObject);
begin
//ist die Url noch diesselbe wie das Epub? Dann Scrollen, sonst Navigieren mit WB.GoBack
if pos(cr.opfDir + cr.html[PageNr, 1], WB.LocationURL) > 0
then
WB.OleObject.Document.ParentWindow.ScrollBy(0, -WB.Height)
//Variante funktioniert nicht immer: OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop := OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop + WB.Height;
else
WB.GoBack;
//falls Seite über Link verlassen wurde, muss normale Browser-Navigation aktiviert werden
end;
//hier kann in einem TEdit mit Namen "edThisPage" direkt zu einer Seite gesprungen werden
procedure TViewer.edThisPageKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
BerechneSeiten.Interval := 0;
if Key <> VK_RETURN
then exit;
if not IsInteger(edThisPage.Text)
then exit;
WB.OleObject.Document.ParentWindow.ScrollBy(0, StrToInt(edThisPage.Text) * WB.Height);
//OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop := OleVariant(WB.Document as IHTMLDocument2).Body.ScrollTop + WB.Height;
BerechneSeiten.Interval := 500;
end;
procedure TViewer.edThisPageEnter(Sender: TObject);
begin
//Der Timer muss unterbrochen werden, sonst kann ich in diesem TEdit edThisPage nichts eingeben
BerechneSeiten.Interval := 0;
end;
procedure TViewer.edThisPageExit(Sender: TObject);
begin
//Bei Verlassen den Timer für die Seitenberechnung wieder starten
BerechneSeiten.Interval := 500;
end;
//Die Kapitelsteuerung. Einfach den unsichtbaren weißen Text ekapitelx suchen
//falls vorher die Scrollbalken benutzt wurden, sorgt die Schleife dafür, dass
//eine ekapitel-Nr unterhab der aktuellen Seite i angesteuert wird
procedure TViewer.BtnKapitelPreviousClick(Sender: TObject);
var
Range: IHTMLTxtRange;
i: integer;
begin
if WB.Busy
then exit;
i := thisPage;
WB.Hide;
//Anzeige wird solange unterbrochen
repeat
if KapitelNr > 2
then Dec(KapitelNr);
Range := ((WB.Document
as IHTMLDocument2).body
as IHTMLBodyElement).createTextRange;
if Range.findText('
ekapitel' + IntToStr(KapitelNr), 1, 0)
then Range.ScrollIntoView(True);
BerechneSeitenTimer(Self);
until (i >= thisPage);
WB.Show;
end;
//Dasselbe rückwärts
procedure TViewer.BtnKapitelNextClick(Sender: TObject);
var
Range: IHTMLTxtRange;
i: integer;
begin
if WB.Busy
then exit;
i := thisPage;
WB.Hide;
repeat
if KapitelNr < High(cr.html)
then Inc(KapitelNr);
Range := ((WB.Document
as IHTMLDocument2).body
as IHTMLBodyElement).createTextRange;
if Range.findText('
ekapitel' + IntToStr(KapitelNr), 1, 0)
then begin Range.ScrollIntoView(True); WB.OleObject.Document.ParentWindow.ScrollBy(0, WB.Height - 50);
{Range.select} end;
BerechneSeitenTimer(Self);
until (i <= thisPage);
WB.Show;
end;
//Da der TWebbrowser kein Scrollevent hat, wird einfach regelmäßig die Seitenzahl neu berechnet
procedure TViewer.BerechneSeitenTimer(Sender: TObject);
var
px: TPoint;
begin
PanelHide.Visible := false;
WB_GetScrollPosition(WB, px);
FirstVisibleLine := px.y;
VisibleLines := WB.Height;
MaxLines := ((WB.Document
as IHTMLDocument2).body
as IHTMLElement2).ScrollHeight;
ThisPage := ((FirstVisibleLine+1)
div VisibleLines) + 1;
//+1 sonst 0 möglich
MaxPage := MaxLines
div VisibleLines;
edThisPage.Text := IntToStr(ThisPage);
lbSeite.Caption := '
Seite ' + IntToStr(ThisPage) + '
von ' + IntToStr(MaxPage);
//'Seiten: ' + IntToStr(MaxPage); //lbSeite.Caption :=
end;
//temporäre Dateien wieder löschen
procedure TViewer.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
WB.Navigate('
about:blank');
//Webbrowser geleert. Jetzt temporäre Daten löschen. Achtung: Verzeichnis ohne Backslash! = ExcludeTrailingPathDelimiter(tempPath)
While (WB.ReadyState < READYSTATE_INTERACTIVE)
do Application.ProcessMessages;
if Assigned(WB.Document)
then if deldir(ExcludeTrailingPathDelimiter(tempPath)) = false
then ShowMessage('
Temporäre Dateien in ' + tempPath + '
konnten nicht entfernt werden.'+#13+'
Bitte manuell löschen');
end;
{***********************************************************************************************}
{* Webbrowser Scrollbar X,Y Position ermitteln: *}
{* Quelle: http://www.delphipraxis.net/110089-twebbrowser-scrollposition-ermitteln.html *}
{***********************************************************************************************}
function TViewer.WB_GetScrollPosition(WB: TWebBrowser;
var ScrollPos: TPoint): Boolean;
// Scrollbar X,Y Position der ListView ermitteln
function WB_GetLVScrollPosition(WB: TWebBrowser;
var ScrollPos: TPoint): Boolean;
var lpsi: TScrollInfo; WND, WndLV: HWND;
begin Result := False;
{SysListView32 Child vom TWebBrowser suchen} WndLV := 0; Wnd := GetNextWindow(WB.Handle, GW_CHILD);
while (WndLV = 0)
and (WND <> 0)
do begin WndLV := FindWindowEx(Wnd, 0, '
SysListView32',
nil); Wnd := GetNextWindow(Wnd, GW_CHILD)
end;
if WndLV <> 0
then {SysListView32 gefunden} begin {TScrollInfo initialisieren} FillChar(lpsi, SizeOf(lpsi), 0);
with lpsi
do begin cbSize := SizeOf(lpsi); fMask := SIF_POS;
end;
{ScrollInfos der vertikalen ScrollBar ermitteln} if GetScrollInfo(WndLV, SB_VERT, lpsi)
then begin ScrollPos.Y := lpsi.nPos;
{ScrollInfos der horizontalen ScrollBar ermitteln} if GetScrollInfo(WndLV, SB_HORZ, lpsi)
then begin ScrollPos.X := lpsi.nPos; Result := True;
end;
end;
end;
end;
// Scrollbar X,Y Position des HTML Documents ermitteln
function WB_GetDOCScrollPosition(WB: TWebBrowser;
var ScrollPos: TPoint): Boolean;
var IDoc: IHTMLDocument2; IDoc3: IHTMLDocument3; IElement: IHTMLElement;
begin ScrollPos := Point(-1, -1); Result := False;
if Assigned(WB.Document)
and (Succeeded(WB.Document.QueryInterface(IHTMLDocument2, IDoc)))
then begin IDoc := WB.Document
as IHTMLDocument2;
if Assigned(IDoc)
and Assigned((IHTMLDocument2(IDoc).Body))
then begin if (IDoc.QueryInterface(IHTMLDocument3, IDoc3) = S_OK)
then if Assigned(IDoc3)
then IElement := IDoc3.get_documentElement;
if (Assigned(IElement))
and (Variant(IDoc).DocumentElement.scrollTop = 0)
then ScrollPos.Y := IHTMLDocument2(IDoc).Body.getAttribute('
ScrollTop', 0)
else ScrollPos.Y := Variant(IDoc).DocumentElement.scrollTop;
if Assigned(IElement)
and (Variant(IDoc).DocumentElement.scrollLeft = 0)
then ScrollPos.X := IHTMLDocument2(IDoc).Body.getAttribute('
ScrollLeft', 0)
else ScrollPos.X := Variant(IDoc).DocumentElement.scrollLeft
end; Result := (ScrollPos.X <> -1)
and (ScrollPos.Y <> -1)
end;
end;
begin
Result := WB_GetDOCScrollPosition(WB, ScrollPos);
if not Result
then Result := WB_GetLVScrollPosition(WB, ScrollPos);
end;
{***********************************************************************************************}
function TViewer.IsInteger(str :
String): Boolean;
var
i: integer;
begin
Result:=true;
try
i := StrToInt(str);
except
Result:=false;
end;
end;
// mit deldir wird das temporäre entpackte Epub bei Beenden der Application wieder gelöscht
function TViewer.deldir(dir:
string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos
do
begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT
or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
end.