unit uBitmap;

interface

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,  // must "uses" before Graphics, bacause TBitmap,TCanvas cause trouble.
{$ENDIF}
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  Rubies;

var
  cBitmap: Tvalue;

function ap_cBitmap: Tvalue;
function ap_iBitmap(real: TBitmap; owner: Tvalue): Tvalue;
procedure Init_Bitmap;

implementation

uses
  Classes, SysUtils,
  uIndexer,
  uConv,
  uRect, uByteArray,
  uDefUtils, uIntern, uAlloc, uProp, uPhi, uCanvas, uGraphic;

type TMyBitmap = class(TBitmap);

function ap_cBitmap: Tvalue;
begin
  result := cBitmap;
end;

procedure Bitmap_setup(obj: Tvalue; real: TBitmap);
begin
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
end;

function Bitmap_alloc(klass: Tvalue; real: TBitmap): Tvalue;
begin
  result := TmpAlloc(klass, real);
  Bitmap_setup(result, real);
end;

function ap_iBitmap(real: TBitmap; owner: Tvalue): Tvalue;
begin
  result := Bitmap_alloc(cBitmap, real);
  ap_owner(result, owner);
end;

function Bitmap_new(This: Tvalue): Tvalue; cdecl;
var
  real: TBitmap;
begin
  real := TBitmap.Create;
  result := ObjAlloc(This, real);
  Bitmap_setup(result, real);
  ap_obj_call_init(result, 0, nil);
end;

function Bitmap_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TBitmap;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.LoadFromFile(dl_String(v));
    except
      on E: EFOpenError do
        ap_raise(ap_eIOError, E.message);
      on E: EInvalidGraphic do
        ap_raise(ap_eStandardError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.LoadFromStream(stream);
    except
      on E: EReadError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Bitmap_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TBitmap;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.SaveToFile(dl_String(v));
    except
      on E: EFCreateError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.SaveToStream(stream);
    except
      on E: EWriteError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := v;
end;

function Bitmap_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TBitmap;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  try
    real.Assign(source);
  except
    on E: EConvertError do
      ap_raise(ap_eStandardError, E.message);
  end;
  result := v;
end;

function Bitmap_get_monochrome(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(TBitmap(ap_data_get_struct(This)).monochrome);
end;

function Bitmap_set_monochrome(This, v: Tvalue): Tvalue; cdecl;
begin
  TBitmap(ap_data_get_struct(This)).monochrome := RTEST(v);
  result := v;
end;

(**** str2 made by ap_src_maker ****)

//type HPALETTE = Word;
//type HBitmap = Word;

function Bitmap_changed(This, Sender : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Sender : TObject;
begin
  real := ap_data_get_struct(This);
  dl_Sender := ap_data_get_struct(Sender);
  real.Changed( dl_Sender );
  result := This;
end;

function Bitmap_draw(This, ACanvas, Rect : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_ACanvas : TCanvas;
  dl_Rect0 : TRect;
begin
  real := ap_data_get_struct(This);
  dl_ACanvas := ap_data_get_struct(ACanvas);
  dl_Rect0 := dl_Rect(Rect);
  real.Draw( dl_ACanvas, dl_Rect0 );
  result := This;
end;

function Bitmap_handle_needed(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.HandleNeeded;
  result := This;
end;
{$IFDEF VCL}
function Bitmap_mask_handle_needed(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.MaskHandleNeeded;
  result := This;
end;

function Bitmap_palette_needed(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.PaletteNeeded;
  result := This;
end;
{$ENDIF}
function Bitmap_read_data(This, Stream : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Stream : TStream;
begin
  real := ap_data_get_struct(This);
  dl_Stream := ap_data_get_struct(Stream);
  real.ReadData( dl_Stream );
  result := This;
end;

function Bitmap_write_data(This, Stream : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Stream : TStream;
begin
  real := ap_data_get_struct(This);
  dl_Stream := ap_data_get_struct(Stream);
  real.WriteData( dl_Stream );
  result := This;
end;

function Bitmap_dormant(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.Dormant;
  result := This;
end;

function Bitmap_free_image(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.FreeImage;
  result := This;
end;
{$IFDEF VCL}
function Bitmap_handle_allocated(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.HandleAllocated);
end;
{$ENDIF}
function Bitmap_load_from_stream(This, Stream : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Stream : TStream;
begin
  real := ap_data_get_struct(This);
  dl_Stream := ap_data_get_struct(Stream);
  real.LoadFromStream( dl_Stream );
  result := This;
end;

function Bitmap_mask(This, TransparentColor : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_TransparentColor : TColor;
begin
  real := ap_data_get_struct(This);
  dl_TransparentColor := TColor(dl_Integer(TransparentColor));
  real.Mask( dl_TransparentColor );
  result := This;
end;

function Bitmap_save_to_stream(This, Stream : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Stream : TStream;
begin
  real := ap_data_get_struct(This);
  dl_Stream := ap_data_get_struct(Stream);
  real.SaveToStream( dl_Stream );
  result := This;
end;
{$IFDEF VCL}
function Bitmap_get_ignore_palette(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.IgnorePalette);
end;

function Bitmap_set_ignore_palette(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.IgnorePalette := dl_Boolean(v);
  result := v;
end;
{$ENDIF}
function Bitmap_get_transparent_color(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.TransparentColor));
end;

function Bitmap_set_transparent_color(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.TransparentColor := TColor(dl_Integer(v));
  result := v;
end;
{$IFDEF VCL}
function Bitmap_get_palette(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.GetPalette));
end;

function Bitmap_set_palette(This, Value : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Value : HPALETTE;
begin
  real := ap_data_get_struct(This);
  dl_Value := HPALETTE(dl_Handle(Value));
  real.SetPalette( dl_Value );
  result := This;
end;
{$ENDIF}
function Bitmap_load_from_resource_name(This, Instance, ResName : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Instance : THandle;
  dl_ResName : String;
begin
  real := ap_data_get_struct(This);
  dl_Instance := THandle(dl_Handle(Instance));
  dl_ResName := dl_String(ResName);
  real.LoadFromResourceName( dl_Instance, dl_ResName );
  result := This;
end;

function Bitmap_load_from_resource_id(This, Instance, ResID : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_Instance : THandle;
  dl_ResID : Integer;
begin
  real := ap_data_get_struct(This);
  dl_Instance := THandle(dl_Handle(Instance));
  dl_ResID := dl_Integer(ResID);
  real.LoadFromResourceID( dl_Instance, dl_ResID );
  result := This;
end;
{$IFDEF VCL}
function Bitmap_release_palette(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.ReleasePalette));
end;
{$ENDIF}
function Bitmap_get_transparent_mode(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.TransparentMode));
end;

function Bitmap_set_transparent_mode(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.TransparentMode := TTransparentMode(dl_Integer(v));
  result := v;
end;
{$IFDEF VCL}
function Bitmap_load_from_clipboard_format(This, AFormat, AData, APalette : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  dl_AFormat : Word;
  dl_AData : THandle;
  dl_APalette : HPALETTE;
begin
  real := ap_data_get_struct(This);
  dl_AFormat := dl_Integer(AFormat);
  dl_AData := THandle(dl_Handle(AData));
  dl_APalette := HPALETTE(dl_Handle(APalette));
  real.LoadFromClipboardFormat( dl_AFormat, dl_AData, dl_APalette );
  result := This;
end;

function Bitmap_release_handle(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.ReleaseHandle));
end;

function Bitmap_release_mask_handle(This : Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.ReleaseMaskHandle));
end;
{$ENDIF}
(*
{$IFDEF VCL}HBitmap{$ELSE}QPixmapH{$ENDIF}

File Qt.pas:
        QPixmapH = class(QPaintDeviceH) end;

File Qt.pas:
  QPaintDeviceH = class(TObject) end;
*)
{$IFDEF VCL}
function Bitmap_get_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.Handle));
end;

function Bitmap_set_handle(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.Handle := HBitmap(dl_Handle(v));
  result := v;
end;
{$ENDIF}
{$IFDEF VCL}
function Bitmap_get_handle_type(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.HandleType));
end;

function Bitmap_set_handle_type(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.HandleType := TBitmapHandleType(dl_Integer(v));
  result := v;
end;

function Bitmap_get_mask_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.MaskHandle));
end;

function Bitmap_set_mask_handle(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.MaskHandle := HBitmap(dl_Handle(v));
  result := v;
end;
{$ENDIF}
function Bitmap_get_pixel_format(This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.PixelFormat));
end;

function Bitmap_set_pixel_format(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  real.PixelFormat := TPixelFormat(dl_Integer(v));
  result := v;
end;

(**** made by ap_src_maker ****)

function ap_ByteArray(ptr:Pointer; len:Integer):Tvalue;  // String
begin
  result := rb_str_new( ptr, len);
end;
//function dl_ByteArray(ptr:Pointer; len:Integer; v:Tvalue):Integer;
function dl_ByteArray(ptr:PChar; len:Integer; v:Tvalue):Integer;
var
  str:String;
  x:Integer;
begin
  str := dl_String(v);
  if len > length(str) then len := length(str);
  for x := 0 to len-1 do ptr[x] := str[x+1];
//  StrLCopy(ptr,@str[1],len);
end;

function Bitmap_get_scan_line(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  p: Pvalue;
  dl_Row : Integer;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  real := ap_data_get_struct(This);
  p := argv;
  dl_Row := dl_Integer(p^);
  result := ap_ByteArray(real.ScanLine[dl_Row], real.Width);
end;

function Bitmap_set_scan_line(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
  p: Pvalue;
  dl_Row : Integer;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  real := ap_data_get_struct(This);
  p := argv;
  dl_Row := dl_Integer(p^); inc(p);
  dl_ByteArray(real.ScanLine[dl_Row], real.Width, p^);
  result := This;
end;

function Bitmap_scan_line_direct(This, row: Tvalue): Tvalue; cdecl;
var
  real: TMyBitmap;
begin
  real := ap_data_get_struct(This);
  result := ap_pByteArray(real.ScanLine[dl_Integer(row)]);
end;

procedure Init_Bitmap;
begin
  cBitmap := rb_define_class_under(mPhi, 'Bitmap', ap_cGraphic);
  OutputProp(cBitmap, TBitmap);

  rb_define_singleton_method(cBitmap, 'new', @Bitmap_new, 0);
  rb_define_method(cBitmap, 'load', @Bitmap_load, 1);
  rb_define_method(cBitmap, 'save', @Bitmap_save, 1);
  rb_define_method(cBitmap, 'assign', @Bitmap_assign, 1);
  rb_define_attr(cBitmap, 'canvas', 1, 0);
  DefineAttrSet(cBitmap, 'monochrome', Bitmap_set_monochrome);
  DefineAttrGet(cBitmap, 'monochrome', Bitmap_get_monochrome);
  rb_define_alias(cBitmap, 'monochrome?', 'monochrome');

(**** str3 made by ap_src_maker ****)
  rb_define_method(cBitmap, 'changed', @Bitmap_changed, 1);
  rb_define_method(cBitmap, 'draw', @Bitmap_draw, 2);
  rb_define_method(cBitmap, 'handle_needed', @Bitmap_handle_needed, 0);
{$IFDEF VCL}
  rb_define_method(cBitmap, 'mask_handle_needed', @Bitmap_mask_handle_needed, 0);
  rb_define_method(cBitmap, 'palette_needed', @Bitmap_palette_needed, 0);
{$ENDIF}
  rb_define_method(cBitmap, 'read_data', @Bitmap_read_data, 1);
{$IFDEF VCL}
  rb_define_method(cBitmap, 'palette', @Bitmap_get_palette, 0);
  rb_define_method(cBitmap, 'palette=', @Bitmap_set_palette, 1);
{$ENDIF}
  rb_define_method(cBitmap, 'write_data', @Bitmap_write_data, 1);
  rb_define_method(cBitmap, 'dormant', @Bitmap_dormant, 0);
  rb_define_method(cBitmap, 'free_image', @Bitmap_free_image, 0);
{$IFDEF VCL}
  rb_define_method(cBitmap, 'handle_allocated', @Bitmap_handle_allocated, 0);
  rb_define_method(cBitmap, 'load_from_clipboard_format', @Bitmap_load_from_clipboard_format, 3);
{$ENDIF}
  rb_define_method(cBitmap, 'load_from_stream', @Bitmap_load_from_stream, 1);
  rb_define_method(cBitmap, 'load_from_resource_name', @Bitmap_load_from_resource_name, 2);
  rb_define_method(cBitmap, 'load_from_resource_id', @Bitmap_load_from_resource_id, 2);
  rb_define_method(cBitmap, 'mask', @Bitmap_mask, 1);
{$IFDEF VCL}
  rb_define_method(cBitmap, 'release_handle', @Bitmap_release_handle, 0);
  rb_define_method(cBitmap, 'release_mask_handle', @Bitmap_release_mask_handle, 0);
  rb_define_method(cBitmap, 'release_palette', @Bitmap_release_palette, 0);
//  rb_define_method(cBitmap, 'save_to_clipboard_format', @Bitmap_save_to_clipboard_format, 3);
{$ENDIF}
  rb_define_method(cBitmap, 'save_to_stream', @Bitmap_save_to_stream, 1);
{$IFDEF VCL}
  DefineAttrGet(cBitmap, 'handle', Bitmap_get_handle);
  DefineAttrSet(cBitmap, 'handle', Bitmap_set_handle);
{$ENDIF}
{$IFDEF VCL}
  DefineAttrGet(cBitmap, 'handle_type', Bitmap_get_handle_type);
  DefineAttrSet(cBitmap, 'handle_type', Bitmap_set_handle_type);
  DefineAttrGet(cBitmap, 'ignore_palette', Bitmap_get_ignore_palette);
  DefineAttrGet(cBitmap, 'ignore_palette?', Bitmap_get_ignore_palette);
  DefineAttrSet(cBitmap, 'ignore_palette', Bitmap_set_ignore_palette);
  DefineAttrGet(cBitmap, 'mask_handle', Bitmap_get_mask_handle);
  DefineAttrSet(cBitmap, 'mask_handle', Bitmap_set_mask_handle);
{$ENDIF}
  DefineAttrGet(cBitmap, 'pixel_format', Bitmap_get_pixel_format);
  DefineAttrSet(cBitmap, 'pixel_format', Bitmap_set_pixel_format);
  DefineAttrGet(cBitmap, 'transparent_color', Bitmap_get_transparent_color);
  DefineAttrSet(cBitmap, 'transparent_color', Bitmap_set_transparent_color);
  DefineAttrGet(cBitmap, 'transparent_mode', Bitmap_get_transparent_mode);
  DefineAttrSet(cBitmap, 'transparent_mode', Bitmap_set_transparent_mode);
(**** made by ap_src_maker ****)
  DefineIndexer(cBitmap, 'scan_line', @Bitmap_get_scan_line, @Bitmap_set_scan_line);
  rb_define_method(cBitmap, 'scan_line_direct', @Bitmap_scan_line_direct, 1);
end;

end.
