preview.pas

Print Preview Suite v4.76 很不错的 打印预览控件!

begin
  if FShadowColor <> Value then
  begin
    FShadowColor := Value;
    DoChange;
  end;
end;

procedure TPaperPreviewOptions.SetShadowWidth(Value: TBorderWidth);
begin
  if FShadowWidth <> Value then
  begin
    FShadowWidth := Value;
    DoChange;
  end;
end;

procedure TPaperPreviewOptions.SetCursor(Value: TCursor);
begin
  if FCursor <> Value then
  begin
    FCursor := Value;
    DoChange;
  end;
end;

procedure TPaperPreviewOptions.SetDragCursor(Value: TCursor);
begin
  if FDragCursor <> Value then
  begin
    FDragCursor := Value;
    DoChange;
  end;
end;

procedure TPaperPreviewOptions.SetGrabCursor(Value: TCursor); //pvg
begin
  if FGrabCursor <> Value then
  begin
    FGrabCursor := Value;
    DoChange;
  end;
end;

procedure TPaperPreviewOptions.SetPopupMenu(Value: TPopupMenu);
begin
  if FPopupMenu <> Value then
  begin
    FPopupMenu := Value;
    DoChange;
  end;
end;

{ TPrintPreview }

procedure RaiseOutOfMemory;
begin
  raise EOutOfMemory.Create(SNotEnoughMemory);
end;

procedure SwapValues(var A, B: Integer);
begin
  A := A xor B;
  B := A xor B;
  A := A xor B;
end;

function ConvertUnits(Value, DPI: Integer; InUnits, OutUnits: TUnits): Integer;
begin
  Result := Value;
  case InUnits of
    mmLoMetric:
      case OutUnits of
        mmLoMetric: Result := Value;
        mmHiMetric: Result := Value * 10;
        mmLoEnglish: Result := MulDiv(Value, 100, 254);
        mmHiEnglish: Result := MulDiv(Value, 1000, 254);
        mmPoints: Result := MulDiv(Value, 72, 254);
        mmTWIPS: Result := MulDiv(Value, 1440, 254);
        mmPixel: Result := MulDiv(Value, DPI, 254);
      end;
    mmHiMetric:
      case OutUnits of
        mmLoMetric: Result := Value div 10;
        mmHiMetric: Result := Value;
        mmLoEnglish: Result := MulDiv(Value, 10, 254);
        mmHiEnglish: Result := MulDiv(Value, 100, 254);
        mmPoints: Result := MulDiv(Value, 72, 2540);
        mmTWIPS: Result := MulDiv(Value, 1440, 2540);
        mmPixel: Result := MulDiv(Value, DPI, 2540);
      end;
    mmLoEnglish:
      case OutUnits of
        mmLoMetric: Result := MulDiv(Value, 254, 100);
        mmHiMetric: Result := MulDiv(Value, 254, 10);
        mmLoEnglish: Result := Value;
        mmHiEnglish: Result := Value * 10;
        mmPoints: Result := MulDiv(Value, 72, 100);
        mmTWIPS: Result := MulDiv(Value, 1440, 100);
        mmPixel: Result := MulDiv(Value, DPI, 100);
      end;
    mmHiEnglish:
      case OutUnits of
        mmLoMetric: Result := MulDiv(Value, 254, 1000);
        mmHiMetric: Result := MulDiv(Value, 254, 100);
        mmLoEnglish: Result := Value div 10;
        mmHiEnglish: Result := Value;
        mmPoints: Result := MulDiv(Value, 72, 1000);
        mmTWIPS: Result := MulDiv(Value, 1440, 1000);
        mmPixel: Result := MulDiv(Value, DPI, 1000);
      end;
    mmPoints:
      case OutUnits of
        mmLoMetric: Result := MulDiv(Value, 254, 72);
        mmHiMetric: Result := MulDiv(Value, 2540, 72);
        mmLoEnglish: Result := MulDiv(Value, 100, 72);
        mmHiEnglish: Result := MulDiv(Value, 1000, 72);
        mmPoints: Result := Value;
        mmTWIPS: Result := Value * 20;
        mmPixel: Result := MulDiv(Value, DPI, 72);
      end;
    mmTWIPS:
      case OutUnits of
        mmLoMetric: Result := MulDiv(Value, 254, 1440);
        mmHiMetric: Result := MulDiv(Value, 2540, 1440);
        mmLoEnglish: Result := MulDiv(Value, 100, 1440);
        mmHiEnglish: Result := MulDiv(Value, 1000, 1440);
        mmPoints: Result := Value div 20;
        mmTWIPS: Result := Value;
        mmPixel: Result := MulDiv(Value, DPI, 1440);
      end;
    mmPixel:
      case OutUnits of
        mmLoMetric: Result := MulDiv(Value, 254, DPI);
        mmHiMetric: Result := MulDiv(Value, 2540, DPI);
        mmLoEnglish: Result := MulDiv(Value, 100, DPI);
        mmHiEnglish: Result := MulDiv(Value, 1000, DPI);
        mmPoints: Result := MulDiv(Value, 72, DPI);
        mmTWIPS: Result := MulDiv(Value, 1440, DPI);
        mmPixel: Result := MulDiv(Value, DPI, Screen.PixelsPerInch);
      end;
  end;
end;

constructor TPrintPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls];
  Align := alClient;
  TabStop := True;
  ParentFont := False;
  Font.Name := 'Arial';
  Font.Size := 8;
  FAborted := False;
  FState := psReady;
  FPaperType := pA4;
  FOrientation := poPortrait;
  FZoomSavePos := True;
  FZoomState := zsZoomToFit;
  FZoom := 100;
  FZoomMin := 10;
  FZoomMax := 500;
  FZoomStep := 10;
  SetUnits(mmHiMetric);
  with PaperSizes[FPaperType] do
    FPageExt := ConvertXY(Width, Height, Units, FUnits);
  CalculateMetafileSize;
  FPages := TMetafileList.Create;
  FPages.OnChange := PagesChanged;
  FPages.OnCurrentChange := PageChanged;
  FPaperViewOptions := TPaperPreviewOptions.Create;
  FPaperViewOptions.OnChange := PaperViewOptionsChanged;
  FPaperView := TPaperPreview.Create(Self);
  with FPaperView do
  begin
    Parent := Self;
    TabStop := False;
    Visible := False;
    OnPaint := PaintPage;
    OnClick := PaperClick;
    OnDblClick := PaperDblClick;
    OnMouseDown := PaperMouseDown;
    OnMouseMove := PaperMouseMove;
    OnMouseUp := PaperMouseUp;
  end;
  FPaperViewOptions.AssignTo(FPaperView);
end;

destructor TPrintPreview.Destroy;
begin
  FPages.Free;
  FPaperView.Free;
  FPaperViewOptions.Free;
  if Assigned(AnnotationMetafile) then
    AnnotationMetafile.Free;
  if Assigned(BackgroundMetafile) then
    BackgroundMetafile.Free;
  if AutoFormName <> '' then
    RemoveForm(AutoFormName);
  inherited Destroy;
end;

procedure TPrintPreview.Loaded;
begin
  inherited Loaded;
  CalculateMetafileSize;
  UpdateZoom;
end;

function TPrintPreview.ConvertX(Value: Integer; InUnits, OutUnits: TUnits): Integer;
begin
  Result := ConvertXY(Value, 0, InUnits, OutUnits).X;
end;

function TPrintPreview.ConvertY(Value: Integer; InUnits, OutUnits: TUnits): Integer;
begin
  Result := ConvertXY(0, Value, InUnits, OutUnits).Y;
end;

function TPrintPreview.ConvertXY(X, Y: Integer; InUnits, OutUnits: TUnits): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
  ConvertPoints(Result, 1, InUnits, OutUnits);
end;

procedure TPrintPreview.ConvertPoints(var Points; NumPoints: Integer;
  InUnits, OutUnits: TUnits);
var
  pPoints: PPoint;
begin
  pPoints := @Points;
  while NumPoints > 0 do
  begin
    with pPoints^ do
    begin
      X := ConvertUnits(X, Screen.PixelsPerInch, InUnits, OutUnits);
      Y := ConvertUnits(Y, Screen.PixelsPerInch, InUnits, OutUnits);
    end;
    Inc(pPoints);
    Dec(NumPoints);
  end;
end;

function TPrintPreview.ClientToPaper(const Pt: TPoint): TPoint;
begin
  Result := Pt;
  MapWindowPoints(Handle, FPaperView.Handle, Result, 1);
  Result.X := MulDiv(Result.X - FPaperViewOptions.BorderWidth, 100, FZoom);
  Result.Y := MulDiv(Result.Y - FPaperViewOptions.BorderWidth, 100, FZoom);
  Result.X := ConvertUnits(Result.X, Screen.PixelsPerInch, mmPixel, FUnits);
  Result.Y := ConvertUnits(Result.Y, Screen.PixelsPerInch, mmPixel, FUnits);
end;

function TPrintPreview.PaperToClient(const Pt: TPoint): TPoint;
begin
  Result.X := ConvertUnits(Pt.X, Screen.PixelsPerInch, FUnits, mmPixel);
  Result.Y := ConvertUnits(Pt.Y, Screen.PixelsPerInch, FUnits, mmPixel);
  Result.X := MulDiv(Result.X, FZoom, 100) + FPaperViewOptions.BorderWidth;
  Result.Y := MulDiv(Result.Y, FZoom, 100) + FPaperViewOptions.BorderWidth;
  MapWindowPoints(FPaperView.Handle, Handle, Result, 1);
end;

function TPrintPreview.PaintGraphic(X, Y: Integer; Graphic: TGraphic): TPoint;
var
  Rect: TRect;
begin
  Rect.Left := X;
  Rect.Top := Y;
  Rect.Right := X + ConvertUnits(Graphic.Width, Screen.PixelsPerInch, mmPixel, FUnits);
  Rect.Bottom := Y + ConvertUnits(Graphic.Height, Screen.PixelsPerInch, mmPixel, FUnits);
  Result := PaintGraphicEx(Rect, Graphic, False, False, False).BottomRight;
end;

function TPrintPreview.PaintGraphicEx(const Rect: TRect; Graphic: TGraphic;
  Proportinal, ShrinkOnly, Center: Boolean): TRect;
var
  gW, gH: Integer;
  rW, rH: Integer;
  W, H: Integer;
begin
  gW := ConvertUnits(Graphic.Width, Screen.PixelsPerInch, mmPixel, FUnits);
  gH := ConvertUnits(Graphic.Height, Screen.PixelsPerInch, mmPixel, FUnits);
  rW := Rect.Right - Rect.Left;
  rH := Rect.Bottom - Rect.Top;
  if not ShrinkOnly or (gW > rW) or (gH > rH) then
  begin
    if Proportinal then
    begin
      if (rW / gW) < (rH / gH) then
      begin
        H := MulDiv(gH, rW, gW);
        W := rW;
      end
      else
      begin
        W := MulDiv(gW, rH, gH);
        H := rH;
      end;
    end
    else
    begin
      W := rW;
      H := rH;
    end;
  end
  else
  begin
    W := gW;
    H := gH;
  end;
  if Center then
  begin
    Result.Left := Rect.Left + (rW - W) div 2;
    Result.Top := Rect.Top + (rH - H) div 2;
  end
  else
    Result.TopLeft := Rect.TopLeft;
  Result.Right := Result.Left + W;
  Result.Bottom := Result.Top + H;
  StretchDrawGraphic(Canvas, Result, Graphic);
end;

//rmk
function TPrintPreview.PaintGraphicEx2(const Rect: TRect; Graphic: TGraphic;
      VertAlign: TVertAlign; HorzAlign: THorzAlign): TRect;
var
  gW, gH: Integer;
  rW, rH: Integer;
  W, H: Integer;
begin
  gW := ConvertUnits(Graphic.Width, Screen.PixelsPerInch, mmPixel, FUnits);
  gH := ConvertUnits(Graphic.Height, Screen.PixelsPerInch, mmPixel, FUnits);
  rW := Rect.Right - Rect.Left;
  rH := Rect.Bottom - Rect.Top;

  if (gW > rW) or (gH > rH) then
  begin
    if (rW / gW) < (rH / gH) then
    begin
      H := MulDiv(gH, rW, gW);
      W := rW;
    end
    else
    begin
      W := MulDiv(gW, rH, gH);
      H := rH;
    end;
  end
  else
  begin
    W := gW;
    H := gH;
  end;

  Case VertAlign of
    vaTop   : Result.Top := Rect.Top;
    vaCenter: Result.Top := Rect.Top + (rH - H)