prvieweh.pas

bcb/delphi 数据库控件源码,包括DBgrid等控件

  if Parent.Printer.Printers.Count > 0 then
  begin
    XOffSet := GetDeviceCaps(Parent.Printer.Handle, PHYSICALOFFSETX);
    YOffSet := GetDeviceCaps(Parent.Printer.Handle, PHYSICALOFFSETY);
  end else
  begin
    XOffSet := DefaultPrinterPhysicalOffSetX;
    YOffSet := DefaultPrinterPhysicalOffSetY;
  end;
  FullWidth := Parent.Printer.PageWidth + XOffSet * 2;
  FullHeight := Parent.Printer.PageHeight + YOffSet * 2;
  with Canvas do
  begin
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(ClientRect);
    SetMapMode(Canvas.Handle, mm_AnIsotropic);
    SetWindowExtEx(Canvas.Handle, FullWidth, FullHeight, nil);
    SetViewportExtEx(Canvas.Handle, Width, Height, nil);
    SetViewportOrgEx(Canvas.Handle, Trunc(XOffSet * Width / FullWidth),
      Trunc(YOffSet * Height / FullHeight), nil);

    if Parent.Printer.Printers.Count > 0 then
    begin
      Font.PixelsPerInch := GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSX);
      if Font.PixelsPerInch > GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSY) then
        Font.PixelsPerInch := GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSY);
    end
    else
      Font.PixelsPerInch := DefaultPrinterPixelsPerInchX;

    if Assigned(Parent.Printer) and (Parent.PageCount > 0) then
      Parent.Printer.DrawPage(Self, Self.Canvas, Parent.PageIndex);
  end;
end;

procedure TDrawPanel.WMCancelMode(var Message: TWMCancelMode);
begin
  inherited;
  if Cursor = crHand then Cursor := crMagnifier;
end;

{ TPreviewBox }

constructor TPreviewBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls]; //clip_children
  FViewMode := vmFullPage;
  FPageCount := 0;
  FPageIndex := 1;
  pnlShadow := TPanel.Create(Self {AOwner});
  with pnlShadow do
  begin
    ControlStyle := ControlStyle - [csAcceptsControls];
    Parent := Self;
    BevelOuter := bvNone;
    Color := 4210752;
    Enabled := False;
    TabOrder := 0;
    //Visible := False;
  end;
  FDrawPanel := TDrawPanel.Create(Self {AOwner});
  with FDrawPanel do
  begin
    ControlStyle := ControlStyle - [csAcceptsControls];
    Parent := Self;
    BevelOuter := bvNone;
    ParentCtl3D := False;
    Ctl3D := False;
    BorderStyle := bsSingle;
    Left := 8;
    Top := 8;
  end;
  FPrinter := TPrinterPreview.Create;
  FPrinter.Previewer := Self;
  HorzScrollBar.Tracking := True;
  VertScrollBar.Tracking := True;
  FScalePercent := 100;
end;

destructor TPreviewBox.Destroy;
begin
  FPrinter.Free;
  inherited;
end;

procedure TPreviewBox.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

procedure TPreviewBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  with VertScrollBar do
    case Key of
      VK_UP:
        if ssCtrl in Shift then Position := Position - ClientHeight + Increment
        else Position := Position - Increment;
      VK_Down:
        if ssCtrl in Shift then Position := Position + ClientHeight - Increment
        else Position := Position + Increment;
      VK_Prior:
        if ssCtrl in Shift then Position := 0
        else Position := Position - ClientHeight + Increment;
      VK_Next:
        if ssCtrl in Shift then Position := Range
        else Position := Position + ClientHeight - Increment;
    end;
  with HorzScrollBar do
    case Key of
      VK_Left:
        if ssCtrl in Shift then Position := Position - ClientWidth + Increment
        else Position := Position - Increment;
      VK_Right:
        if ssCtrl in Shift then Position := Position + ClientWidth - Increment
        else Position := Position + Increment;
      VK_Home:
        if ssCtrl in Shift then
        begin
          Position := 0;
          VertScrollBar.Position := 0;
        end
        else Position := 0;
      VK_End:
        if ssCtrl in Shift then
        begin
          Position := Range;
          VertScrollBar.Position := VertScrollBar.Range;
        end
        else Position := Range;
    end;
end;

procedure TPreviewBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  SetFocus;
end;

procedure TPreviewBox.PrintDialog;
var Page: Integer;
  OldPrinter: TPrinter;
begin
  OldPrinter := PrintersSetPrinter(Printer.Printer);
  try
    with TPrintDialog.Create(Owner) do
    try
      Options := Options + [poPageNums];
      MinPage := 1;
      MaxPage := PageCount;
      FromPage := 1;
      ToPage := PageCount;
      if Execute then
        if Assigned(Printer) then
        begin
          if Printer.FMetafileList.Count = 0 then Exit;
          with PrintersPrinter do
          begin
            BeginDoc;
            for Page := FromPage to ToPage do
            begin
              Printer.DrawPage(Printer, Canvas, Page);
              if Page < ToPage then NewPage;
            end;
            EndDoc;
          end;
        end;
    finally
      Free;
    end;
  finally
    PrintersSetPrinter(OldPrinter);
  end;
end;

procedure TPreviewBox.PrinterSetupDialog;
var OldPrinter: TPrinter;
begin
  OldPrinter := PrintersSetPrinter(Printer.Printer);
  try
    if Assigned(OnPrinterSetupDialog) then
      OnPrinterSetupDialog(Self)
    else
      with TPrinterSetupDialog.Create(Owner) do
      try
        if Execute then
        begin
          UpdatePageSetup;
          if Assigned(FOnPrinterSetupChanged)
            then FOnPrinterSetupChanged(Self);
        end;
      finally
        Free;
      end;
  finally
    PrintersSetPrinter(OldPrinter);
  end;
end;

procedure TPreviewBox.SetPageIndex(Value: Integer);
begin
  if Value < 1 then Value := 1;
  if Value > PageCount then Value := PageCount;
  if Value <> FPageIndex then
  begin
    FPageIndex := Value;
    UpdatePreview;
    if Assigned(OnPrinterPreviewChanged) then OnPrinterPreviewChanged(Self);
  end;
end;

procedure TPreviewBox.SetPrinter(const Value: TPrinterPreview);
begin
  FPrinter := Value;
end;

procedure TPreviewBox.SetViewMode(const Value: TViewMode);
begin
  if Value <> FViewMode then
  begin
    FViewMode := Value;
    UpdatePageSetup;
  end;
  if Assigned(OnPrinterPreviewChanged) then OnPrinterPreviewChanged(Self);
end;

procedure TPreviewBox.UpdatePageSetup;
var
  Scaling: Integer;
  ALeft, ATop, AWidth, AHeight: Integer;
begin
//  pnlShadow.Visible:=False;
//  LockWindowUpdate(Handle);
  try
    with FDrawPanel, Printer do
    begin
      ALeft := Left; ATop := Top; AWidth := Width; AHeight := Height;
//    Visible:=False;
      case FViewMode of
        vm500: Scaling := 500;
        vm200: Scaling := 200;
        vm150: Scaling := 150;
        vm100: Scaling := 100;
        vm75: Scaling := 75;
        vm50: Scaling := 50;
        vm25: Scaling := 25;
        vm10: Scaling := 10;
        vmPageWidth: // on width pages
          begin
            VertScrollBar.Position := 0;
            HorzScrollBar.Position := 0;
            Scaling := 1;
            ALeft := 8;
            ATop := 8;
            AWidth := Self.Width - 20 - GetSystemMetrics(sm_CXVScroll);
            if Printer.Printers.Count > 0 then
            begin
              AHeight := AWidth * GetDeviceCaps(Printer.Handle, VertSize) div
                GetDeviceCaps(Printer.Handle, HorzSize);
              FScalePercent := AWidth * 100 div (PageWidth * (Self.Owner as TForm).PixelsPerInch div
                GetDeviceCaps(Printer.Handle, LOGPIXELSX));
            end else
            begin
              AHeight := AWidth * DefaultPrinterVerticalSizeMM div
                DefaultPrinterHorizontalSizeMM;
              FScalePercent := AWidth * 100 div (PageWidth * (Self.Owner as TForm).PixelsPerInch div
                DefaultPrinterPixelsPerInchX);
            end;
            VertScrollBar.Range := AHeight + 16;
            HorzScrollBar.Range := 0;
          end;
        vmFullPage: // 耱疣龛鲟 鲥腓觐