expertcad/SRC/Main/U_PrintLists.pas

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];
      // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
      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.