print_preview.pas

delphi语言开发的矢量图形处理对象

var s : String;
begin
  if (PageCount>0) and (Pagenum>0) and (Pagenum<=PageCount) then begin
    Printer.Title := Title;
    if not Printer.Printing then Printer.BeginDoc;
    if Assigned(Print_Preview) then s := Print_Preview.Panel2.Caption;
    try
      if Assigned(Print_Preview) then begin
        Print_Preview.Panel2.Caption := Format('Printing page %d of %d',[pagenum, PageCount]);
        Print_Preview.Panel2.repaint;
      end;
      Printer.Canvas.StretchDraw(Rect(0,0,Printer.PageWidth, Printer.PageHeight), Metafiles[pagenum]);
    finally
      Printer.EndDoc;
      if Assigned(Print_Preview) then Print_Preview.Panel2.Caption := s;
    end;
  end;
end;

procedure TPrintout.Preview;
begin
  Print_Preview.ShowModal;
end;

// needed mainly when the user switches between full page/page width options
procedure TPrintout.rescale_objects(scale:double; page:integer);
var lp1    : integer;
    P_rect : Prect;
    tpwc   : TPanelWithCanvas;
    temp_p : TNotifyEvent;
begin

  Print_Preview.StretchHandle1.detach;

  for lp1:=0 to TSingle_page(Fpages[page-1]).obj_count-1 do begin
    tpwc := TPanelWithCanvas(TSingle_page(Fpages[page-1]).FControls[lp1]);
    with tpwc do begin
      visible := false;
      P_rect  := Prect(TSingle_page(Fpages[page-1]).FRects[lp1]);
      temp_p  := OnResize;
      OnResize := nil; // prevent resize message
      left    := round(P_rect^.left  *scale);
      width   := round(P_rect^.right *scale)-left;
      top     := round(P_rect^.top   *scale);
      height  := round(P_rect^.bottom*scale)-top;
      OnResize := temp_p;
      visible := true;
    end;
  end;
  Flastscale := scale;
end;

procedure TPrintout.DisplayPage(Page : Integer);
var scale : double;
    r     : TRect;
    lp1   : integer;
begin
  if (Page>=1) AND (Page<=PageCount) then begin
    with Print_Preview.PaintArea do begin
      Visible := true;
      scale   := Width / PageSize_pixels.X;  //  printer_pixels to screen pixels
      if Flastpage<>page then begin

        Print_Preview.StretchHandle1.detach;

        // remove all window controls (page may have changed etc)
        for lp1:=ControlCount-1 downto 0 do
        RemoveControl(Controls[lp1]);
        // insert all the controls for this page
        rescale_objects(scale,page);
        for lp1:=0 to TSingle_page(Fpages[page-1]).obj_count-1 do begin
          InsertControl(TControl(TSingle_page(Fpages[page-1]).FControls[lp1]));
        end;
      end else if Flastscale<>scale then rescale_objects(scale,page);
      // if uses changes page width/full page view we need to alter box scaling
      // do the border
      Canvas.Pen.Style := psSolid;
      Canvas.Rectangle(0, 0, Width, Height);
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect( Rect(1, 1, Width - 2, Height - 2)); // fill with white
      // do the dotted margins rect
      r.Left   := Trunc(Margin_Size_pixels.x * scale);
      r.Top    := Trunc(Margin_Size_pixels.y * scale);
      r.Right  := Trunc((PageSize_pixels.x-Margin_Size_pixels2.x) * scale);
      r.Bottom := Trunc((PageSize_pixels.y-Margin_Size_pixels2.y) * scale);
      Canvas.Pen.Style := psDot;
      Canvas.Rectangle(r.left-1, r.top-1, r.right, r.bottom);
    end;
    Print_Preview.Panel2.Caption := Format('Page %d of %d', [Page, PageCount]);
    Print_Preview.PageDisplaying := Page;
    Flastpage                    := page;
  end
  else begin
    Print_Preview.PaintArea.Visible := false;
    Flastpage                       := -1;
  end;
  if (Page = 1) or (PageCount=0) then begin
    Print_Preview.FirstBtn.Enabled := False;
    Print_Preview.PriorBtn.Enabled := False;
  end else begin
    Print_Preview.FirstBtn.Enabled := True;
    Print_Preview.PriorBtn.Enabled := True;
  end;
  if PageCount > Page then begin
    Print_Preview.NextBtn.Enabled := True;
    Print_Preview.LastBtn.Enabled := True;
  end else begin
    Print_Preview.NextBtn.Enabled := False;
    Print_Preview.LastBtn.Enabled := False;
  end;
  // stops sub controls sending repaint to parent, and causing infinite loop
  ValidateRect(Print_Preview.PaintArea.handle,nil);
end;

procedure TPrintout.ClearPrintBuff;
var i : integer;
begin
  for i := 1 to PageCount do TSingle_page(FPages[i-1]).Free;
  FPages.Clear;
  FCurrentPage := 0;
  PrinterSetupChanged;

  Print_Preview.StretchHandle1.Detach;

  FLastpage := -1;
end;

function TPrintout.NewPage : Integer;
begin
  Result := FPages.Add(TSingle_page.Create(Print_Preview))+1;
  FCurrentPage := Result;
end;

procedure TPrintout.PrinterSetupChanged;
begin
  Printer_ppi.x             := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  Printer_ppi.y             := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  PageSize_pixels.x         := GetDeviceCaps(Printer.handle,PHYSICALWIDTH);
  PageSize_pixels.y         := GetDeviceCaps(Printer.handle,PHYSICALHEIGHT);
  Screen_ppi.x              := screen.PixelsPerInch;
  Screen_ppi.y              := screen.PixelsPerInch;
  with Print_Preview.PageSetupDialog1 do begin
    Margin_Size_inches.x  := marginleft/1000;
    Margin_Size_inches.y  := margintop /1000;
    Margin_Size_pixels.x  := round(Margin_Size_inches.x*Printer_ppi.x);
    Margin_Size_pixels.y  := round(Margin_Size_inches.y*Printer_ppi.y);
    Margin_Size_pixels2.x := round((marginright/1000)*Printer_ppi.x);
    Margin_Size_pixels2.y := round((marginbottom/1000)*Printer_ppi.y);
    if Print_Preview.fullmode then Print_Preview.FullButtonClick(nil)
    else Print_Preview.WidthButtonClick(nil);
  end;
end;

procedure TPrintout.add_metafile(pagenum:integer; tm:TMetafile;abcolor:tcolor; ox,oy:double);
var r,r2 : TRect;
    lp1  : integer;
begin
  if pagenum=-1 then pagenum := FCurrentPage
  else if (pagenum>0) and (pagenum<=PageCount) then begin end
  else if (pagenum>Pagecount) then for lp1 := Pagecount+1 to pagenum do NewPage;
  r.left   := round(ox*Printer_ppi.x);
  r.top    := round(oy*Printer_ppi.y);
  r.right  := r.left + round((tm.width/Screen_ppi.x)*Printer_ppi.x);
  r.bottom := r.top  + round((tm.height/Screen_ppi.y)*Printer_ppi.y);
// not sure I still need both rects, but it works so I'll not mess any more.
  r2.left   := round((Margin_Size_inches.x+ox)*Screen_ppi.x);
  r2.top    := round((oy)*Screen_ppi.y);
  r2.right  := r2.left + round((tm.width/Screen_ppi.x)*Screen_ppi.x);
  r2.bottom := r2.top  + round((tm.height/Screen_ppi.y)*Screen_ppi.y);
  if (FCurrentPage>0) then TSingle_page(FPages[pagenum-1]).add_MetaFile(tm,abcolor,r,r2,Printer_ppi.x,Printer_ppi.y);
  FLastpage := -1; // forces controls to be rechecked
end;

///////////////////////////////////////////////////////////////////////////////
//                         Form event handlers
///////////////////////////////////////////////////////////////////////////////
procedure TPrintPreview_form.FormCreate(Sender: TObject);
begin
  PageDisplaying         := 1;
  fullmode               := true;
  PaintArea              := TPanelWithCanvas.Create(self);
  PaintArea.Parent       := sb;
  PaintArea.OnPaint      := PaintAreaPaint;

  StretchHandle1         := TStretchHandle.Create(self);
  StretchHandle1.OnMoved := StretchHandle1Moved;
  
  PageSetupDialog1                 := TPageSetupDialog.Create(self);
//  PageSetupDialog1.OnInitPaintPage := PageSetupDialog1InitPaintPage;
//  PageSetupDialog1.OnDrawFullPage  := PageSetupDialog1PaintPage;
end;

procedure TPrintPreview_form.FormDestroy(Sender: TObject);
var lp1 : integer;
begin
  StretchHandle1.detach; // Stop it from being deleted incorrectly
  // make sure panel doesn't have any children in it. (selection boxes)
  for lp1:=PaintArea.ControlCount-1 downto 0 do begin
    PaintArea.RemoveControl(PaintArea.Controls[lp1]);
  end;
  PaintArea.Free;
  StretchHandle1.Free;
  PageSetupDialog1.Free;
end;

procedure TPrintPreview_form.FormShow(Sender: TObject);
begin
  if PrintOut.PageCount>0 then PaintArea.visible := true;
end;

procedure TPrintPreview_form.PaintAreaPaint(Sender: TObject);
begin
  PrintOut.DisplayPage(PageDisplaying);
end;
//////////////////////////////////////////////
//                      Button press routines
//////////////////////////////////////////////
procedure TPrintPreview_form.LastBtnClick(Sender: TObject);
begin
  PrintOut.DisplayPage(PrintOut.PageCount);
end;

procedure TPrintPreview_form.FirstBtnClick(Sender: TObject);
begin
  PrintOut.DisplayPage(1);
end;

procedure TPrintPreview_form.PriorBtnClick(Sender: TObject);
begin
  PrintOut.DisplayPage(PageDisplaying - 1);
end;

procedure TPrintPreview_form.NextBtnClick(Sender: TObject);
begin
  PrintOut.DisplayPage(PageDisplaying + 1);
end;

procedure TPrintPreview_form.WidthButtonClick(Sender: TObject);
var b : boolean;
begin
  if not fullmode then stretchhandle1.detach;
  
  b := PaintArea.Visible;
  PaintArea.Visible := False;
  PaintArea.Top     := 15;
  PaintArea.Left    := 15;
  PaintArea.Width   := ClientWidth - 45;
  PaintArea.Height  := (Longint(PaintArea.Width) * Longint(PageSize_pixels.Y)) div Longint(PageSize_pixels.X);
  PaintArea.Visible := b;
  fullmode          := false;
end;

procedure TPrintPreview_form.FullButtonClick(Sender: TObject);
var b : boolean;
begin
  if not fullmode then stretchhandle1.detach;

  b := PaintArea.Visible;
  PaintArea.Visible := False;
  PaintArea.Top     := 15;
  PaintArea.Height  := Sb.height - 30;
  PaintArea.Width   := (PaintArea.Height*PageSize_pixels.X) div PageSize_pixels.Y;
  PaintArea.Left    := (Width div 2) - (PaintArea.Width div 2);
  PaintArea.Visible := b;
  fullmode          := true;
end;

procedure TPrintPreview_form.ThisPageBtnClick(Sender: TObject);
begin
  PrintOut.PrintPage(PageDisplaying);
end;

procedure TPrintPreview_form.PrintBtnClick(Sender: TObject);
begin
  PrintOut.PrintAll;
end;

procedure TPrintPreview_form.SetupBtnClick(Sender: TObject);
begin
  PageSetupDialog1.execute;
  PrintOut.PrinterSetupChanged;
  if fullmode then FullButtonClick(nil)
  else WidthButtonClick(nil);
end;

procedure TPrintPreview_form.ClearBtnClick(Sender: TObject);
begin
  PrintOut.ClearPrintBuff;
  if fullmode then FullButtonClick(nil)
  else WidthButtonClick(nil);
end;

procedure TPrintPreview_form.CloseButtonClick(Sender: TObject);
begin
  close;
end;

function TPrintPreview_form.PageSetupDialog1PaintPage(Sender: TObject;
  PaintWhat: TPSPaintWhat; Canvas: TCanvas; Rect: TRect): Boolean;
begin
// couldn't get this to work using if...else on the paintwhat so do the
// margins by hand
  if PaintWhat=pwFullPage then begin
    Canvas.StretchDraw(Rect,PrintOut.MetaFiles[PageDisplaying]);
    result := false;
  end
  else if PaintWhat=pwGreekText then begin
    // margins are drawn for us
    result := true; // stops further calls ???
  end
  else result := false;
end;


{ TPanelWithCanvas }

procedure TPanelWithCanvas.Paint;
begin
  inherited;
  if Assigned(fOnPaint) then fOnPaint(self);
end;

//**************************************************************

procedure TPrintPreview_form.UpDown1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  StretchHandle1.GridX := StrtoInt(Edit1.Text);
  StretchHandle1.GridY := StrtoInt(Edit1.Text);
  StretchHandle1.SnapToGrid:=SnapToGrid.Checked;
end;

procedure TPrintPreview_form.SnapToGridClick(Sender: TObject);
begin
  StretchHandle1.GridX := StrtoInt(Edit1.Text);
  StretchHandle1.GridY := StrtoInt(Edit1.Text);
  StretchHandle1.SnapToGrid:=SnapToGrid.Checked;
end;

procedure TPrintPreview_form.StretchHandle1Moved(Sender: TObject);
var
  tpwc:TPanelWithCanvas;
begin
// don't really need these checks but better put them in...
  if stretchhandle1.ChildCount>0 then begin
    tpwc := TPanelWithCanvas(stretchhandle1.Children[0]);
    if assigned(tpwc.OnResize) then tpwc.OnResize(tpwc);
  end;
end;

procedure Tsingle_page.Special_Mouse_handler(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  parent_form.StretchHandle1.detach;
  parent_form.StretchHandle1.attach(sender as TControl);
end;

end.