//Advanced Delphi Systems Code: ads_RBXtraDev_HTML
unit ads_RBXtraDev_HTML;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download Units
Description: ads_RBXtraDev_HTML.pas
This unit contains the following routines.
THTMLONEPAGEDevice.AddImageFile
THTMLONEPAGEDevice.EndBand
THTMLONEPAGEDevice.EndJob
THTMLONEPAGEDevice.EndPage
THTMLONEPAGEDevice.GetImageBase
THTMLONEPAGEDevice.GetImageFile
THTMLONEPAGEDevice.LettersToNumbers
THTMLONEPAGEDevice.MakeHTMLPageNav
THTMLONEPAGEDevice.NumToLetters
THTMLONEPAGEDevice.ppDrawCommandToString
THTMLONEPAGEDevice.ProcessBand
THTMLONEPAGEDevice.StartBand
THTMLONEPAGEDevice.StartJob
THTMLONEPAGEDevice.StartPage
THTMLONEPAGEDevice.Write
THTMLONEPAGEDevice.WriteAnImage_ads
THTMLONEPAGEDevice.WriteBarCodeImage_ads
THTMLONEPAGEDevice.WriteImage_ads
THTMLONEPAGEDevice.WriteImageDetail_ads
THTMLONEPAGEDevice.WriteLineImage_ads
THTMLONEPAGEDevice.WriteShapeImage_ads
THTMLONEPAGEDevice.WriteZoomImage_ads
*)
interface
uses
Windows,
//ads_RBXtraDev,
Classes,
Graphics,
ppDevice,
TXtraDev
;
{ THTMLONEPAGEDevice }
Type
//THTMLONEPAGEDevice = class(TppFileDevice)
THTMLONEPAGEDevice = class(TExtraDevice)
private
BandWidth : Integer;
BaseFont : String;
BaseSize : Integer;
DestStream: TFileStream;
ImageArray: Array of Array of String;
ImageBase : String;
Images : TStringList;
JobEnd : Double;
JobRun : Double;
JobStart : Double;
OutFile : String;
Page1End : Double;
PageMax : Integer;
sgHead : String;
Styles : TStringList;
TopOffset : Integer;
TotWidth : Integer;
WebPages : TStringList;
protected
Function GetImageBase: String;
function GetImageFile(ImageType,ImageSpec:String): String;
function LettersToNumbers(Letters: String): Integer;
Function MakeHTMLPageNav(PageNum: Integer): String;
function NumToLetters(num: Integer): String;
function ppDrawCommandToString(ppDrawCommand: TppDrawCommand): string;
function WriteImage_ads(B: TBitmap;ImageType,ImageSpec: String): String;
procedure AddImageFile(FileName,ImageType,ImageSpec:String);
procedure EndBand; override;
procedure EndPage; override;
procedure ProcessBand(Band: TReportBand); override;
procedure StartBand; override;
procedure StartPage; override;
procedure Write(Buffer: String); override;
Procedure WriteAnImage_ads(var ImgFile: String;Itm:TReportItem;Height,Width:Integer);
Procedure WriteBarCodeImage_ads(var ImgFile: String;Itm:TReportItem;Height,Width:Integer);
procedure WriteImageDetail_ads(var ImgFile: String;ImageType: String;Itm: TReportItem;Height,Width: Integer);
Procedure WriteLineImage_ads(var ImgFile: String;Itm:TReportItem;Height,Width:Integer);
Procedure WriteShapeImage_ads(var ImgFile: String;Itm:TReportItem;Height,Width:Integer);
Procedure WriteZoomImage_ads(var ImgFile: String;Itm:TReportItem);
public
class function DefaultExt: String; override;
class function DefaultExtFilter: String; override;
class function DeviceDescription(aLanguageIndex: Longint): String; override;
class function DeviceName: String; override;
procedure EndJob; override;
procedure StartJob; override;
end;
implementation
Uses
ads_RBTXtraDevUtils,
ExtCtrls,
JPEG,
ppDrwCmd,
ppTypes,
ppUtils,
SysUtils
;
var FOptions: TExtraOptions = Nil;
{ HTMLOnePage Device }
class function THTMLONEPAGEDevice.DeviceName: String;
begin
Result := 'HTMLOnePageFile';
end;
class function THTMLONEPAGEDevice.DefaultExt: String;
begin
Result := 'HTM';
end;
class function THTMLONEPAGEDevice.DefaultExtFilter: String;
begin
Result := 'HTML files|*.HTM|All files|*.*';
end;
class function THTMLONEPAGEDevice.DeviceDescription(aLanguageIndex: Longint): String;
begin
Result := 'HTML File';
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.Write(Buffer: String);
begin
if Length(Buffer) > 0 then begin
DestStream.Write(Buffer[1], Length(Buffer));
end;
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.StartJob;
begin
inherited;
BaseFont := 'Arial';
BaseSize := 10;
ImageBase := '';
JobStart := now();
JobEnd := JobStart;
JobRun := JobEnd-JobStart;
Page1End := 0.00;
PageMax := 0;
end;
//
Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.EndJob;
var
ZapFile: Boolean;
begin
ZapFile := (FileStream.Size = 0);
inherited;
if ZapFile then begin
DeleteFile(FileName);
end;
ImageBase := '';
JobEnd := now();
JobRun := JobEnd-JobStart;
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.StartPage;
begin
inherited;
TopOffset := 0;
If Not Assigned(WebPages) Then WebPages := TStringList.Create();
If Not Assigned(Styles) Then Styles := TStringList.Create();
If Not Assigned(Images) Then Images := TStringList.Create();
If FPageNo = 1 Then
Begin
OutFile := FileName;
SetLength(ImageArray,0,3);
Styles.Clear;
With WebPages Do
Begin
Clear;
WebPages.SaveToFile(OutFile+'l');
Add(
''+#13+
''+#13+
'' + Page.DocumentName + '' +#13+
''+#13+
'');
WebPages.Add('');
WebPages.SetText(PChar(sgHead+Styles.Text+WebPages.Text));
WebPages[3] := '';
JobEnd := now();
JobRun := JobEnd-JobStart;
WebPages.Add('');
WebPages.SaveToFile(OutFile+'l');
WebPages.Free;
WebPages := nil;
If WebPages <> nil Then;
Styles.Free;
Styles := nil;
If Styles <> nil Then;
Images.Free;
Images := nil;
If Images <> nil Then;
SetLength(ImageArray,0,3);
End;
inherited;
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.StartBand;
Var
inIndex : Integer;
sgStyle : String;
begin
inherited;
TotWidth := 0;
BandWidth := ppToScreenPixels(Page.PageDef.mmWidth, utMMThousandths, pprtHorizontal, Nil);
sgStyle := '{';
sgStyle := sgStyle + 'width: '+IntToStr(BandWidth)+';';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
sgStyle := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle);
sgStyle := ' CLASS='+NumToLetters(Styles.Count-1);
End;
WebPages.Add('');
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.EndBand;
Var
inIndex : Integer;
sgStyle : String;
begin
If (BandWidth - TotWidth) > 0 Then
Begin
sgStyle := '{';
sgStyle := sgStyle + 'width: '+IntToStr(BandWidth - TotWidth)+';';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
sgStyle := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle);
sgStyle := ' CLASS='+NumToLetters(Styles.Count-1);
End;
WebPages.Add('');
End;
WebPages.Add('');
WebPages.Add('
');
inherited;
end;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.ProcessBand(Band: TReportBand);
var
Buffer : String;
Height : Integer;
I : Integer;
ImgFile : String;
inIndex : Integer;
Itm : TReportItem;
Left : Integer;
LeftOffset: Integer;
sgHeight : String;
sgStyle : String;
sgStyle2 : String;
sgWidth : String;
Top : Integer;
Txt : TppDrawText;
Width : Integer;
//ZoomImg : String;
begin
inherited;
LeftOffset := 0;
For I := 0 to Band.Count - 1 Do
Begin
sgHeight:= '';
sgWidth := '';
sgStyle := '{';
Itm := TReportItem(Band[I]);
Buffer := '';
Left := ppToScreenPixels(Itm.Left , utMMThousandths, pprtHorizontal, Nil);
Width := ppToScreenPixels(Itm.Width , utMMThousandths, pprtHorizontal, Nil);
Top := ppToScreenPixels(Itm.Top , utMMThousandths, pprtVertical , Nil);
Height := ppToScreenPixels(Itm.Height, utMMThousandths, pprtVertical , Nil);
If Top >= TopOffset Then
Begin
If Top - TopOffset > 0 Then
Begin
sgStyle := '{';
sgStyle := sgStyle + 'height: '+IntToStr(Top - TopOffset)+';';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
sgStyle := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle);
sgStyle := ' CLASS='+NumToLetters(Styles.Count-1);
End;
WebPages.Add('|
');
sgStyle := '{';
End;
sgStyle := '{';
sgStyle := sgStyle + 'vertical-align: top;';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
sgStyle := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle);
sgStyle := ' CLASS='+NumToLetters(Styles.Count-1);
End;
Buffer := '';
sgStyle := '{';
TopOffset := Top + Height;
End
Else
Begin
If I=0 Then Buffer := ''+#13;
End;
If (Top + Height) > TopOffset Then TopOffset := Top + Height;
If Itm.ItemType in [riLine, riImage, riText, riShape, riRTF, riBarCode] Then
Begin
sgStyle := '{';
sgStyle := sgStyle + 'width: '+IntToStr(Left - LeftOffset)+';';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
sgStyle := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle);
sgStyle := ' CLASS='+NumToLetters(Styles.Count-1);
End;
Buffer := Buffer + '';
sgStyle := '{';
TotWidth := TotWidth + (Left - LeftOffset);
sgStyle := sgStyle + 'width: '+IntToStr(Width+1)+';';
sgStyle := sgStyle + 'height: '+IntToStr(Height)+';';
Buffer := Buffer + ' -1 Then
Begin
sgStyle2 := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle2);
sgStyle2 := ' CLASS='+NumToLetters(Styles.Count-1);
End;
Buffer := Buffer + '>
';
sgStyle2 := '{';
End;
// Process BarCodes
If Itm.ItemType = riBarCode Then
Begin
WriteBarCodeImage_ads(
ImgFile, //var ImgFile: String;
Itm , //Itm:TReportItem;
Height , //Height,
Width );//Width:Integer);
sgStyle2 := '{';
sgStyle2 := sgStyle2 + 'height: '+IntToStr(Height)+';';
sgStyle2 := sgStyle2 + 'width: ' +IntToStr(Width)+';';
sgStyle2 := sgStyle2 + 'border: 0;';
sgStyle2 := sgStyle2 + '}';
inIndex := Styles.IndexOf(sgStyle2);
If inIndex <> -1 Then
Begin
sgStyle2 := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle2);
sgStyle2 := ' CLASS='+NumToLetters(Styles.Count-1);
End;
Buffer := Buffer + '>';
sgStyle2 := '{';
End;
(*
// Process Shapes
If Itm.ItemType = riShape Then
Begin
WriteShapeImage_ads(
ImgFile, //var ImgFile: String;
Itm , //Itm:TReportItem;
Height , //Height,
Width );//Width:Integer);
sgStyle2 := '{';
sgStyle2 := sgStyle2 + 'height: '+IntToStr(Height)+';';
sgStyle2 := sgStyle2 + 'width: ' +IntToStr(Width)+';';
sgStyle2 := sgStyle2 + 'border: 0;';
sgStyle2 := sgStyle2 + '}';
inIndex := Styles.IndexOf(sgStyle2);
If inIndex <> -1 Then
Begin
sgStyle2 := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle2);
sgStyle2 := ' CLASS='+NumToLetters(Styles.Count-1);
End;
Buffer := Buffer + '>';
sgStyle2 := '{';
End;
*)
// Process RichText
if Itm.ItemType = riRTF then begin
Buffer := Buffer + '>' + RTF2HTML(TppDrawRichText(Itm.DrawCmd));
end;
// Process Images
If Itm.ItemType = riImage Then
Begin
If Copy(Buffer,Length(Buffer),1) <> '>' Then
Buffer := Buffer + '>';
WriteAnImage_ads(
ImgFile, //var ImgFile: String;
Itm , //Itm:TReportItem;
Height , //Height,
Width );//Width:Integer);
sgStyle2 := '{';
sgStyle2 := sgStyle2 + 'height: '+IntToStr(Height)+';';
sgStyle2 := sgStyle2 + 'width: ' +IntToStr(Width)+';';
sgStyle2 := sgStyle2 + 'border: 0;';
sgStyle2 := sgStyle2 + '}';
inIndex := Styles.IndexOf(sgStyle2);
If inIndex <> -1 Then
Begin
sgStyle2 := ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Styles.Add(sgStyle2);
sgStyle2 := ' CLASS='+NumToLetters(Styles.Count-1);
End;
(*
sgStyle2 := '{';
If ExtraDevices.HTML.ZoomableImages Then
Begin
WriteZoomImage_ads(
ZoomImg, //var ImgFile : String;
Itm );//Itm :TReportItem;
Buffer := Buffer + '';
Buffer := Buffer + '>';
Buffer := Buffer + '';
End
Else
Begin
*)
If Copy(Buffer,Length(Buffer),1) <> '>' Then
Buffer := Buffer + '>';
Buffer := Buffer + '';
//End;
End;
If Itm.ItemType = riText Then
Begin
Txt := TppDrawText(Itm.DrawCmd);
Case Txt.Alignment of
taLeftJustify : sgStyle := sgStyle + 'text-align: left;';
taCenter : sgStyle := sgStyle + 'text-align: center;';
taRightJustify : sgStyle := sgStyle + 'text-align: right;';
End;
If Txt.Transparent Then
Begin
sgStyle := sgStyle + 'background-color: transparent;';
End
Else
Begin
sgStyle := sgStyle + 'background-color: '+ColorToHex(Txt.Color)+';';
End;
sgStyle := sgStyle + 'font-size: ' + IntToStr(Txt.Font.Size) + 'pt;';
sgStyle := sgStyle + 'font-family: ' + Txt.Font.Name + ';';
sgStyle := sgStyle + 'color: ' + ColorToHex(Txt.Font.Color) + ';';
If fsItalic in Txt.Font.Style Then sgStyle := sgStyle + 'font-style: italic;';
If fsBold in Txt.Font.Style Then sgStyle := sgStyle + 'font-weight: bold;';
If fsUnderline in Txt.Font.Style Then sgStyle := sgStyle + 'text-decoration: underline;';
sgStyle := sgStyle + '}';
inIndex := Styles.IndexOf(sgStyle);
If inIndex <> -1 Then
Begin
Buffer := Buffer + ' CLASS='+NumToLetters(inIndex);
End
Else
Begin
Buffer := Buffer + ' CLASS='+NumToLetters(Styles.Count);
Styles.Add(sgStyle);
End;
Buffer := Buffer + '>';
If Txt.IsMemo or (Txt.WordWrap = True) Then
Begin
Buffer := Buffer + Replace(HTMLEncode(Txt.WrappedText.Text), #13, '
');
End
Else
Begin
Buffer := Buffer + HTMLEncode(Txt.Text);
End;
End;
If Itm.ItemType in [riLine, riImage, riText, riShape, riRTF, riBarCode] Then
Begin
Buffer := Buffer + '';
WebPages.Add(Buffer);
LeftOffset := Left + Width;
End;
End;
End;
//Unit Description UnitIndex Master Index
function THTMLONEPAGEDevice.WriteImage_ads(
B : TBitmap;
ImageType : String;
ImageSpec : String): String;
var
N : Integer;
J : TJPEGImage;
sgBase : String;
begin
Result := GetImageFile(ImageType,ImageSpec);
If Result <> '' Then Exit;
sgBase := GetImageBase;
Result := sgBase + FormatFloat('0000', FImageNo) + '.JPG';
If Images.IndexOf(Result) <> -1 Then Exit;
If FileExists(ExtractFilePath(FileName) + Result) Then Exit;
J := TJPEGImage.Create;
Try
J.Assign(B);
N := ImageIndex(J, Result);
If N = -1 Then
Begin
Inc(FImageNo);
Try
J.SaveToFile(ExtractFilePath(FileName) + Result);
Images.Add(Result);
AddImageFile(Result,ImageType,ImageSpec);
Except
End;
End
Else
Begin
Result := TImageCRC(ImageList[N]).FileName;
If Images.IndexOf(Result)=-1 Then Images.Add(Result);
End;
Finally
J.Free;
End;
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteLineImage_ads(
var ImgFile : String;
Itm :TReportItem;
Height,Width:Integer);
begin
WriteImageDetail_ads(
ImgFile , //var ImgFile : String;
'LINEIMAGE' , //ImageType : String;
Itm , //Itm : TReportItem;
Height , //Height : Integer;
Width );//Width : Integer);
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteBarCodeImage_ads(
var ImgFile : String;
Itm :TReportItem;
Height,Width:Integer);
begin
WriteImageDetail_ads(
ImgFile , //var ImgFile : String;
'BARCODEIMAGE', //ImageType : String;
Itm , //Itm : TReportItem;
Height , //Height : Integer;
Width );//Width : Integer);
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteImageDetail_ads(
var ImgFile : String;
ImageType : String;
Itm : TReportItem;
Height : Integer;
Width : Integer);
Var
B : TBitmap;
ImageSpec : String;
inCounter : Integer;
lst : TStringList;
sgObject : String;
begin
lst := TStringList.Create();
Try
lst.SetText(PChar(ppDrawCommandToString(Itm.DrawCmd)));
For inCounter := 0 To lst.Count - 1 Do
Begin
lst[inCounter] := Trim(lst[inCounter]);
lst[inCounter] := StringReplace(lst[inCounter],' = ','=',[]);
End;
lst.Values['Top'] := '0';
lst.Values['Left'] := '0';
sgObject := lst.Text;
Finally
lst.Free;
End;
ImageType := UpperCase(ImageType);
ImageSpec := '0_0_'+IntToStr(Width)+'_'+IntToStr(Height)+'_'+sgObject;
ImgFile := GetImageFile(ImageType,ImageSpec);
If ImgFile <> '' Then Exit;
ImgFile := GetImageBase + FormatFloat('0000', FImageNo) + '.JPG';
If Images.IndexOf(ImgFile) <> -1 Then Exit;
If FileExists(ExtractFilePath(FileName)+ImgFile) Then Exit;
B := TBitmap.Create;
Try
B.Width := Width;
B.Height := Height;
B.PixelFormat := ExtraDevices.HTML.PixelFormat;
If ImageType = 'LINEIMAGE' Then
Begin
DrawLine(B.Canvas, TppDrawLine(Itm.DrawCmd), Rect(0, 0, Width, Height));
End
Else
Begin
If ImageType = 'SHAPEIMAGE' Then
Begin
DrawShape(B.Canvas, TppDrawShape(Itm.DrawCmd), Rect(0, 0, Width, Height));
End
Else
Begin
If ImageType = 'BARCODEIMAGE' Then
Begin
DrawBarCode(B.Canvas, TppDrawBarCode(Itm.DrawCmd), Rect(0, 0, Width, Height));
End
Else
Begin
If ImageType = 'PICTURE' Then
Begin
DrawImage(B, TppDrawImage(Itm.DrawCmd), Rect(0, 0, Width, Height), True, False);
End;
End;
End;
End;
ImgFile := WriteImage_ads(B,ImageType,ImageSpec);
Finally
B.Free;
End;
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteShapeImage_ads(
var ImgFile : String;
Itm :TReportItem;
Height,Width:Integer);
begin
WriteImageDetail_ads(
ImgFile , //var ImgFile : String;
'SHAPEIMAGE' , //ImageType : String;
Itm , //Itm : TReportItem;
Height , //Height : Integer;
Width );//Width : Integer);
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteAnImage_ads(
var ImgFile : String;
Itm :TReportItem;
Height,Width:Integer);
begin
WriteImageDetail_ads(
ImgFile , //var ImgFile : String;
'PICTURE' , //ImageType : String;
Itm , //Itm : TReportItem;
Height , //Height : Integer;
Width );//Width : Integer);
end;
//Unit Description UnitIndex Master Index
Procedure THTMLONEPAGEDevice.WriteZoomImage_ads(
var ImgFile : String;
Itm :TReportItem);
var
B : TBitmap;
begin
ImgFile := GetImageBase + FormatFloat('0000', FImageNo) + '.JPG';
If Images.IndexOf(ImgFile) <> -1 Then Exit;
If FileExists(ExtractFilePath(FileName)+ImgFile) Then Exit;
B := TBitmap.Create;
Try
B.PixelFormat := ExtraDevices.HTML.PixelFormat;
DrawImage(B, TppDrawImage(Itm.DrawCmd), Rect(0, 0, TppDrawImage(Itm.DrawCmd).Picture.Width, TppDrawImage(Itm.DrawCmd).Picture.Height), True, True);
ImgFile := WriteImage_ads(B,'JUMPIMAGE','');
Finally
B.Free;
End;
end;
//Unit Description UnitIndex Master Index
function THTMLONEPAGEDevice.GetImageBase: String;
Var
inPos : Integer;
begin
Result := 'IMG';
If ImageBase <> '' Then
Begin
Result := ImageBase;
Exit;
End;
If FileName = '' Then Exit;
ImageBase := ExtractFileName(FileName);
inPos := Pos('.',ImageBase);
If inPos > 0 Then ImageBase := Copy(ImageBase,1,inPos-1);
Result := ImageBase;
End;
//Unit Description UnitIndex Master Index
function THTMLONEPAGEDevice.ppDrawCommandToString(ppDrawCommand: TppDrawCommand): string;
var
BinStream: TMemoryStream;
StrStream: TStringStream;
s : string;
begin
Result := '';
Try
BinStream := TMemoryStream.Create;
Try
StrStream := TStringStream.Create(s);
Try
BinStream.WriteComponent(TComponent(ppDrawCommand));
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result:= StrStream.DataString;
Finally
StrStream.Free;
End;
Finally
BinStream.Free;
End;
Except
End;
End;
//Unit Description UnitIndex Master Index
function THTMLONEPAGEDevice.GetImageFile(ImageType,ImageSpec:String): String;
Var
inCounter : Integer;
sgFile : String;
begin
(*
'LINEIMAGE'
'BARCODEIMAGE'
'SHAPEIMAGE'
'PICTURE'
'JUMPIMAGE'
*)
Result := '';
ImageType := UpperCase(ImageType);
ImageSpec := UpperCase(ImageSpec);
If ImageType = 'JUMPIMAGE' Then Exit;
sgFile := '';
For inCounter := 0 To Length(ImageArray) - 1 Do
Begin
If ImageArray[inCounter,1] = ImageType Then
Begin
If ImageArray[inCounter,2] = ImageSpec Then
Begin
sgFile := GetImageBase + FormatFloat('0000', inCounter) + '.JPG';
Break;
End;
End;
End;
Result := sgFile;
end;
//Unit Description UnitIndex Master Index
Function THTMLONEPAGEDevice.NumToLetters(num: Integer): String;
Var
sgChar : String;
inLen : Integer;
inMod : Integer;
inInt : Integer;
Begin
Result := '';
sgChar := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
inLen := Length(sgChar);
If num <= inLen Then
Begin
Result := Copy(sgChar,num,1);
Exit;
End;
inMod := num mod inLen;
inInt := num div inLen;
If inInt <= inLen Then
Begin
Result := Copy(sgChar,inInt,1)+Copy(sgChar,inMod,1);
Exit;
End;
Result := NumToLetters(inInt)+Copy(sgChar,inMod,1);
End;
//Unit Description UnitIndex Master Index
Function THTMLONEPAGEDevice.LettersToNumbers(Letters:String): Integer;
Var
inChar : Integer;
inCount : Integer;
inCounter : Integer;
inLen : Integer;
inMult : Integer;
inNum : Integer;
inPos : Integer;
sgChar : String;
sgL : String;
Begin
Result := -1;
inNum := 0;
If Letters = '' Then Exit;
If Copy(Letters,1,1) = '_' Then Letters := Copy(Letters,2,Length(Letters)-1);
If Letters = '' Then Exit;
sgChar := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
inChar := Length(sgChar);
inLen := Length(Letters);
For inCounter := inLen DownTo 1 Do
Begin
sgL := Copy(Letters,inCounter,1);
inPos:= Pos(sgL,sgChar);
If inPos = 0 Then Exit;
inMult := 1;
For inCount := 1 To (inLen-incounter) Do
Begin
inMult := inMult * inChar;
End;
inNum := inNum + (inPos*inMult);
End;
Result := inNum;
End;
//Unit Description UnitIndex Master Index
procedure THTMLONEPAGEDevice.AddImageFile(FileName,ImageType,ImageSpec:String);
Var
inLen : Integer;
begin
inLen := Length(ImageArray)+1;
SetLength(ImageArray,inLen,3);
ImageArray[inLen-1,0] := FileName;
ImageArray[inLen-1,1] := UpperCase(ImageType);
ImageArray[inLen-1,2] := UpperCase(ImageSpec);
end;
initialization
ppRegisterDevice(THTMLONEPAGEDevice);
finalization
ppUnRegisterDevice(THTMLONEPAGEDevice);
end.
//