⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 acemerge.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    end;
    AceRT_ExtTextOut:
    begin
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadRect;
      Count := ReadLongInt;
      StreamMove(Count);
    end;
    AceRT_TextRect:
    begin
      ReadRect;
      ReadSmallInt;
      ReadSmallInt;
      ReadString;
    end;
    AceRT_FillRect, AceRT_Rectangle: ReadRect;
    AceRT_RoundRect: StreamMove(SizeOf(SmallInt) * 6);
    AceRT_Ellipse: ReadRect;
    AceRT_Draw:
    begin
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadStream;
    end;
    AceRT_StretchDraw:
    begin
      ReadRect;
      ReadSmallInt;
      ReadStream;
    end;
    AceRT_ShadeRect:
    begin
      ReadRect;
      ReadSmallInt;
    end;
    AceRT_PrinterInfo: StreamMove(SizeOF(TAceFilePrinterInfo));
    AceRT_NewPrinterInfo:
    begin
      Count := ReadLongInt;
      StreamMove(Count);
    end;
    AceRT_SetBkColor: ReadLongInt;
    AceRT_TextJustify:
    begin
      ReadRect;
      ReadSmallInt;
      ReadSmallInt;
      ReadString;
      ReadBoolean;
      if afh.Version > 1.0 then ReadRect;
    end;
    AceRT_AceDrawBitmap:
    begin
      ReadSmallInt;
      ReadSmallInt;
      ReadStream;
    end;
    AceRT_AceStretchDrawBitmap:
    begin
      ReadRect;
      ReadStream;
    end;
    AceRT_RtfDraw:
    begin
      ReadLongInt;
      ReadRect;
      ReadBoolean;
      ReadLongInt;
      ReadLongInt;
      ReadStream;
    end;
    AceRT_DrawCheckBox:
    begin
      ReadRect;
      ReadSmallInt;
      ReadLongInt;
      ReadSmallInt;
    end;
    AceRT_DrawShapeType:
    begin
      ReadSmallInt;
      StreamMove(SizeOf(LongInt) * 8);
    end;
    AceRT_PolyDrawType:
    begin
      ReadSmallInt;
      Count := ReadSmallInt;
      StreamMove(SizeOf(LongInt) * 2 * Count);
    end;
    AceRT_3of9BarCode,AceRT_2of5BarCode:
    begin
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadSmallInt;
      ReadBoolean;
      ReadBoolean;
      ReadString;
    end else StreamMove(ReadLongInt);

  end;
end;


procedure TAceMerge.LoadFromStream(LoadStream: TStream);
var
  afh: TAceFileHeader;
  afi: TAceFileInfo;
begin
  LoadStream.Read(afh, SizeOf(TAceFileHeader));
  if (afh.Key = 101071) then
  begin
    if (FAceFilesAdded > 0) And (afh.Version <> FAceFileHeader.Version) then
      Raise Exception.Create('You cannot combine ACE files from different versions.')
    else
    begin
      Inc(FAceFilesAdded);
      LoadStream.Read(afi, SizeOf(TAceFileInfo));

      if FAceFilesAdded = 1 then
      begin
        FAceFileHeader := afh;
        FAceFileInfo := afi;
        FDescription := StrPas(afh.Description);
      end;

      GetPrinterSetup(LoadStream, afh);
      GetUserStream(LoadStream);
      GetPages(LoadStream,afi);
      FAceFileInfo.Pages := FPages.Count;
      GetObjects(LoadStream, afi);
      FAceFileInfo.Objects := FObjects.Count;
      GetPageData(LoadStream, afh);
    end;  
  end else Raise Exception.Create('Invalid ACE file format.');
end;
procedure TAceMerge.LoadFromFile(FileName: String);
var
  fs: TFileStream;
begin
  fs := nil;
  try
    fs := TFileStream.Create(FileName, fmOpenRead);
    LoadFromStream(fs);
  finally
    if fs <> nil then fs.Free;
  end;
end;
procedure TAceMerge.SaveToFile(FileName: String);
var
  fs: TFileStream;
begin
  fs := nil;
  try
    fs := TFileStream.Create(FileName, fmCreate);
    SaveToStream(fs);
  finally
    if fs <> nil then fs.Free;
  end;
end;
procedure TAceMerge.SaveToStream(SaveStream: TStream);
var
  SavePos: LongInt;
  Pos: Integer;
  Spot: LongInt;
  Len: LongInt;
begin
  for Pos := 0 to SizeOf(FAceFileHeader.Description) -1 do
       FAceFileHeader.Description[Pos] := #0;

  StrPLCopy(FAceFileHeader.Description, FDescription,SizeOf(FAceFileHeader.Description)-1);

  SaveStream.Write(FAceFileHeader, SizeOf(FAceFileHeader));
  SaveStream.Write(FAceFileInfo, SizeOf(FAceFileInfo));
  FAcePrinterSetup.WriteToStream(SaveStream);

  Len := FUserStream.Size;;
  SaveStream.Write(Len, SizeOf(Len));
  FUserStream.Position := 0;
  SaveStream.CopyFrom(FUserStream, FUserStream.Size);

  for Pos := 0 to FPages.Count - 1 do
  begin
    Spot := TAcePagePosition(FPages.Items(Pos)).Pos;
    SaveStream.Write(Spot, SizeOf(Spot));
  end;

  for Pos := 0 to FObjects.count - 1 do TAceMergeObject(FObjects.Items[Pos]).Write(SaveStream);

  FAceFileHeader.HeaderLen := SaveStream.Size;
  SaveStream.Position := 0;
  SaveStream.Write(FAceFileHeader, SizeOf(FAceFileHeader));
  SaveStream.Position := SaveStream.Size;

  SavePos := FStream.Position;
  FStream.Position := 0;
  SaveStream.CopyFrom(FStream, FStream.Size);
  FStream.Position := SavePos;
end;




{ TAceMergeObject }
constructor TAceMergeObject.Create;
begin
  FObjectType := aotNone;
  FUseObject := -1;
end;

destructor TAceMergeObject.Destroy;
begin
  inherited Destroy;
end;

procedure TAceMergeObject.Assign(Source: TObject);
var
  mo: TAceMergeObject;
begin
  if Source is TAceMergeObject then
  begin
    mo := Source as TAceMergeObject;
    FObjectType := mo.FObjectType;
    case mo.FObjectType of
      aotFont: FLogFont := mo.FLogFont;
      aotBrush: FLogBrush := mo.FLogBrush;
      aotPen: FLogPen := mo.FLogPen;
    end;
  end;
end;
function TAceMergeObject.IsEqual(Source: TObject): Boolean;
var
  mo: TAceMergeObject;
begin
  Result := False;
  if Source is TAceMergeObject then
  begin
    mo := Source as TAceMergeObject;
    if FObjectType = mo.FObjectType then
    begin
      case mo.FObjectType of
        aotFont:  Result := FontSame(mo.FLogFont);
        aotBrush: Result := BrushSame(mo.FLogBrush);
        aotPen:   Result := PenSame(mo.FLogPen);
      end;
    end;
  end;
end;

function TAceMergeObject.FontSame(lf: TAceLogFont): boolean;
begin
  Result := AceIsPCharEqual(@FLogFont, @lf, SizeOf(FLogFont) - SizeOf(FLogFont.Name));
  if result And (StrComp(FLogFont.Name, lf.Name) <> 0)  then Result := False;
end;

function TAceMergeObject.PenSame(lp: TAceLogPen): boolean;
begin
  Result := AceIsPCharEqual(@lp, @FLogPen, SizeOf(FLogPen));
end;

function TAceMergeObject.BrushSame(lb: TAceLogBrush): boolean;
begin
  Result := False;
      // AceIsPCharEqual(@lb, @FLogBrush, SizeOf(FLogBrush));
end;

procedure TAceMergeObject.Write(Stream: TStream);
var
  ot: Word;
begin
  case FObjectType of
    aotFont:
    begin
      ot := AceRT_Font;
      Stream.Write( ot, SizeOf(ot));
      Stream.Write( FLogFont, SizeOf(FLogFont));
    end;
    aotBrush:
    begin
      ot := AceRT_Brush;
      Stream.Write( ot, SizeOf(ot));
      Stream.Write( FLogBrush, SizeOf(FLogBrush));
    end;
    aotPen:
    begin
      ot := AceRT_Pen;
      Stream.Write( ot, SizeOf(ot));
      Stream.Write( FLogPen, SizeOf(FLogPen));
    end;
  end;
end;

procedure TAceMergeObject.Read(Stream: TStream);
var
  rt: Word;
begin

  Stream.Read(rt, SizeOf(rt));
  case rt of
    AceRT_Font:
    begin
      FObjectType := aotFont;
      Stream.Read( FLogFont, SizeOf(FLogFont));
    end;
    AceRT_Brush:
    begin
      FObjectType := aotBrush;
      Stream.Read( FLogBrush, SizeOf(FLogBrush));
    end;
    AceRT_Pen:
    begin
      FObjectType := aotPen;
      Stream.Read( FLogPen, SizeOf(FLogPen));
    end;
  end;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -