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

📄 acesetup.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    { PhysicalHeight and Width doesn't exist in 16bit world }
    L := GetDeviceCaps(Printers.Printer.handle, PHYSICALHEIGHT) / PixelsPerInchY;
    W := GetDeviceCaps(Printers.Printer.handle, PHYSICALWIDTH) / PixelsPerInchX;
{$endif}

    FLeftPrintArea := POffset.x / PixelsPerInchX;
    FTopPrintArea := POffset.y / PixelsPerInchY;
    FRightPrintArea := W - (hres / PixelsPerInchX) - FLeftPrintArea;
    FBottomPrintArea := L - (vres / PixelsPerInchY) - FTopPrintArea;

    if FRightPrintArea < 0 then FRightPrintArea := 0;
    if FBottomPrintArea < 0 then FBottomPrintArea := 0;
{$endif}

    FPrinterSettings.GetValues;
    CopyFromPrinterSettings;

    PRect := AceGetPrintableArea(Printers.Printer.Handle);
    Size := AceGetPhysicalSize(Printers.Printer.Handle);
    Res := AceGetResolution(Printers.Printer.Handle);
    FLeftPrintArea := PRect.Left / Res.x;
    FTopPrintArea := PRect.Top / Res.y;
    FRightPrintArea := (Size.x - PRect.Right) / Res.x;
    FBottomPrintArea := (Size.y - PRect.Bottom) / Res.y;
  end;
end;

procedure TAcePrinterSetup.SetOrientation(Value: Integer);
begin
  if Value <> FOrientation then
  begin
    FOrientation := Value;
    FPrintSet[0] := True;
  end;
end;
procedure TAcePrinterSetup.SetPaperSize(Value: Integer);
begin
  if Value <> FPaperSize then
  begin
    FPaperSize := Value;
    FPrintSet[1] := True;
  end;
end;
procedure TAcePrinterSetup.SetLength(Value: Double);
begin
  if Value <> FLength then
  begin
    FLength := Value;
    FPrintSet[2] := True;
  end;
end;
procedure TAcePrinterSetup.SetWidth(Value: Double);
begin
  if Value <> FWidth then
  begin
    FWidth := Value;
    FPrintSet[3] := True;
  end;
end;
procedure TAcePrinterSetup.SetScale(Value: Integer);
begin
  if Value <> FScale then
  begin
    FScale := Value;
    FPrintSet[4] := True;
  end;
end;
procedure TAcePrinterSetup.SetCopies(Value: Integer);
begin
  if Value <> FCopies then
  begin
    FCopies := Value;
    FPrintSet[5] := True;
  end;
end;
procedure TAcePrinterSetup.SetSource(Value: Integer);
begin
  if Value <> FSource then
  begin
    FSource := Value;
    FPrintSet[6] := True;
  end;
end;
procedure TAcePrinterSetup.SetPrintQuality(Value: Integer);
begin
  if Value <> FPrintQuality then
  begin
    FPrintQuality := Value;
    FPrintSet[7] := True;
  end;
end;
procedure TAcePrinterSetup.SetColor(Value: Integer);
begin
  if Value <> FColor then
  begin
    FColor := Value;
    FPrintSet[8] := True;
  end;
end;
procedure TAcePrinterSetup.SetDuplex(Value: Integer);
begin
  if Value <> FDuplex then
  begin
    FDuplex := Value;
    FPrintSet[9] := True;
  end;
end;
procedure TAcePrinterSetup.SetYResolution(Value: Integer);
begin
  if Value <> FYResolution then
  begin
    FYResolution := Value;
    FPrintSet[10] := True;
  end;
end;
procedure TAcePrinterSetup.SetTTOption(Value: Integer);
begin
  if Value <> FTTOption then
  begin
    FTTOption := Value;
    FPrintSet[11] := True;
  end;
end;
procedure TAcePrinterSetup.SetCollatedCopies(Value: Boolean);
begin
  if Value <> FCollatedCopies then
  begin
    FCollatedCopies := Value;
    FPrintSet[12] := True;
  end;
end;
procedure TAcePrinterSetup.SetFormName(Value: String);
begin
  if Value <> FFormName then
  begin
    FFormName := Value;
    FPrintSet[13] := True;
  end;
end;



function TAcePrinterSetup.ReadFromAceFile(af: TObject): Boolean;
begin
  Result := ReadFromStream(TAceAceFile(af).Stream);
end;

function TAcePrinterSetup.ReadFromStream(Stream: TStream): Boolean;
var
  Len, Spot, LongValue: LongInt;
  RecType, SmallValue: SmallInt;
  PText: array[0..255] of Char;

  procedure ReadSmallInt(var I: SmallInt);
  begin
    Stream.Read(I, SizeOf(I));
  end;
  procedure ReadLongInt(var LI: LongInt);
  begin
    Stream.Read(LI, SizeOf(LI));
  end;

begin
  Result := False;
  Stream.Read(Len, SizeOf(Len));
  if Len > 0 then
  begin
    Result := True;
    Spot := Stream.Position;
    while (Stream.Position - Spot) < Len do
    begin
      Stream.Read(RecType, SizeOf(RecType));
      case RecType of
        AceRT_Orientation:
        begin
          ReadSmallInt(SmallValue);
          Orientation := SmallValue;
        end;
        AceRT_PaperSize:
        begin
          ReadSmallInt(SmallValue);
          PaperSize := SmallValue;
        end;
        AceRT_Length:
        begin
          ReadLongInt(LongValue);
          Length := LongValue / 254;
        end;
        AceRT_Width:
        begin
          ReadLongInt(LongValue);
          Width := LongValue / 254;
        end;
        AceRT_Scale:
        begin
          ReadSmallInt(SmallValue);
          Scale := SmallValue;
        end;
        AceRT_Copies:
        begin
          ReadSmallInt(SmallValue);
          Copies := SmallValue;
        end;
        AceRT_Source:
        begin
          ReadSmallInt(SmallValue);
          Source := SmallValue;
        end;
        AceRT_PrintQuality:
        begin
          ReadSmallInt(SmallValue);
          PrintQuality := SmallValue;
        end;
        AceRT_Color:
        begin
          ReadSmallInt(SmallValue);
          Color := SmallValue;
        end;
        AceRT_Duplex:
        begin
          ReadSmallInt(SmallValue);
          Duplex := SmallValue;
        end;
        AceRT_YResolution:
        begin
          ReadSmallInt(SmallValue);
          YResolution := SmallValue;
        end;
        AceRT_TTOption:
        begin
          ReadSmallInt(SmallValue);
          TTOption := SmallValue;
        end;
        AceRT_CollatedCopies:
        begin
          Stream.Read(FCollatedCopies, SizeOf(FCollatedCopies));
          FPrintSet[12] := True;
        end;
        AceRT_FormName:
        begin
          ReadSmallInt(SmallValue);
          Stream.Read( PText, SmallValue);
          PText[SmallValue] := #0;
          FFormName := StrPas(PText);
          FPrintSet[13] := True;
        end;
        else break;
      end;

    end;
  end;
end;

procedure TAcePrinterSetup.WriteToAceFile(af: TObject);
begin
  WriteToStream(TAceAceFile(af).Stream);
end;

procedure TAcePrinterSetup.WriteToStream(Stream: TStream);
var
  Spot1, Spot2, Spot3: LongInt;
  SmallValue: SmallInt;

  procedure WriteSmallInt(I: SmallInt);
  begin
    Stream.Write(I, Sizeof(I));
  end;
  procedure WriteLongInt(LI: LongInt);
  begin
    Stream.Write(LI, Sizeof(LI));
  end;
begin
  WriteSmallInt(AceRT_NewPrinterInfo);
  Spot1 := Stream.Position;
  WriteLongInt(0); { Come back to write the length }
  Spot2 := Stream.Position;
  if FPrintSet[0] or True then
  begin
    WriteSmallInt(AceRT_Orientation);
    WriteSmallInt(FOrientation);
  end;
  if FPrintSet[1] or True then
  begin
    WriteSmallInt(AceRT_PaperSize);
    WriteSmallInt(FPaperSize);
  end;
  if FPrintSet[2] then
  begin
    WriteSmallInt(AceRT_Length);
    WriteLongInt(Round(FLength * 254));
  end;
  if FPrintSet[3] then
  begin
    WriteSmallInt(AceRT_Width);
    WriteLongInt(Round(FWidth * 254));
  end;
  if FPrintSet[4] then
  begin
    WriteSmallInt(AceRT_Scale);
    WriteSmallInt(FScale);
  end;
  if FPrintSet[5] then
  begin
    WriteSmallInt(AceRT_Copies);
    WriteSmallInt(FCopies);
  end;
  if FPrintSet[6] or True then
  begin
    WriteSmallInt(AceRT_Source);
    WriteSmallInt(FSource);
  end;
  if FPrintSet[7] then
  begin
    WriteSmallInt(AceRT_PrintQuality);
    WriteSmallInt(FPrintQuality);
  end;
  if FPrintSet[8] then
  begin
    WriteSmallInt(AceRT_Color);
    WriteSmallInt(FColor);
  end;
  if FPrintSet[9] or True then
  begin
    WriteSmallInt(AceRT_Duplex);
    WriteSmallInt(FDuplex);
  end;
  if FPrintSet[10] then
  begin
    WriteSmallInt(AceRT_YResolution);
    WriteSmallInt(FYResolution);
  end;
  if FPrintSet[11] then
  begin
    WriteSmallInt(AceRT_TTOption);
    WriteSmallInt(FTTOption);
  end;
  if FPrintSet[12] then
  begin
    WriteSmallInt(AceRT_CollatedCopies);
    Stream.Write(FCollatedCopies, SizeOf(FCollatedCopies));
  end;
  if FPrintSet[13] then
  begin
    WriteSmallInt(AceRT_FormName);
    SmallValue := System.Length(FFormName);
    WriteSmallInt(SmallValue);
    Stream.Write( FFormName[1], SmallValue);
  end;
  Spot3 := Stream.Position;
  Stream.Position := Spot1;
  WriteLongInt(Spot3 - Spot2);
  Stream.Position := Spot3;
end;

end.

⌨️ 快捷键说明

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