prvieweh.pas

很COOL的GRID控件

procedure TDrawPanel.Paint;
var FullWidth, FullHeight, XOffSet, YOffSet: Integer;
    Parent: TPreviewBox;
begin
  Parent := TPreviewBox(Self.Parent);
  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: // 镱