unit U_PrintLists; interface uses Windows, U_LNG, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,Printers,PCTypesUtils, RzPanel, ComCtrls, siComp, siLngLnk; type TF_PrintLists = class(TForm) bClose: TBitBtn; prnLabel: TLabel; bSetting: TBitBtn; bPrint: TBitBtn; RzPanel1: TRzPanel; ScrollBox1: TScrollBox; pbox: TPaintBox; ScrollBox2: TScrollBox; lvCadLists: TListView; sp: TSplitter; lng_Forms: TsiLangLinked; procedure bCloseClick(Sender: TObject); procedure pboxPaint(Sender: TObject); procedure FormCreate(Sender: TObject); procedure bSettingClick(Sender: TObject); procedure bPrintClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure lvCadListsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); private { Private declarations } Procedure DrawPage; Procedure DrawMargins; public { Public declarations } tBmp: TBitmap; CadControl: Pointer; Procedure Init; end; var F_PrintLists: TF_PrintLists; prnName: String; prnW,prnH: Integer; resX,resY: Integer; offX,offY: Integer; dx,dy: Integer; dScale: Double; ox,oy,pw,ph:Integer; dpm: Double; implementation {$R *.DFM} uses PCDrawing, PowerCad, U_BaseCommon, U_Common, U_Constants; { TfrmPrv } procedure TF_PrintLists.Init; begin prnName := Printer.Printers[Printer.PrinterIndex]; prnLabel.Caption := cPrevForm_Mes1 + prnName; prnW := GetDeviceCaps(printer.Handle, PHYSICALWIDTH); prnH := GetDeviceCaps(printer.Handle, PHYSICALHEIGHT); resX := GetDeviceCaps(printer.Handle, LOGPIXELSX); resY := GetDeviceCaps(printer.Handle, LOGPIXELSY); offX := GetDeviceCaps(printer.Handle, PHYSICALOFFSETX ); offY := GetDeviceCaps(printer.Handle, PHYSICALOFFSETY ); // offX := 0; // offY := 0; end; procedure TF_PrintLists.bCloseClick(Sender: TObject); begin Close; end; procedure TF_PrintLists.pboxPaint(Sender: TObject); var //clpRgn: Integer; clpRgn: HRGN; begin try DrawPage; tbmp.Canvas.Brush.Color := clWhite; tbmp.Canvas.Brush.Style := bsSolid; tbmp.Canvas.FillRect(Rect(0,0,tbmp.Width,tbmp.Height)); TPCDrawing(CadControl).DrawToCanvas(tbmp.canvas, dx, dy, dScale); clpRgn := CreateRectRgn(dx + ox, dy + ox, dx + pw - ox, dy + ph - ox); SelectClipRgn(pbox.canvas.handle,clpRgn); Pbox.Canvas.Draw(0, 0, tbmp); SelectClipRgn(pbox.canvas.handle, 0); DeleteObject(ClpRgn); DrawMargins; except on E: Exception do AddExceptionToLogEx('TF_PrintLists.pboxPaint', E.Message); end; end; procedure TF_PrintLists.DrawPage; var xr, yr, cr: Double; dpmO: Double; begin try xr := (pbox.Width - 10) / prnW; yr := (pBox.Height - 10) / prnH; if xr < yr then cr := xr else cr := yr; pw := round(prnW * cr); ph := round(prnH * cr); ox := round(offX * cr); oy := round(offY * cr); if ox < 3 then ox := 3; if oy < 3 then oy := 3; dx := (pbox.Width - pw) div 2; dy := (pbox.Height - ph) div 2; dpm := (((pw * resx) / prnW) / 25.4); dpmO := TPCDrawing(CadControl).DotsPerMilOrig; dScale := dpm / dpmO; pbox.Canvas.Brush.Style := bsSolid; pbox.Canvas.Brush.Color := clGray; pbox.Canvas.Pen.Color := clGray; pbox.Canvas.Pen.Style := psSolid; pbox.Canvas.Rectangle(dx + 4, dy + 4, dx + pw + 4, dy + ph + 4); pbox.Canvas.Pen.Color := clBlack; pbox.Canvas.Brush.Color := clWhite; pbox.Canvas.Rectangle(dx, dy, dx + pw, dy + ph); except on E: Exception do AddExceptionToLogEx('TF_PrintLists.DrawPage', E.Message); end; end; procedure TF_PrintLists.DrawMargins; begin try pbox.Canvas.pen.Color := clRed; pbox.Canvas.MoveTo(dx+ox,dy); pbox.Canvas.LineTo(dx+ox,dy+ph); pbox.Canvas.MoveTo(dx,dy+oy); pbox.Canvas.LineTo(dx+pw,dy+oy); pbox.Canvas.MoveTo(dx+pw-ox,dy); pbox.Canvas.LineTo(dx+pw-ox,dy+ph); pbox.Canvas.MoveTo(dx,dy+ph-oy); pbox.Canvas.LineTo(dx+pw,dy+ph-oy); except on E: Exception do AddExceptionToLogEx('TF_PrintLists.DrawMargins', E.Message); end; end; procedure TF_PrintLists.FormCreate(Sender: TObject); begin try tBmp := tBitmap.Create; tbmp.Width := pbox.width; tbmp.Height := pbox.height; except on E: Exception do AddExceptionToLogEx('TF_PrintLists.FormCreate', E.Message); end; end; procedure TF_PrintLists.bSettingClick(Sender: TObject); begin try TPCDrawing(CadControl).ExecuteTBCommand(cPrinterSetup); Init; PBox.Refresh; except on E: Exception do AddExceptionToLogEx('TF_PrintLists.bSettingClick', E.Message); end; end; procedure TF_PrintLists.bPrintClick(Sender: TObject); var i: Integer; Item: TListItem; PrintCad: pointer; begin try for i := 0 to lvCadLists.Items.Count - 1 do begin Item := lvCadLists.Items[i]; // печатать этот лист if Item.Checked then begin PrintCad := Item.Data; TPCDrawing(PrintCad).PrintDrawing(TPowerCad(PrintCad).ActiveFile); // TPCDrawing(PrintCad).ExecuteTBCommand(cPrint); end; end; except on E: Exception do AddExceptionToLogEx('TF_PrintLists.bPrintClick', E.Message); end; end; procedure TF_PrintLists.FormDestroy(Sender: TObject); begin //tbmp.FreeImage; //tbmp.Free; //tbmp.free; end; procedure TF_PrintLists.lvCadListsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin try CadControl := Item.Data; PBox.Refresh; except on E: Exception do AddExceptionToLogEx('TF_PrintLists.lvCadListsSelectItem', E.Message); end; end; end.