vpdftypes.pas

生成PDF文档的控件

{*******************************************************}
{                                                       }
{       This unit is part of the VISPDF VCL library.    }
{       Written by R.Husske - ALL RIGHTS RESERVED.      }
{                                                       }
{       Copyright (C) 2000-2009, www.vispdf.com         }
{                                                       }
{       e-mail: [e-mail]                      }
{       http://www.vispdf.com                           }
{                                                       }
{*******************************************************}

unit VPDFTypes;

interface

{$I VisPDFLib.inc }

uses
  SysUtils, Classes, Windows, Graphics;

type
    TVPDFPen = record
        lopnStyle: UINT;
        lopnWidth: Extended;
        lopnColor: COLORREF;
    end;

    TVPDFRectangle = record
        Left, Top, Right, Bottom: Extended;
    end;

    EMR_SMALLTEXTOUTA = packed record
        EMR: EMR;
        ptlReference: TPoint;
        nChars: DWORD;
        fuOptions: DWORD;
        iGraphicsMode: DWORD;
        exScale: Single;
        eyScale: Single;
        rclClip: TRect;
        cString: array[0..0] of AnsiChar;
    end;

    PEMR_SMALLTEXTOUTA = ^EMR_SMALLTEXTOUTA;

    TEMR_SMALLTEXTOUTA = packed record
        EMR: TEMR;
        ptlReference: TPointL;
        nChars: DWORD;
        fuOptions: DWORD;
        iGraphicsMode: DWORD;
        exScale: Single;
        eyScale: Single;
        cString: array[1..1] of AnsiChar;
    end;

    PEMRSMALLTEXTOUTA = ^TEMR_SMALLTEXTOUTA;

    PCardn = ^Cardinal;

    TVPDFDestinationType = (dtXYZ, dtFit, dtFitH, dtFitV, dtFitR, dtFitB, dtFitBH, dtFitBV);

procedure _WriteString(const Value: AnsiString; AStream: TStream);
function _StrToUnicodeHex(const Value: AnsiString): AnsiString;
function _StrToHex(const Value: AnsiString): AnsiString;
function _GetDefinedDC(var IsUseScreen: Boolean): HDC;
function _HasMultiByteString(const Value: AnsiString): boolean;
function _DateTimeToPdfDate(ADate: TDateTime): AnsiString;
function _PdfDateToDateTime(AText: AnsiString): TDateTime;
function _UnEscapeText(Value: AnsiString): AnsiString;
function _EscapeText(const Value: AnsiString): AnsiString;
function _SmEscapeText(const Value: AnsiString): AnsiString;
function _FloatToStrR(Value: Extended): AnsiString;
function _ColorToStrR(Value: TColor): AnsiString;
function _CutFloat(Value: Extended): AnsiString;
function _GetUnicodeHeader: AnsiString;
function _GetCharCount(Text: AnsiString): integer;

implementation

function _DateTimeToPdfDate(ADate: TDateTime): AnsiString;
begin
  Result := AnsiString(FormatDateTime('"D:"yyyymmddhhnnss', now));
end;

function _PdfDateToDateTime(AText: AnsiString): TDateTime;
var
  yy, mm, dd, hh, nn, ss: Word;
begin
  if Length(AText) <> 16 then
    EConvertError.Create('');
  yy := StrToInt(String(Copy(AText, 3, 4)));
  mm := StrToInt(String(Copy(AText, 7, 2)));
  dd := StrToInt(String(Copy(AText, 9, 2)));
  hh := StrToInt(String(Copy(AText, 11, 2)));
  nn := StrToInt(String(Copy(AText, 13, 2)));
  ss := StrToInt(String(Copy(AText, 15, 2)));
  Result := EncodeDate(yy, mm, dd) + EncodeTime(hh, nn, ss, 0);
end;

function _StrToUnicodeHex(const Value: AnsiString): AnsiString;
var
  PW: Pointer;
  PByte: ^Byte;
  HiByte, LoByte: Byte;
  Len: integer;
  i: integer;
begin
  Result := '';
  Len := MultiByteToWideChar(0, CP_ACP, PAnsiChar(Value), Length(Value), nil, 0);
  GetMem(PW, Len * 2);
  Len := MultiByteToWideChar(0, CP_ACP, PAnsiChar(Value), Length(Value), PW, Len *
    2);
  PByte := Pw;
  i := 0;
  while i < Len do
  begin
    LoByte := PByte^;
    inc(PByte);
    HiByte := PByte^;
    inc(PByte);
    Result := Result + AnsiString(IntToHex(HiByte, 2)) + AnsiString(IntToHex(LoByte, 2));
    inc(i);
  end;
  FreeMem(PW);
end;

function _StrToHex(const Value: AnsiString): AnsiString;
var
  i: integer;
begin
  Result := '';
  for i := 1 to Length(Value) do
    Result := Result + AnsiString(IntToHex(ord(Value[i]), 2));
end;

function _HasMultiByteString(const Value: AnsiString): boolean;
var
  i: integer;
begin
  Result := false;
  for i := 1 to Length(Value) do
    if ByteType(Value, i) <> mbSingleByte then
    begin
      Result := true;
      Break;
    end;
end;

function _EscapeText(const Value: AnsiString): AnsiString;
const
  EscapeChars: AnsiString = '()\'#13#10#09#08#12;
  ReplaceChars: AnsiString = '()\rntbf';
var
  i, j: integer;
  flg: boolean;
begin
  Result := '';
  for i := 1 to Length(Value) do
  begin
    flg := false;
    for j := 1 to Length(EscapeChars) do
      if Value[i] = EscapeChars[j] then
      begin
        Result := Result + '\' + ReplaceChars[j];
        flg := true;
        break;
      end;
    if not flg then Result := Result + Value[i];
  end;
end;

function _UnEscapeText(Value: AnsiString): AnsiString;
const
  UnEscapeChars: AnsiString = '()\'#13#10#09#08#12;
  EscapeChars = ['(', ')', '\', 'r', 'n', 't', 'b', 'f'];
var
  I: integer;
  VaLen: integer;

  function GetCorrSym: AnsiChar;
  var
    H: Integer;
  begin
    H := 1;
    while (UnEscapeChars[H] <> Value[I + 1]) do
    begin
      Inc(H);
    end;
    result := UnEscapeChars[H];
  end;

begin
  I := 1;
  VaLen := Length(Value);
  while (I < VaLen) do
  begin
    if (Value[I] = '\') then
    begin
      if (Value[I + 1] in EscapeChars) then
      begin
        Value := Copy(Value, 1, I - 1) + GetCorrSym + Copy(Value, I + 2, VaLen - I - 1);
        VaLen := Length(Value);
      end;
    end;
    Inc(I);
  end;
  Result := Value;
end;

function _SmEscapeText(const Value: AnsiString): AnsiString;
const
  EscapeChars: AnsiString = '()\'#13#10;
  ReplaceChars: AnsiString = '()\rn';
var
  i, j: integer;
  flg: boolean;
begin
  Result := '';
  for i := 1 to Length(Value) do
  begin
    flg := false;
    for j := 1 to Length(EscapeChars) do
      if Value[i] = EscapeChars[j] then
      begin
        Result := Result + '\' + ReplaceChars[j];
        flg := true;
        break;
      end;
    if not flg then Result := Result + Value[i];
  end;
end;

procedure _WriteString(const Value: AnsiString; AStream: TStream);
var
  MemStr: AnsiString;
  MemBlock: Pointer;
begin
  MemStr := Value;
  MemBlock := @MemStr[1];
  AStream.Write(MemBlock^, Length(Value));
end;

function _GetDefinedDC(var IsUseScreen: Boolean): HDC;
begin
  Result := GetDC(0);
end;

function _FloatToStrR(Value: Extended): AnsiString;
var
  i: integer;
begin
  Result := AnsiString(FloatToStr(Trunc(Value * 100 + 0.5) / 100));
  if DecimalSeparator <> '.' then
  begin
    i := Pos(DecimalSeparator, String(Result));
    if i > 0 then
      Result[i] := '.';
  end;
end;

function _GetUnicodeHeader: AnsiString;
begin
  Result := AnsiString(Format('FEFF001B%s001B', [_StrToHex('en')]));
end;

function _GetCharCount(Text: AnsiString): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to Length(Text) do
    if (ByteType(Text, i) = mbSingleByte) or (ByteType(Text, i) = mbLeadByte)
      then
      inc(Result);
end;

function _ColorToStrR(Value: TColor): AnsiString;
var
  X: array[0..3] of Byte;
  rgb: integer;
begin
  if Value > 0 then
    rgb := integer(Value)
  else
    rgb := 0;
  Move(rgb, x[0], 4);
  Result := _FloatToStrR(X[0] / 255) + ' ' +
    _FloatToStrR(X[1] / 255) + ' ' + _FloatToStrR(X[2] / 255);
end;

function _CutFloat(Value: Extended): AnsiString;
begin
  DecimalSeparator := '.';
  Result := AnsiString(FormatFloat('0.####', Value));
end;

end.