adfaxcvt.pas

测试用例

    CheckException(Self, upUnpackFileToTiff(Data, InFNameZ, OutFNameZ));
  end;

  procedure TApdCustomFaxUnpacker.UnpackPageToBmp(const Page : Cardinal);
    {-Unpack a page of a fax into a BMP file}
  begin
    with UnpackPageToBitmap(Page) do begin                               {!!.04}
      SaveToFile(FOutFileName);                                          {!!.04}
      Free;                                                              {!!.04}
    end;                                                                 {!!.04}
  end;

  procedure TApdCustomFaxUnpacker.UnpackFileToBmp;
    {-Unpack a file to a BMP file}
  begin
    with UnpackFileToBitmap do begin                                     {!!.04}
      SaveToFile(FOutFileName);                                          {!!.04}
      Free;                                                              {!!.04}
    end;                                                                 {!!.04}
  end;

  class function TApdCustomFaxUnpacker.IsAnAPFFile(const FName : String) : Boolean;
  var
    Temp : array[0..255] of Char;

  begin
    Result := awIsAnAPFFile(StrPCopy(Temp, FName));
  end;

procedure TApdCustomFaxUnpacker.ExtractPage(const Page: Cardinal);
var
  Fax        : TFileStream;
  Dest       : TMemoryStream;
  FaxHeader  : TFaxHeaderRec;
  PageHeader : TPageHeaderRec;
  Count      : Cardinal;
  Ext        : String;
begin
  if not FileExists(FInFileName) then
    CheckException(Self, ecFileNotFound);

  if (FOutFileName = '') then
    FOutFileName := ChangeFileExt(FInFileName, '.' + DefAPFExt)
  else begin
    Ext := ExtractFileExt(FOutFileName);
    if (Ext = '') then
      FOutFileName := ChangeFileExt(FOutFileName, '.' + DefAPFExt);
  end;

  if UpperCase(FInFileName) = UpperCase(FOutFileName) then
    CheckException(Self, ecAccessDenied);

  Fax := TFileStream.Create(FInFileName, fmOpenRead);
  try
    Fax.ReadBuffer(FaxHeader, SizeOf(TFaxHeaderRec));
    if FaxHeader.Signature <> DefAPFSig then begin
      Fax.Free;
      CheckException(Self, ecFaxBadFormat);
    end;
    if FaxHeader.PageCount < Page then begin
      Fax.Free;
      CheckException(Self, ecInvalidPageNumber);
    end;
    Dest := TMemoryStream.Create;
    try
      FaxHeader.PageCount := 1;
      Dest.WriteBuffer(FaxHeader, SizeOf(TFaxHeaderRec));
      Count := 1;
      while Count < Page do begin
        inc(Count);
        Fax.ReadBuffer(PageHeader, SizeOf(TPageHeaderRec));
        Fax.Seek(PageHeader.ImgLength, soFromCurrent);
      end;
      Fax.ReadBuffer(PageHeader, SizeOf(TPageHeaderRec));
      Dest.WriteBuffer(PageHeader, SizeOf(TPageHeaderRec));
      Dest.CopyFrom(Fax, PageHeader.ImgLength);
      Dest.SaveToFile(FOutFileName);
    finally
      Dest.Free;
    end;
  finally
    Fax.Free;
  end;
end;

{ TApdAPFGraphic }

constructor TApdAPFGraphic.Create;
begin
  inherited Create;

  FPages := TList.Create;

  FFromAPF := TApdFaxUnpacker.Create (nil);
  FToAPF := TApdFaxConverter.Create (nil);
end;

destructor TApdAPFGraphic.Destroy;
begin
  FreeImages;
  FPages.Free;
  FFromAPF.Free;
  FToAPF.Free;
  
  inherited Destroy;
end;

procedure TApdAPFGraphic.Assign (Source : TPersistent);
var
  i : Integer;
begin
  FreeImages;
  if Source is TApdAPFGraphic then begin
    FPages.Capacity := (Source as TApdAPFGraphic).FPages.Capacity;
    FPages.Count := (Source as TApdAPFGraphic).FPages.Count;
    for i := 0 to (Source as TApdAPFGraphic).FPages.Count - 1 do
      FPages.Items[i] := (Source as TApdAPFGraphic).FPages.Items[i];
    CurrentPage := (Source as TApdAPFGraphic).CurrentPage;
  end else
    inherited Assign (Source);
end;

procedure TApdAPFGraphic.AssignTo (Dest : TPersistent);
begin
  if (Dest is TBitmap) then
    Dest.Assign (TBitmap (FPages[CurrentPage]))
  else
    inherited AssignTo (Dest); 
end;

procedure TApdAPFGraphic.Draw (ACanvas : TCanvas; const Rect : TRect);
begin
  ACanvas.StretchDraw (Rect, Page[FCurrentPage]);
end;

procedure TApdAPFGraphic.FreeImages;
var
  i : Integer;

begin
  for i := 0 to FPages.Count - 1 do
    TBitmap (FPages[i]).Free;
  FPages.Clear;
  FCurrentPage := 0;
end;

function TApdAPFGraphic.GetEmpty : Boolean;
begin
  Result := (FPages.Count = 0);
end;

function TApdAPFGraphic.GetHeight : Integer;
begin
  if FPages.Count > 0 then
    Result := TBitmap (FPages[FCurrentPage]).Height
  else
    Result := 0;
end;

function TApdAPFGraphic.GetNumPages : Integer;
begin
  Result := FPages.Count;
end;

function TApdAPFGraphic.GetPage (x : Integer) : TBitmap;
begin
  if FPages.Count > 0 then
    Result := TBitmap (FPages[FCurrentPage])
  else
    Result := nil;
end;

function TApdAPFGraphic.GetWidth : Integer;
begin
  if FPages.Count > 0 then
    Result := TBitmap (FPages[FCurrentPage]).Width
  else
    Result := 0;
end;

procedure TApdAPFGraphic.LoadFromClipboardFormat (AFormat : Word;
                                                  AData : THandle;
                                                  APalette : HPALETTE);
begin
  raise EApdAPFGraphicError.Create (ApdEcStrNoClipboard);
end;

procedure TApdAPFGraphic.LoadFromFile (const Filename : string);
var
  i : Integer;
  WorkBitmap : TBitmap;

begin
  FreeImages;
  FFromAPF.InFileName := FileName;
  for i := 1 to FFromAPF.NumPages do begin
    WorkBitmap := FFromAPF.UnpackPageToBitmap(i);
    FPages.Add (WorkBitmap)
  end;
  CurrentPage := 0;
end;

procedure TApdAPFGraphic.LoadFromStream (Stream : TStream);
var
  fpOut : TFileStream;
  TempPath : array [0..MAX_PATH] of Char;
  TempName : array [0..MAX_PATH] of Char;

begin
  GetTempPath (255, TempPath);
  GetTempFileName (TempPath, 'APD', 0, TempName);
  fpOut := TFileStream.Create(TempName, fmCreate);
  try
    fpOut.CopyFrom (Stream, 0); 
  finally
    fpOut.Free;
    try
      LoadFromFile (TempName);
    finally
      DeleteFile (TempName);
    end;
  end;
end;

procedure TApdAPFGraphic.SaveToClipboardFormat (var AFormat : Word;
                                                var AData : THandle;
                                                var APalette : HPALETTE);
begin
  raise EApdAPFGraphicError.Create (ApdEcStrNoClipboard);
end;

procedure TApdAPFGraphic.SaveToStream (Stream : TStream);
var
  fpIn : TFileStream;
  TempPath : array [0..MAX_PATH] of Char;
  TempName : array [0..MAX_PATH] of Char;

begin
  GetTempPath (255, TempPath);
  GetTempFileName (TempPath, 'APD', 0, TempName);
  SaveToFile (TempName);
  
  fpIn := TFileStream.Create (TempName, fmOpenRead);
  try
    Stream.CopyFrom (fpIn, 0) 
  finally
    fpIn.Free;
    DeleteFile (TempName);
  end;
end;

procedure TApdAPFGraphic.SaveToFile (const Filename : string);
var
  i            : Integer;
  FaxList      : TStringList;
  TempPath     : array [0..MAX_PATH] of Char;
  TempName     : array [0..MAX_PATH] of Char;
  DestFile     : TFileStream;
  SourceFile   : TFileStream;
  DestHeader   : TFaxHeaderRec;
  SourceHeader : TFaxHeaderRec;

begin
  FaxList := TStringList.Create;
  try
    GetTempPath (255, TempPath);
    FToAPF.InputDocumentType := idBMP;
    for i := 0 to FPages.Count - 1 do begin
      GetTempFileName (TempPath, 'APD', 0, TempName);
      FToAPF.OutFileName := TempName;
      FToAPF.ConvertBitmapToFile (Page[i]);
      FaxList.Add (TempName); 
    end;
    if FaxList.Count = 0 then
      Exit;

    { concatenate the temp files into the new one }
    { Create temp file }
    
    DestFile := TFileStream.Create (FileName, fmCreate or fmShareExclusive);
    try
      { Open first source file }
      SourceFile := TFileStream.Create (FaxList[0],
                                        fmOpenRead or fmShareDenyWrite);
      try
        { Read header of the first APF }
        SourceFile.ReadBuffer (DestHeader, SizeOf (DestHeader));
        if (DestHeader.Signature <> DefAPFSig) then
          raise EApdAPFGraphicError.Create (ApdEcStrBadFaxFmt);
        { Copy first source file to dest }
        DestFile.CopyFrom (SourceFile, 0);
      finally
        SourceFile.Free;
      end;                         
      { Append remaining files in the list }
      for I := 1 to Pred (FaxList.Count) do begin
        SourceFile := TFileStream.Create (FaxList[I],
                                          fmOpenRead or fmShareDenyWrite);
        try
          SourceFile.ReadBuffer (SourceHeader, SizeOf (SourceHeader));
          if (SourceHeader.Signature <> DefAPFSig) then
            raise EApdAPFGraphicError.Create (ApdEcStrBadFaxFmt);
          DestFile.CopyFrom (SourceFile,
                             SourceFile.Size - SizeOf (SourceHeader));
          DestHeader.PageCount := DestHeader.PageCount +
                                  SourceHeader.PageCount;
        finally
          SourceFile.Free;
        end;
      end;
      DestFile.Position := 0;
      DestFile.WriteBuffer (DestHeader, SizeOf (DestHeader));
    finally
      DestFile.Free;
    end;

  finally
    try
      for i := 0 to FaxList.Count - 1 do
        DeleteFile (FaxList[i]);
    finally
      FaxList.Free;
    end;
  end;
end;

procedure TApdAPFGraphic.SetCurrentPage (v : Integer);
begin
  if (v <> FCurrentPage) then begin
    if (v >= 0) and (v < FPages.Count) then
      FCurrentPage := v
    else
      raise EApdAPFGraphicError.Create (ApdEcStrInvalidPage);
  end;
end;

procedure TApdAPFGraphic.SetHeight (v : Integer);
begin
  TBitmap (FPages[CurrentPage]).Height := v;
end;

procedure TApdAPFGraphic.SetPage (x : Integer; v : TBitmap);
var
  WorkBitmap : TBitmap;
  
begin
  { Assign the bitmap to the specified index.  If you specify an index that
    is one greater than the last available index, the image will be added
    at the end. }
  if (x >= 0) and (x < FPages.Count) then
    TBitmap (FPages[x]).Assign (v)
  else if (x = FPages.Count) then begin
    WorkBitmap := TBitmap.Create;
    WorkBitmap.Assign (v);
    FPages.Add(WorkBitmap);
  end else
    raise EApdAPFGraphicError.Create (ApdEcStrInvalidPage);
end;

procedure TApdAPFGraphic.SetWidth (v : Integer);
begin
  TBitmap (FPages[CurrentPage]).Width := v;
end;

initialization

  { Register this format with TPicture }

  TPicture.RegisterFileFormat ('APF', 'APRO APF Fo