unit uPrinter;

(****
TPrinter
	Aborted
	Canvas		ほとんどのプリンタで使用できません。
	Capabilities	TPrinterCapability = (pcCopies, pcOrientation,
pcCollation);
	Copies
	Fonts		TStrings; タイプフェースの名前
	Handle
	Orientation	TPrinterOrientation = (poPortrait, poLandscape);
	PageHeight
	PageNumber
	PageWidth
	PrinterIndex	OK
	Printers	OK
	Printing
	Title		OK
****)

interface

uses
{$IFDEF VCL}
  Printers,
{$ELSE}
  QPrinters,
{$ENDIF}
  Rubies;

var
  cPrinter: Tvalue;
  vPrinter: Tvalue;

function ap_cPrinter: Tvalue;
function ap_vPrinter: Tvalue;
procedure Init_Printer;

implementation

uses uDefUtils, uAlloc, uProp, uPhi, uConv, uStrings, uCanvas;

function ap_cPrinter: Tvalue;
begin
  result := cPrinter;
end;

function ap_vPrinter: Tvalue;
begin
  result := vPrinter;
end;

{$IFDEF VCL}
procedure SetPrinter;
var
  Device, Driver, Port: array[0..512] of Char;
  hDev: THandle;
begin
  Printer.GetPrinter(Device, Driver, Port, hDev);
  Printer.SetPrinter(Device, Driver, Port, 0);
end;

function Printer_get_printer_index(This: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  result := ap_Fixnum(real.PrinterIndex);
  SetPrinter;
end;

function Printer_set_printer_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  real.PrinterIndex := dl_Integer(v);
  result := v;
end;
{$ENDIF}

function Printer_get_printers(This: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.Printers, This);
end;

function Printer_get_title(This: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Title);
end;

function Printer_set_title(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  real.Title := dl_String(v);
  result := v;
end;

function Printer_get_aborted(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Bool(TPrinter(ap_data_get_struct(This)).Aborted);
end;
{$IFDEF VCL}
function Printer_get_capabilities(This: Tvalue): Tvalue; cdecl;
var
  Capabilities: TPrinterCapabilities;
begin
  Capabilities := TPrinter(ap_data_get_struct(This)).Capabilities;
  result := ap_Set(Capabilities);
end;
{$ENDIF}
function Printer_get_copies(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TPrinter(ap_data_get_struct(This)).Copies);
end;

//function Printer_get_fonts(This: Tvalue): Tvalue; cdecl;
//begin
//  result := ap_Array(TPrinter(ap_data_get_struct(This)).Fonts);
//end;
{$IFDEF VCL}
function Printer_get_handle(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TPrinter(ap_data_get_struct(This)).Handle);//CLX: Integer -> QPaintDeviceH
end;
{$ENDIF}

function Printer_get_orientation(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(ord(TPrinter(ap_data_get_struct(This)).Orientation));
end;

function Printer_get_page_height(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TPrinter(ap_data_get_struct(This)).PageHeight);
end;

function Printer_get_page_width(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TPrinter(ap_data_get_struct(This)).PageWidth);
end;

function Printer_get_printing(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Bool(TPrinter(ap_data_get_struct(This)).Printing);
end;

function Printer_set_copies(This,v: Tvalue): Tvalue; cdecl;
begin
  result := v;
  TPrinter(ap_data_get_struct(This)).Copies := dl_Integer(v);
end;

function Printer_set_orientation(This,v: Tvalue): Tvalue; cdecl;
begin
  result := v;
  TPrinter(ap_data_get_struct(This)).Orientation := TPrinterOrientation(dl_Integer(v));
end;

function Printer_instance(This: Tvalue): Tvalue; cdecl;
begin
  result := vPrinter;
end;

procedure Regist_Printer;
var
  real: TPrinter;
  obj: Tvalue;
begin
  real := Printer;
  obj := TmpAlloc(cPrinter, real);
  vPrinter := obj;
  rb_define_const(mPhi, 'PRINTER', obj);
end;

function Printer_get_canvas(This: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  result := ap_iCanvas(real.canvas,This);
end;

function Printer_doc(This: Tvalue): Tvalue; cdecl;
var
  real: TPrinter;
begin
  real := ap_data_get_struct(This);
  try
    real.BeginDoc;
    result := rb_yield(Qnil);
  finally
    real.EndDoc;
  end;
end;

procedure Init_Printer;
begin
  cPrinter := rb_define_class_under(mPhi, 'Printer', ap_cObject);
//  OutputProp(cPrinter, TPrinter);
  rb_undef_method(CLASS_OF(cPrinter), 'new');
  rb_define_singleton_method(cPrinter, 'instance', @Printer_instance, 0);
{$IFDEF VCL}
  DefineAttrGet(cPrinter, 'printer_index', Printer_get_printer_index);
  DefineAttrSet(cPrinter, 'printer_index', Printer_set_printer_index);
{$ENDIF}
  DefineAttrGet(cPrinter, 'printers', Printer_get_printers);
  DefineAttrGet(cPrinter, 'title', Printer_get_title);
  DefineAttrSet(cPrinter, 'title', Printer_set_title);

  DefineAttrGet(cPrinter, 'aborted', Printer_get_aborted);
{$IFDEF VCL}
  DefineAttrGet(cPrinter, 'capabilities', Printer_get_capabilities);
{$ENDIF}
  DefineAttrGet(cPrinter, 'copies', Printer_get_copies);
//  DefineAttrGet(cPrinter, 'fonts', Printer_get_fonts);
{$IFDEF VCL}
  DefineAttrGet(cPrinter, 'handle', Printer_get_handle);
{$ENDIF}
  DefineAttrGet(cPrinter, 'orientation', Printer_get_orientation);
  DefineAttrGet(cPrinter, 'page_height', Printer_get_page_height);
  DefineAttrGet(cPrinter, 'page_width', Printer_get_page_width);
  DefineAttrGet(cPrinter, 'printing', Printer_get_printing);

  DefineAttrSet(cPrinter, 'copies', Printer_set_copies);
  DefineAttrSet(cPrinter, 'orientation', Printer_set_orientation);

  OutputConstSetType(mPhi, TypeInfo(TPrinterCapability));
  OutputConstSetType(mPhi, TypeInfo(TPrinterOrientation));

  rb_define_method(cPrinter, 'doc', @Printer_doc, 0);
  rb_define_method(cPrinter, 'canvas', @Printer_get_canvas, 0);

  Regist_Printer;
end;

end.
