(*
/*

// wrapper for {Painntbox} control, {Bitmap}, {Canvas}

CLASS {AL4_drawing|_Delphi_KOL},
NATIVE, UNTESTED, BYTES :

IMPORT: {Control}, {Bitmap}, {Stream}, {Icon}, {Bitmap_direct},
        {String_functions}, {AL4_form}, {Paintbox}, {File_stream},
        {Geometry}, {Canvas}, {Long_int} .
IMPORT: {NATIVE_Stream_on_C_Stream} .

NATIVE: "uses AL4_drawing, AL4_font, AL4_form, Windows;" .

//?{Printer}
NATIVE: "uses KOLMHPrinters;" .
//.

NATIVE: "///copy NATIVE_Stream_on_C_Stream.pas" .
*/
*)
unit AL4_drawing;
{$I EXTERNAL_DEFINES.inc}
{$I KOLDEF.inc}

interface

uses {$IFDEF KOL} KOL 
//?{Printer}
			 , KOLMHPrinters
//.
     {$ELSE} Classes, Forms, Controls, Menus,
             StdCtrls, ExtCtrls, ComCtrls, Dialogs, Graphics
     {$ENDIF}, NATIVE_Stream_on_C_Stream,
// use AL4 to access system functions (AL4.pas inserted by the compiler into
// a project folder)
     AL4,
// use All_classes from a project folder (generated for a certain project)
     All_classes, AL4_form, AL4_font,
     unitC_Control {to access NoneObj_C_Control},
     Windows, Messages
     {$IFNDEF SMALLEST_CODE}
     , JpegObj, KOLPng, KOLGif
     {$ENDIF}
     {$IFDEF KOLGRAPHIC}
     , KolGraphicEx
     {$ELSE}
//?{Pcx}
	 , KOLPcx
//.
     {$ENDIF}
     ;

//{$WARN UNIT_DEPRECATED OFF}
//{$WARN SYMBOL_PLATFORM OFF}
//{$IFDEF Delphi7}
//{$WARN UNSAFE_TYPE OFF}
//{$WARN UNSAFE_CAST OFF}
//{$WARN UNSAFE_CODE OFF}
//{$ENDIF}

// do not remove following comment!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//defines

type
    PScrolled_paintbox = ^TScrolled_paintbox;
    TScrolled_paintbox = object(TObj)
    public
		AL4Form: PAL4Form;
        Panel: PControl;
        PBox: PControl;
        VBar: PControl;
        HBar: PControl;
        Content_width: Double;
        Content_height: Double;
        row_width: Double;
        line_height: Double;
        coeff_vert: Double;
        coeff_horz: Double;
        Can_focus: Boolean;
        caret_active: Boolean;
        
        suspend_count: Integer;
        
        procedure DoResize(Sender: PObj);
        procedure Adjust_components;
        procedure Paint_box(Sender: PControl; DC: HDC);
        function Bar_message(var Msg: KOL.TMsg; var Rslt: Integer): Boolean;
        function PBox_message(var M: KOL.TMsg; var Rslt: Integer): Boolean;
    end;

    PBitmapEx = ^TBitmapEx;
    TBitmapEx = object(KOL.TObj)
        public Bmp: KOL.PBitmap;
        public Ico: KOL.PIcon;
//?{Gif}
		public Gif: PGif;
//.
        public Bitmap_object: Ref_obj;
        public CanvasObject: Integer;
//?{Printer}
        public Printer: PMHPrinter;
//.
        public LocalCopyPixels: Pointer;
        public LocalSize: Integer;
        public AlphaChannel: KOL.PBitmap;
        public locked_Y: Integer;
        public locked_H: Integer;
        destructor Destroy; virtual;
    end;

function UnitsFromCoords(C: PCanvas; C_C: C_Canvas; Value_pixels: Double): Double;
    
// paint box functions    
function Do_Create_paint_box(form: Integer; X_P: Pointer;
    X_V, X_H, X_Can_focus: Boolean): Integer;
    
// bitmap functions
function Do_Create_bitmap(X_B: Ref_obj; X_Bpp: Integer): Integer;
procedure Do_Set_bitmap_size(X_B: Integer; X_W, X_H: Integer);

// can ?
function Do_Can_load_bitmap_fmt(const X_Format: String): Boolean;
function Do_Can_save_bitmap_fmt(const X_Format: String): Boolean;


//bmp
function Do_Get_bitmap_from_stream(X_A: DynAByte; X_B: Integer): Boolean;
function Do_Save_to_stream_bmp(X_B: Integer; X_S: Ref_obj): Boolean;
function Do_Save_bitmap(X_B: Integer; const X_Path: String): Boolean;
function Do_get_bitmap_from_clipboard(X_B: Integer): Boolean;
function Do_put_bitmap_to_clipboard(X_B: Integer): Boolean;

//jpeg
function Do_get_jpeg_from_stream_ex(
	X_A: DynAByte; X_B: Integer; X_Div: Integer): Boolean;
function Do_Save_bitmap_jpg(
	X_B: Integer; const X_Path: String; X_Quality: Integer): Boolean;
function Do_Save_to_stream_jpg(
	X_B: Integer; X_Stream: Ref_obj; X_Quality: Integer): Boolean;	
	
//png
function Do_get_png_from_stream_ex(X_A: DynAByte; X_B: Integer;
X_Div: Integer): Boolean;
function Do_Save_to_stream_png(
	X_B: Integer; X_Stream: Ref_obj): Boolean;
function Do_Save_bitmap_png(
	X_B: Integer; const X_Path: String): Boolean;	

//gif
function Do_get_gif_from_stream(X_A: DynAByte; X_B: Integer): Boolean;
function Do_Get_gif_frames_count(X_B: Integer): Integer;
procedure Do_Set_gif_current_frame(X_B: Integer; X_I: Integer);
function Do_Get_gif_frame_duration(X_B: Integer): Integer;
//pcx
function Do_get_pcx_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//psd
function Do_get_psd_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//targa
function Do_get_tga_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//tiff
function Do_get_tif_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//pcd
function Do_get_pcd_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;


procedure Do_Draw_bitmap_rotated_flipped(
X_Target, X_Source, X_Angle: Integer; Flip_w, Flip_h: Boolean);
procedure Do_Draw_bitmap_inverted(X_Target, X_Source: Integer);

procedure Do_Destroy_bitmap(X_B: Integer);
procedure Do_draw_bitmap(X_B: Integer; X_D: Ref_obj; X, Y, W, H: Double);


// {Icon}
procedure Do_load_icon(X_B: Integer; X_In: Ref_obj);

// {Bitmap_direct}
procedure Do_LockBitmapPixels(X_B: Ref_obj; X_Y, X_H: Integer; X_Read: Boolean);
procedure Do_UnlockBitmapPixels(X_B: Ref_obj; X_Write: Boolean);

// canvas functions
function Do_Create_bitmap_canvas(
	X_C: Ref_obj; X_B: Ref_obj): Integer;
function Do_Create_printer_canvas(
	X_C: Ref_obj; X_Printer_handle: Integer): Integer;

procedure Do_Paint_text(X_C: Ref_obj; X_X, X_Y: Double; const Text: String);

procedure Do_transform_reset(X_C: Ref_obj);
procedure Do_transform_offset(X_C: Ref_obj; Dx, Dy: Double);
procedure Do_transform_rotate(X_C: Ref_obj; Angle: Double);
procedure Do_transform_scale(X_C: Ref_obj; Sx, Sy: Double);

function Get_canvas(X_Bmp: Ref_obj; var C: C_Canvas; var A: PCanvas): PCanvas;

procedure Do_provide_window_caret(X_S, off_x, off_y, w_caret, h_caret: Integer);
procedure Do_destroy_window_caret(X_S: Integer);

function UnitsToCoords(C: PCanvas; 
	C_C: C_Canvas; Value_units: Double): Integer;
procedure call_form_scrolled(SPB: PScrolled_paintbox);

implementation

(*
/*

FUNCTION Get_system_color(
	{Canvas}.{system_color} C|olor_index) ==> INT, NATIVE :
@   "var i: Integer;"
    "i := COLOR_ACTIVECAPTION;"
    "case X_C of"
    "0: i := COLOR_ACTIVECAPTION;"
    "1: i := COLOR_GRADIENTACTIVECAPTION;"
    "2: i := COLOR_ACTIVEBORDER;"
    "3: i := COLOR_CAPTIONTEXT;"
    "4: i := COLOR_BTNFACE;"
    "5: i := COLOR_BTNTEXT;"
    "6: i := COLOR_BTNHILIGHT;"
    "7: i := COLOR_BTNSHADOW;"
    "8: i := COLOR_DESKTOP;"
    "9: i := COLOR_GRAYTEXT;"
    "10: i := COLOR_INFOBK;"
    "11: i := COLOR_INFOTEXT;"
    "12: i := COLOR_INACTIVECAPTION;"
    "13: i := COLOR_GRADIENTACTIVECAPTION;"
    "14: i := COLOR_INACTIVEBORDER;"
    "15: i := COLOR_INACTIVECAPTIONTEXT;"
    "16: i := COLOR_MENU;"
    "17: i := COLOR_MENUTEXT;"
    "18: i := 29 {COLOR_MENUHIGHLIGHT};"
    "19: i := COLOR_SCROLLBAR;"
    "20: i := COLOR_WINDOW;"
    "21: i := COLOR_WINDOWTEXT;"
    "22: i := COLOR_WINDOWFRAME;"
    "23: i := COLOR_HIGHLIGHT;"
    "24: i := COLOR_HIGHLIGHTTEXT;"
    "end;"
    "RESULT := GetSysColor(i) or $FF000000;" .
    
FUN Get_rgba_order ==> {Canvas}.{rgba_order} := 'R_G_B' .
    
*/
*)

//-------------------------------------------------------- P A I N T   B O X

{ TScrolled_paintbox }

(*
/*
// Create paint box control, return descriptor.
//---------------------------------------------

FUN Create_paint_box(
    {Control} P|aintbox_control,
    STR Op|tions_V_H_Focus) ==> INT
    :
    INT form|_handle = P.Form_.Handle
    //DEBUG: "create paint box " P.Alias " Op=" Op " V=" ("V" IN Op).S #NL ;
    RESULT = do_Create_paint_box(form, P, "V" IN Op, "H" IN Op, "F" IN Op, TRUE)
    .
FUN do_Create_paint_box(
	INT Form|_handle,
	{Control} P|aintbox_control,
    BOOL V|ertical_scrollbar,
    BOOL H|orizontal_scrollbar,
    BOOL Can|_focus,
    BOOL Call_paint) ==> INT, NATIVE : @
    "	Result := Do_Create_paint_box(X_Form, X_P, X_V, X_H, X_Can);" .
    
FUN Create_scene_2D(
    {Control} P|icture_control,
    STR Options|_V_H_F) ==> INT
    :
    INT form|_handle = P.Form_.Handle
    
    RESULT = do_Create_paint_box(form, P,
    	"V" IN Options, "H" IN Options, "F" IN Options, FALSE)
    .

    
*/
*)

function Do_Create_paint_box(
	form: Integer; X_P: Pointer;
    X_V, X_H, X_Can_focus: Boolean): Integer;
var Parent: PAL4Column;
    F: PAL4Form;
	Sbox: PScrolled_paintbox;
begin
    F := PAL4Form(form);
    Parent := PAL4Column(F.Get_current_column_handle);
	New(Sbox, Create);
    
    Sbox.coeff_horz := 1;
    Sbox.coeff_vert := 1;
    Sbox.row_width := 1;
    Sbox.line_height := 1;
    
    Sbox.Panel := NewPanel(Parent.Panel, esNone);
    Sbox.PBox := NewPaintbox(Sbox.Panel);
    if X_Can_focus then
    begin
        Sbox.Can_focus := true;
        Sbox.PBox.TabStop := true;
        Sbox.PBox.OnMessage := Sbox.PBox_message;
        Sbox.PBox.LookTabKeys := []; //[tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn]
    end
        else Sbox.PBox.TabStop := false;
    if X_V then 
    begin
        Sbox.VBar := NewScrollBar(Sbox.Panel, sbVertical);
        Sbox.VBar.OnMessage := Sbox.Bar_message;
    end;
    if X_H then
    begin
        Sbox.HBar := NewScrollBar(Sbox.Panel, sbHorizontal);
        Sbox.HBar.OnMessage := Sbox.Bar_message;
    end;
    
	Sbox.AL4Form := F;
    Sbox.Panel.Width := Points(100);
	Sbox.Panel.Height := Points(100);
    Sbox.Panel.Tag := Integer(X_P);
    
    SBox.Panel.CustomData := Sbox;
    Sbox.PBox.Tag := Integer(X_P);
    Sbox.Tag := Integer(X_P);
    PObj(X_P).Tag := DWORD(Sbox);
    
    Adjust_control_location_1(Parent, Sbox.Panel);
    Set_control_events(Parent, Sbox.Panel);
    Set_control_events(Parent, Sbox.PBox);
    Set_Win_control_events(Parent, Sbox.PBox);

    Sbox.PBox.OnPaint := Sbox.Paint_box;
    Sbox.Panel.OnResize := Sbox.DoResize;
    Result := Integer(Sbox.Panel);
end;

var handling_scroll: Boolean;

function TScrolled_paintbox.Bar_message(
    var Msg: KOL.TMsg; var Rslt: Integer): Boolean;
//?{Paintbox}
var CR: Ref_obj;
    CC: C_Paintbox;
    F: C_Form;
//.
begin
//?{Paintbox}
    Result := false;
    case Msg.Message of
    SBM_SETPOS, SBM_SETRANGE, SBM_SETRANGEREDRAW, SBM_SETSCROLLINFO:
        begin
	        CR := Ref_obj(Tag);
	        CC := C_Paintbox(CR.Obj);
	        F := C_Form(CC.F_Form_.Obj);
			
			operation_started(F, 25, CR);
			try
	        CC.M_scrolled;
		    finally
		    F.M_operation_ended(25);
		    end;
        	PBox.Invalidate;
        end;
    end;
//?{Form}.scrolled
	if not handling_scroll then
	begin
		handling_scroll := true;
		try
			call_form_scrolled(@Self);
		finally
			handling_scroll := false;
		end;
    end;
    //DEBUG
    //if (w <> THackControl(Pointer(H)).Width) then
    //    Writeln('width changed for ' + THackControl(Pointer(H)).Caption
    //    + ' from ' + IntToStr(w) + ' to ' 
    //    + IntToStr(THackControl(Pointer(H)).Width) + #13#10 +
    //    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' + #13#10);
//.	
//.
end;

procedure call_form_scrolled(SPB: PScrolled_paintbox);
var F: C_Form;
//?{Form}.scrolled
	CC: C_Control;
//.
begin
//?{Form}.scrolled
	CC := C_Paintbox(Ref_obj(SPB.Tag).Obj);
	F := C_Form(CC.F_Form_.Obj);
    operation_started(F, 25, Ref_obj(SPB.Tag));
    try
    	//Object_assign_hard(F.F_sender, CC);
    	F.M_scrolled;
    finally
    	F.M_operation_ended(25);
    	//Object_assign_hard(F.F_sender, NoneObj_C_Control);
    end;
//.
//.
end;

	(*
	/*
	
    FUN Suspend_paintbox({Paintbox} P|aintbox_control), NATIVE :
        INT h|andle_paintbox = P.Handle 
    	CASE h == 0 ? ==> ;
    NATIVE @
    "var SPB: PScrolled_paintbox;"
    " 	 SPB := PScrolled_paintbox(PControl(X_P).CustomData);"
    "Inc(SPB.suspend_count);"
    //"writeln('++: ' + IntToStr(SPB.suspend_count));"     
    .
    
    FUN Resume_paintbox({Paintbox} P|aintbox_control), NATIVE :
        INT h|andle_paintbox = P.Handle 
    	CASE h == 0 ? ==> ;
    NATIVE @
	"var SPB: PScrolled_paintbox;"
    " 	 SPB := PScrolled_paintbox(PControl(X_P).CustomData);"
    "Dec(SPB.suspend_count);"
    //"writeln('--: ' + IntToStr(SPB.suspend_count));"     
    "if (SPB.suspend_count <= 0) then"
    "	 SPB.Adjust_components;" .
    
	
	
 	FUN Get_control_bitmap_bpp ==> INT := 0 .
	
	
    FUNCTION Call_form_scrolled(
    INT P|aintbox_control_handle), NATIVE : @
    "var SPB: PScrolled_paintbox;"
    " SPB := PScrolled_paintbox(PControl(X_P).CustomData);"
    " call_form_scrolled(SPB);" .
		
	
	*/
	*)


procedure TScrolled_paintbox.Paint_box(
	Sender: PControl; DC: HDC);
//? {Paintbox}
var B: PBitmapEx;
    X: TXForm;
    CF: C_Form;
    R: Ref_obj;
//.
begin
//? {Paintbox}
    R := Ref_obj(Tag);
    CF := C_Form( AL4Form.AL4Object.Obj );

	operation_started(CF, 21, R);
	try
    C_Paintbox(R.Obj).M_before_paint;
    finally
    CF.M_operation_ended(21);
    end;

    if (C_Paintbox(R.Obj).F_need_repaint) then
    begin
		operation_started(CF, 22, R);
		dec(Allow_handle_events);
		try
	    CF.M_Paint;
	    finally
	    inc(Allow_handle_events);
	    CF.M_operation_ended(22);
	    end;
    end;
    
	operation_started(CF, 23, R);
	try
    C_Paintbox(R.Obj).M_after_paint;
    finally
    CF.M_operation_ended(23);
    end;

	B := PBitmapEx(Pointer(
        C_Bitmap(C_Paintbox(Ref_obj(Tag).Obj).F_buffer.Obj).F_Handle ));
    if (B.Bmp.Canvas <> nil) and 
    	(GetGraphicsMode(B.Bmp.Canvas.Handle) <> GM_COMPATIBLE) then
    begin
        ModifyWorldTransform(B.Bmp.Canvas.Handle, X, MWT_IDENTITY);
        SetGraphicsMode(B.Bmp.Canvas.Handle, GM_COMPATIBLE);
    end;
    B.Bmp.Draw(PBox.Canvas.Handle, 0, 0);
//.
end;

function TScrolled_paintbox.PBox_message(
    var M: KOL.TMsg; var Rslt: Integer): Boolean;
//? {Paintbox}.keyboard_focus
var CR: Ref_obj;
    CC: C_Paintbox;
    F: C_Form;
//.
begin
    Result := false;
//? {Paintbox}.keyboard_focus
    case M.Message of 
    WM_SETFOCUS, WM_KILLFOCUS:
        begin
	        CR := Ref_obj(Tag);
	        CC := C_Paintbox(CR.Obj);
	        F := C_Form(CC.F_Form_.Obj);
			
			operation_started(F, 24, CR);
			try
	        CC.M_keyboard_focus(M.Message = WM_SETFOCUS);
		    finally
		    F.M_operation_ended(24);
		    end;
        end;
    end;
//.
end;

procedure TScrolled_paintbox.DoResize(
	Sender: PObj);
begin
  Adjust_components;
  Panel.Invalidate;
end;

(*
/*
	
FUN Adjust_paintbox_components({Paintbox} P|aintbox_object), NATIVE :
	INT h|andle_control = P.Handle
	CASE h == 0 ? ==> ;
	NATIVE @
	"var spb: PScrolled_paintbox;"
	"spb := PScrolled_paintbox(PControl(X_h).CustomData);"
	"spb.Adjust_components;" .
	
	
	FUN Paint_lines_activated(INT H|andle_control), NATIVE : @
	"var SPB: PScrolled_paintbox;"
    " SPB := PScrolled_paintbox(PControl(X_h).CustomData);"
	"SetFocus(SPB.PBox.Handle);" .    
	
	
*/
*)

var adjusting_already: Boolean;

procedure TScrolled_paintbox.Adjust_components;
var VBar_W, HBar_H: Integer;
	p_s, m_v: Integer;
	w_a, h_a: Double;
	CF: C_Form;
begin
	CF := C_Form( AL4Form.AL4Object.Obj );
	//if (CF.F_suspended_count > 0) or not AL4Form.shown or adjusting_already then
	if (CF.F_suspended_count > 0) or adjusting_already then
		Exit;
	inc(CF.F_suspended_count);
	adjusting_already := true;
		{$IFnDEF NOTRY}
	try
		{$ENDIF}
	

    VBar_W := 0;
    HBar_H := 0;
    if VBar <> nil then begin
        VBar_W := VBar.Width;
        VBar.Left := Panel.Width - VBar_W;
    end;
    if HBar <> nil then begin
        HBar_H := HBar.Height;
        HBar.Top := Panel.Height - HBar_H;
    end;
    PBox.Width := Panel.Width - VBar_W;
    PBox.Height := Panel.Height - HBar_H;
    
    if VBar <> nil then 
    begin 
        VBar.Height := Panel.Height - HBar_H;
        
        h_a := Pixels(PBox.Height);
		if h_a > Content_height then h_a := Content_height;
		
		p_s := Trunc(h_a / coeff_vert);
		m_v := Trunc(Content_height / coeff_vert);
		if m_v < 0 then m_v := 0;
       	{$IFnDEF SMALLER_CODE}
       	if VBar.SBMax <> m_v then
       	{$ENDIF}
       		VBar.SBMax := m_v;
       	{$IFnDEF SMALLER_CODE}
       	if VBar.SBPageSize <> p_s then
       	{$ENDIF}
			VBar.SBPageSize := p_s;
    end;
    
    if HBar <> nil then 
    begin 
        HBar.Width := Panel.Width - VBar_W;
        //HBar.SBPageSize := 0;
		
		w_a := Pixels(PBox.Width);
		if w_a > Content_width then w_a := Content_width;
		
       	p_s := Trunc(w_a / coeff_horz);
		m_v := Trunc(Content_width / coeff_horz);
		if m_v < 0 then m_v := 0;
       	{$IFnDEF SMALLER_CODE}
       	if HBar.SBMax <> m_v then
       	{$ENDIF}
       		HBar.SBMax := m_v;
       	{$IFnDEF SMALLER_CODE}
       	if HBar.SBPageSize <> p_s then
       	{$ENDIF}
		HBar.SBPageSize := p_s;
    end;
    
    	{$IFnDEF NOTRY}
    finally
    	{$ENDIF}
    	adjusting_already := false;
    	dec(CF.F_suspended_count);
    	{$IFnDEF NOTRY}
    end;
    	{$ENDIF}
    //PBox.Invalidate;
end;

(*
/*

FUN Invalidate_paintbox(
    INT H|andle_paint_box,
    {Geometry}.{rect} R|ectangle_invalidate)
    :
	do_Invalidate_paintbox(H, R.Loc.X, R.Loc.Y, R.Width, R.Height) .
FUN do_Invalidate_paintbox(INT PB|ox_handle, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_of_rect, REAL H|eight_of_rect), NATIVE
    :
@   "var P: PScrolled_paintbox;"
    "var R: TRect;"
    "	 if X_PB = 0 then Exit;"
    "    P := PScrolled_paintbox(PControl(X_PB).CustomData);"
    "    R := MakeRect(Points(X_X), Points(X_Y),"
    "                  Points(X_X + X_W),"
    "                  Points(X_Y + X_H));"
    "    InvalidateRect(P.PBox.Handle, @R, FALSE);" .
    
FUN Update_paintbox(INT H|andle_paint_box): .    
    
FUN Get_invalid_rect(
    INT H|andle_paint_box, REAL A|rray_coords_DYN[]): .

FUN Set_paintbox_content_area(INT P|aint_box_handle,
    REAL W|idth_area_points, REAL H|eight_area_points,
    REAL Row_w|idth, REAL Line_h|eight), NATIVE :
	     CASE P == 0 ? ==> ;
    NATIVE @
    "var P: PScrolled_paintbox;"
    "var PB: PControl;"
    "	 PB := PControl(X_P);"
    "    P := PScrolled_paintbox(PB.CustomData);"
    "	 P.Content_width := X_W;"
    "	 P.Content_height := X_H;"
    "	 P.row_width := X_Row_w;"
    "	 P.line_height := X_Line_h;"
    "    if X_W <= MaxInt then P.coeff_horz := 1"
    "    else P.coeff_horz := X_W / MaxInt;"
    "    if X_H <= MaxInt then P.coeff_vert := 1"
    "    else P.coeff_vert := X_H / MaxInt;"
    "    P.Adjust_components;" .
    
FUN Paintbox_client_width(
	INT P|aint_box_handle) ==> REAL, NATIVE :
@	"var P: PScrolled_paintbox;"
	"	 if X_P = 0 then Exit;"
	"    P := PScrolled_paintbox(PControl(X_P).CustomData);"
	"	 RESULT := Pixels(P.PBox.Width);" .
	
FUN Paintbox_client_height(
	INT P|aint_box_handle) ==> REAL, NATIVE :
@	"var P: PScrolled_paintbox;"
	"	 if X_P = 0 then Exit;"
	"    P := PScrolled_paintbox(PControl(X_P).CustomData);"
	"	 RESULT := Pixels(P.PBox.Height);" .
    
FUN Set_paint_lines_line_height(INT P|aint_box_handle,
    REAL H|eight_area_points), NATIVE :
	CASE P==0 ? ==> ;
	NATIVE     
@   "var P: PScrolled_paintbox;"
    "    P := PScrolled_paintbox(PControl(X_P).CustomData);"
    "    //if P.VBar <> nil then P.VBar.SB... := Points(X_H);" 
    "    P.Adjust_components;" .
    
FUN Get_hscroll_height(
	INT H|andle_paint_box) ==> REAL RESULT|_points,
    NATIVE :
@   "var P: PScrolled_paintbox;"
    "    P := PScrolled_paintbox(PControl(X_H).CustomData);"
    "    if P.HBar <> nil then RESULT := Pixels(P.HBar.Height);" .


FUN Get_vscroll_width(
	INT H|andle_paint_box) ==> REAL RESULT|_points,
    NATIVE :
@   "var P: PScrolled_paintbox;"
    "    P := PScrolled_paintbox(PControl(X_H).CustomData);"
    "    if P.VBar <> nil then RESULT := Pixels(P.VBar.Width);" .
    
    
FUN Get_scroll_position(
    INT H|andle_paint_box,
    STR What|_box_VH) ==> REAL RESULT|_points, NATIVE
    :
	CASE H == 0 ? ==> ;
    BOOL v|ertical = "v" IN What.Lower
    BOOL hor|izontal = "h" IN What.Lower
    NATIVE @
    "var P: PScrolled_paintbox;"
    "	 if X_H = 0 then Exit;"
    "    P := PScrolled_paintbox(PControl(X_H).CustomData);"
    "    if (X_v) and (P.VBar <> nil) then"
    "       RESULT := P.VBar.SBPosition * P.coeff_vert"
    "    else if (X_hor) and (P.HBar <> nil) then"
    "       RESULT := P.HBar.SBPosition * P.coeff_horz;" .
    
    
FUN Set_scroll_position(
    INT H|andle_paint_box,
    STR What|_box_VH, REAL Value|_points), NATIVE
    :
	CASE H == 0 ? ==> ;
    BOOL v|ertical = "v" IN What.Lower
    BOOL hor|izontal = "h" IN What.Lower
    NATIVE @
    "var P: PScrolled_paintbox;"
    "var n_p: Integer;"
    "    P := PScrolled_paintbox(PControl(X_H).CustomData);"
    "    if (X_v) and (P.VBar <> nil) then"
    "	 begin"
    "		n_p := Round(X_Value / P.coeff_vert);"
    "		{$IFnDEF SMALLER_CODE}"
    "	 	if P.VBar.SBPosition <> n_p then"
    "		{$ENDIF}"
    "       	P.VBar.SBPosition := n_p;"
    "	 end"
    "    else if (X_hor) and (P.HBar <> nil) then"
    "	 begin"
    "		n_p := Round(X_Value / P.coeff_horz);"
    "		{$IFnDEF SMALLER_CODE}"
    "	 	if P.HBar.SBPosition <> n_p then"
    "		{$ENDIF}"
    "       	P.HBar.SBPosition := n_p;" 
    "	 end;".
    
*/
*)

//------------------------------------------------------------------ B I T M A P

(*
/*
// Create TBitmapEx object, return descriptor.
//--------------------------------------------

FUN Create_bitmap(
	{Bitmap} B|itmap_object,
    INT Bpp|bits_per_pixel) ==> INT, NATIVE :
    "    RESULT := Do_Create_bitmap(X_B, X_Bpp);" .
    
    TODO: "support 1, 4, 8, 15, 16 bpp bitmaps" .
*/
*)

function Do_Create_bitmap(
	X_B: Ref_obj; X_Bpp: Integer): Integer;
var B: PBitmapEx;
	C_B: C_Bitmap;
begin
	C_B := C_Bitmap(X_B.Obj);
    new(B, Create);
    B.Bmp := NewBitmap(C_B.F_Width, C_B.F_Height);
    CASE X_Bpp OF
    1: B.Bmp.PixelFormat := pf1bit;
    4: B.Bmp.PixelFormat := pf4bit;
    8: B.Bmp.PixelFormat := pf8bit;
    15: B.Bmp.PixelFormat := pf15bit;
    16: B.Bmp.PixelFormat := pf16bit;
    24: B.Bmp.PixelFormat := pf24bit;
    else B.Bmp.PixelFormat := pf32bit;
    END;
    B.Bitmap_object := X_B;
    Result := Integer(B);
end;

(*
/*

FUN Get_bitmap_depth(
	INT B|itmap_handle) ==> INT RESULT|bpp_or_0, NATIVE :
@   "var B: PBitmapEx;"
    "    B := PBitmapEx(Pointer(X_B));"
    "    case B.Bmp.PixelFormat of" 
    "    pf1bit: RESULT := 1;"
    "    pf4bit: RESULT := 4;"
    "    pf8bit: RESULT := 8;"
    "    pf15bit, pf16bit: RESULT := 16;"
    "    pf24bit: RESULT := 24;"
    "    pf32bit: RESULT := 32;"
    "    end;" .
*/
*)



(*
/*
// Set Bitmap new size
//--------------------

FUN Set_bitmap_size(INT B|itmap_handle,
    INT W|idth_bitmap, INT H|eight_bitmap), NATIVE :
    "     Do_Set_bitmap_size(X_B, X_W, X_H);" .
*/
*)

procedure Do_Set_bitmap_size(
	X_B: Integer; X_W, X_H: Integer);
var B: PBitmapEx;
begin
    B := PBitmapEx(X_B);
    TRY
    B.Bmp.Width := X_W;
    B.Bmp.Height := X_H;
    if B.AlphaChannel <> nil then
    begin
        B.AlphaChannel.Width := X_W;
        B.AlphaChannel.Height := X_H;
    end;
    EXCEPT
    END;
end;

(*
/*
// Load Bitmap from file
//----------------------

FUN Get_bitmap_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
	"	RESULT := Do_get_bitmap_from_stream(X_a, X_B);" .    

FUN Get_jpeg_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
	"	RESULT := Do_get_jpeg_from_stream_ex(X_a, X_B, 1);" .
	
FUN Get_jpeg_from_stream_ex(
{Stream} Source|_stream, INT B|itmap_handle, INT Div|ide_size) ==> BOOL,
NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
	"	RESULT := Do_get_jpeg_from_stream_ex(X_a, X_B, X_Div);" .
	
FUN Get_png_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
    "     RESULT := Do_get_png_from_stream_ex(X_a, X_B, 1);" .
    
FUN Get_png_from_stream_ex(
{Stream} Source|_stream, INT B|itmap_handle, INT Div|ide_size) ==> BOOL,
NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
    "     RESULT := Do_get_png_from_stream_ex(X_a, X_B, X_Div);" .
    
FUN Get_gif_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
    "     RESULT := Do_get_gif_from_stream(X_a, X_B);" .

FUN Get_animated_gif_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	BYTE a|s_memory_bytes[]
	CASE !Source.Load_bytes(a[], Source.Size.To_int) ? ==> ;
	NATIVE @
    "     RESULT := Do_get_gif_from_stream(X_a, X_B);" .
    
*/
*)

function Do_Get_bitmap_from_stream(X_A: DynAByte; X_B: Integer): Boolean;
//?{Bmp}
var Bmp: PBitmapEx;
	B_ref: Ref_obj;
	CB: C_Bitmap;
	MS: PStream;
	i: Integer;
	buf: Byte;
//.
begin
	RESULT := FALSE;
//?{Bmp}
	MS := NewMemoryStream;
	MS.Size := X_A.Count;
	for i := 0 to MS.Size-1 do
	begin
		buf := X_A.GetBytes(i); 
		MS.Write(buf, 1);
	end;
	MS.Position := 0;

	Bmp := PBitmapEx(X_B);
    try
	    TRY
	    Bmp.Bmp.LoadFromStream(MS);
	    Free_And_Nil(Bmp.AlphaChannel);
	    B_ref := Bmp.Bitmap_object;
	    CB := C_Bitmap(B_ref.Obj);
	    CB.F_Width := Bmp.Bmp.Width;
	    CB.F_Height := Bmp.Bmp.Height;
	    RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
	    EXCEPT
	    END;
    finally
    	MS.Free;
    end;
//.
end;

function Do_get_jpeg_from_stream_ex(
	X_A: DynAByte; X_B: Integer; X_Div: Integer): Boolean;
//?{Jpeg}
var Bmp: PBitmapEx;
	B_ref: Ref_obj;
	CB: C_Bitmap;
	J: PJpeg;
	MS: PStream;
	i: Integer;
	buf: Byte;
//.
begin
	RESULT := FALSE;
//?{Jpeg}
	MS := NewMemoryStream;
	MS.Size := X_A.Count;
	for i := 0 to MS.Size-1 do
	begin
		buf := X_A.GetBytes(i); 
		MS.Write(buf, 1);
	end;
	MS.Position := 0;

	J := NewJpeg;
	Bmp := PBitmapEx(X_B);
    try
	    TRY
	        J.PixelFormat := jf24Bit;
	        J.LoadFromStream(MS);
	        J.Performance := jpBestQuality;
	        case X_Div of
	        2: J.Scale := jsHalf;
	        4: J.Scale := jsQuarter;
	        8: J.Scale := jsEighth;
	        else J.Scale := jsFullSize;
	        end;
	        J.DIBNeeded;
		    Bmp.Bmp.Width := J.Width;
		    Bmp.Bmp.Height := J.Height;
		    Bmp.Bmp.PixelFormat := pf32bit;
		    {$IFnDEF SMALLER_CODE}
		    if Bmp.Bmp.Canvas = nil then Exit;
		    {$ENDIF}
		    J.Draw(Bmp.Bmp.Canvas.Handle, 0, 0);
		    Free_And_Nil(Bmp.AlphaChannel);
	        B_ref := Bmp.Bitmap_object;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := Bmp.Bmp.Width;
	        CB.F_Height := Bmp.Bmp.Height;
		    RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
	    EXCEPT
	    END;
    finally
    	J.Free;
    	MS.Free;
    end;
//.
end;

function Do_get_png_from_stream_ex(
X_A: DynAByte; X_B: Integer; X_Div: Integer): Boolean;
//?{Png}
var B: PBitmapEx;
    B_ref: Ref_obj;
    CB: C_Bitmap;
    P: PPngObject;
var	MS: PStream;
	i: Integer;
	buf: Byte;
var AlphaLine: PByteArray;
    AlphaDest: PDWORD;
    y, x: Integer;
//.
begin
	RESULT := FALSE;
//?{Png}
	MS := NewMemoryStream();
	for i := 0 to X_A.Count-1 do
	begin
		buf := X_A.GetBytes(i); 
		MS.Write(buf, 1);
	end;
	MS.Position := 0;
    P := NewPngObject;
    B := PBitmapEx(X_B);
    try
        TRY
        case X_Div of
        2: P.Scale := psHalfSize;
        4: P.Scale := psQuarterSize;
        8: P.Scale := psEightsSize;
        else P.Scale := psFullImage;
        end;
        P.LoadFromStream(MS);
	    if (P.Width > 0) and (P.Height > 0) then
	    begin
	        B.Bmp.Width := P.Width;
	        B.Bmp.Height := P.Height;
	        P.Draw(B.Bmp.Canvas.Handle, 0, 0);
	        if B.AlphaChannel <> nil then
	        begin
		        B.AlphaChannel.Width := P.Width;
		        B.AlphaChannel.Height := P.Height;
		        B.AlphaChannel.PixelFormat := pf32bit;
		        for y := 0 to P.Height-1 do
		        begin
		            AlphaLine := P.AlphaScanLine[y];
		            AlphaDest := B.AlphaChannel.ScanLine[y];
		            for x := 0 to P.Width-1 do
		            begin
		                AlphaDest^ := AlphaLine[x];
		                inc(AlphaLine);
		                inc(AlphaDest);
		            end;
		        end;
	        end;
	    end; 
        B_ref := B.Bitmap_object;
        CB := C_Bitmap(B_ref.Obj);
        CB.F_Width := B.Bmp.Width;
        CB.F_Height := B.Bmp.Height;
        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
        EXCEPT
        END;
    finally
        P.Free;
        MS.Free;
    end;
//.
end;


function Do_get_gif_from_stream(
X_A: DynAByte; X_B: Integer): Boolean;
//?{Gif}
var B: PBitmapEx;
	B_ref: Ref_obj;
	CB: C_Bitmap;
	G: PGif;
var	MS: PStream;
	i: Integer;
	buf: Byte;
//.
begin
	RESULT := FALSE;
//?{Gif}
	MS := NewMemoryStream();
	for i := 0 to X_A.Count-1 do
	begin
		buf := X_A.GetBytes(i); 
		MS.Write(buf, 1);
	end;
	MS.Position := 0;
	G := NewGif;
    B := PBitmapEx(X_B);
    try
	    TRY
	    G.LoadFromStream(MS);
	    
	    B.Bmp.Width := G.Width;
	    B.Bmp.Height := G.Height;
	    G.Draw(B.Bmp.Canvas.Handle, 0, 0);
	    
	    Free_And_Nil(B.AlphaChannel);
	    B_ref := B.Bitmap_object;
	    CB := C_Bitmap(B_ref.Obj);
	    CB.F_Width := G.Width;
	    CB.F_Height := G.Height;
	    RESULT := (G.Width > 0) and (G.Height > 0);
		B.Gif := G;
		G := nil;
	    EXCEPT
	    END;
    finally
    	G.Free;
    	MS.Free;
    end;
//.
end;

(*
/*

FUN Get_gif_frames_count(
INT B|itmap_handle) ==> INT, NATIVE : @
	"RESULT := Do_Get_gif_frames_count(X_B);" .
*/
*)

function Do_Get_gif_frames_count(X_B: Integer): Integer;
var Bmp: PBitmapEx;
begin
	RESULT := 0;
//?{Gif}
	Bmp := PBitmapEx(X_B);
    if (Bmp.Gif <> nil) then RESULT := Bmp.Gif.Count;
//.
end; 
 
(*
/*

FUN Set_gif_current_frame(
INT B|itmap_handle, INT I|ndex_frame_to_set), NATIVE : @
	"Do_Set_gif_current_frame(X_B, X_I);" .
*/
*)

procedure Do_Set_gif_current_frame(X_B: Integer; X_I: Integer);
var Bmp: PBitmapEx;
begin
//?{Gif}
	Bmp := PBitmapEx(X_B);
    if Bmp.Gif <> nil then
    begin
    	Bmp.Gif.Frame := X_I;
    end;
//.
end; 
 
(*
/*

FUN Get_gif_frame_duration(
INT B|itmap_handle) ==> INT, NATIVE : @
	"RESULT := Do_Get_gif_frame_duration(X_B);" .
*/
*)

function Do_Get_gif_frame_duration(X_B: Integer): Integer;
var Bmp: PBitmapEx;
begin
	RESULT := 0;
//?{Gif}
	Bmp := PBitmapEx(X_B);
    if (Bmp.Gif <> nil) then 
    	RESULT := Bmp.Gif.Frames[Bmp.Gif.Frame].Delay;
//.
end; 

(*
/*

FUN Get_pcx_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
    "     RESULT := Do_get_pcx_from_stream(X_Source, X_B);" .
    
*/
*)

{$IFnDEF KOLGRAPHIC}
//?{Pcx}
	{$DEFINE USE_KOLPCX}
//.
{$ENDIF}

function Do_get_pcx_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Pcx}
	{$IFDEF USE_KOLPCX}
var Pcx: PPcx;
	{$ELSE}
var Pcx: PPcxGraphic;	
	{$ENDIF}
var S: PStream;
	B: PBitmapEx;
	B_Ref: Ref_obj;
	CB: C_Bitmap;
//.
begin
	RESULT := FALSE;
//?{Pcx}

	B := PBitmapEx(X_B);
	
	{$IFDEF USE_KOLPCX}
		Pcx := NewPCX;
	{$ELSE}
		new(Pcx, Create);
	{$ENDIF}
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		Pcx.LoadFromStream(S);
		if (Pcx.Width <> 0) and (Pcx.Height > 0) then
		begin
			{$IFDEF USE_KOLPCX}
				B.Bmp.Free;
				B.Bmp := NewBitmap(Pcx.Width, Pcx.Height);
				B.Bmp.PixelFormat := pf32bit;
				Pcx.Draw(B.Bmp.Canvas.Handle, 0, 0);
			{$ELSE}
				B.Bmp.Assign(Pcx.Bitmap);
			{$ENDIF}
			
		    Free_And_Nil(B.AlphaChannel);
		    B_ref := B.Bitmap_object;
		    CB := C_Bitmap(B_ref.Obj);
		    CB.F_Width := Pcx.Width;
		    CB.F_Height := Pcx.Height;
			
			RESULT := TRUE;	
		end;
	finally
		S.Free;
		Pcx.Free;
	end;

//.
end;
(*
/*

FUN Get_psd_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
    "     RESULT := Do_get_psd_from_stream(X_Source, X_B);" .
    
*/
*)

function Do_get_psd_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Psd}
{$IFDEF KOLGRAPHIC}
var Psd: PPsdGraphic;	
var S: PStream;
	B: PBitmapEx;
	B_Ref: Ref_obj;
	CB: C_Bitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Psd}
{$IFDEF KOLGRAPHIC}
	B := PBitmapEx(X_B);
	new(Psd, Create);
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		Psd.LoadFromStream(S);
		if (Psd.Width <> 0) and (Psd.Height > 0) then
		begin
			B.Bmp.Assign(Psd.Bitmap);
			
		    Free_And_Nil(B.AlphaChannel);
		    B_ref := B.Bitmap_object;
		    CB := C_Bitmap(B_ref.Obj);
		    CB.F_Width := Psd.Width;
		    CB.F_Height := Psd.Height;
			
			RESULT := TRUE;	
		end;
	finally
		S.Free;
		Psd.Free;
	end;
{$ENDIF}
//.
end;
(*
/*

FUN Get_tga_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
    "     RESULT := Do_get_tga_from_stream(X_Source, X_B);" .
    
*/
*)

function Do_get_tga_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Tga}
{$IFDEF KOLGRAPHIC}
type PTgaGraphic = ^TTgaGraphic;
var Tga: PTgaGraphic;	
var S: PStream;
	B: PBitmapEx;
	B_Ref: Ref_obj;
	CB: C_Bitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Tga}
{$IFDEF KOLGRAPHIC}
	B := PBitmapEx(X_B);
	new(Tga, Create);
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		Tga.LoadFromStream(S);
		if (Tga.Width <> 0) and (Tga.Height > 0) then
		begin
			B.Bmp.Assign(Tga.Bitmap);
			
		    Free_And_Nil(B.AlphaChannel);
		    B_ref := B.Bitmap_object;
		    CB := C_Bitmap(B_ref.Obj);
		    CB.F_Width := Tga.Width;
		    CB.F_Height := Tga.Height;
			
			RESULT := TRUE;	
		end;
	finally
		S.Free;
		Tga.Free;
	end;
{$ENDIF}
//.
end;
(*
/*

FUN Get_tiff_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
    "     RESULT := Do_get_tif_from_stream(X_Source, X_B);" .
    
*/
*)

function Do_get_tif_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Tiff}
{$IFDEF KOLGRAPHIC}
type PTiffGraphic = ^TTiffGraphic;
var Tiff: PTiffGraphic;	
var S: PStream;
	B: PBitmapEx;
	B_Ref: Ref_obj;
	CB: C_Bitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Tiff}
{$IFDEF KOLGRAPHIC}
	B := PBitmapEx(X_B);
	new(Tiff, Create);
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		Tiff.LoadFromStream(S);
		if (Tiff.Width <> 0) and (Tiff.Height > 0) then
		begin
			B.Bmp.Assign(Tiff.Bitmap);
			
		    Free_And_Nil(B.AlphaChannel);
		    B_ref := B.Bitmap_object;
		    CB := C_Bitmap(B_ref.Obj);
		    CB.F_Width := Tiff.Width;
		    CB.F_Height := Tiff.Height;
			
			RESULT := TRUE;	
		end;
	finally
		S.Free;
		Tiff.Free;
	end;
{$ENDIF}
//.
end;

(*
/*

FUN Get_webp_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL : .
    
FUN Save_to_stream_webp(INT B|itmap_handle,
{Stream} S|tream_dest, INT Q|uality_compression, BOOL Lossless) ==> BOOL : .

FUN Get_xpm_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL : .
    
FUN Get_pcd_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
    "     RESULT := Do_get_pcd_from_stream(X_Source, X_B);" .
    
*/
*)

//{$DEFINE SUPPORT_PCD}

function Do_get_pcd_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Pcd}
{$IFDEF SUPPORT_PCD}
{$IFDEF KOLGRAPHIC}
type PPCDGraphic = ^TPCDGraphic;
var PCD: PPCDGraphic;	
var S: PStream;
	B: PBitmapEx;
	B_Ref: Ref_obj;
	CB: C_Bitmap;
{$ENDIF}
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Pcd}
{$IFDEF SUPPORT_PCD}
{$IFDEF KOLGRAPHIC}
	B := PBitmapEx(X_B);
	new(PCD, Create);
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		PCD.LoadFromStream(S);
		if (PCD.Width <> 0) and (PCD.Height > 0) then
		begin
			B.Bmp.Assign(PCD.Bitmap);
			
		    Free_And_Nil(B.AlphaChannel);
		    B_ref := B.Bitmap_object;
		    CB := C_Bitmap(B_ref.Obj);
		    CB.F_Width := PCD.Width;
		    CB.F_Height := PCD.Height;
			
			RESULT := TRUE;	
		end;
	finally
		S.Free;
		PCD.Free;
	end;
{$ENDIF}
{$ENDIF}
//.
end;

(*
/*
    
// Save Bitmap to file
//--------------------

FUN Save_to_stream_bmp(
INT B|itmap_handle, {Stream} S|tream_dest) ==> BOOL, NATIVE : @
"	RESULT := Do_Save_to_stream_bmp(X_B, X_S);" .

FUN Save_bitmap_native|_to_file(
	INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap(X_B, X_Path);" .
    
FUN Save_bitmap_bmp(
	INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap(X_B, X_Path);" .
    
FUN Save_to_stream_jpg(INT B|itmap_handle,
    {Stream} S|tream_dest, REAL Quality|_10_to_100) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_to_stream_jpg(X_B, X_S, Trunc(X_Quality));" .

FUN Save_bitmap_jpg(
	INT B|itmap_handle,
    STR Path|_image_file,
    REAL Quality|_10_to_100) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap_jpg(X_B, X_Path, Trunc(X_Quality));" .
    
FUN Save_to_stream_png(
	INT B|itmap_handle,
    {Stream} S|tream_dest,
    INT Q|ality_compression) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_to_stream_png(X_B, X_S);" .
    
FUN Save_bitmap_png(
	INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap_png(X_B, X_Path);" .
    
FUN Save_bitmap_gif(
	INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL : .
    
FUN Save_to_stream_gif(INT B|itmap_handle,
    {Stream} S|tream_dest) ==> BOOL : .

FUN Can_load_bitmap_fmt(
STR Format|_BMP_JPG_PNG_GIF) ==> BOOL, NATIVE : @
"RESULT := Do_Can_load_bitmap_fmt(X_Format);" .

*/
*)

function Do_Can_load_bitmap_fmt(
const X_Format: String): Boolean;
begin
		//RESULT = Format.Upper IN ["BMP", "JPG", "PNG", "GIF", "ICO", "CUR"] .
	RESULT := false
//?{Bmp}
	or (X_Format = 'BMP')
//.
//?{Jpeg}
	or (X_Format = 'JPG')
	or (X_Format = 'JPEG')
//.
//?{Png}
	or (X_Format = 'PNG')
//.
//?{Gif}
	or (X_Format = 'GIF')
//.
//?{Icon}
	or (X_Format = 'ICO') or (X_Format = 'CUR')
//.
//?{Pcx}
	or (X_Format = 'PCX')
//.
{$IFDEF KOLGRAPHIC}
//?{Pcd}
	{$IFDEF SUPPORT_PCD}
	or (X_Format = 'PCD')
	{$ENDIF}
//.
//?{Psd}
	or (X_Format = 'PSD')
	//or (X_Format = 'PDD')
//.
//?{Tga}
	or (X_Format = 'TGA')
//.
//?{Tiff}
	or (X_Format = 'TIFF')
	or (X_Format = 'TIF')
//.
{$ENDIF}
	;  
end; 
(*
/*

FUN Can_save_bitmap_fmt(
STR Format|_BMP_JPG_PNG_GIF) ==> BOOL, NATIVE : @
"RESULT := Do_Can_save_bitmap_fmt(X_Format);" .

*/
*)

function Do_Can_save_bitmap_fmt(
const X_Format: String): Boolean;
begin
	RESULT := FALSE
//?{Bmp}
		or (X_Format = 'BMP')
//.
//?{Jpeg}
		or (X_Format = 'JPG')
//.
//?{Png}
		or (X_Format = 'PNG')
//.
		;
end;
		
function Do_Save_to_stream_bmp(
X_B: Integer; X_S: Ref_obj): Boolean;
//?{Bmp}
var S: PNATIVE_Stream_on_C_Stream;
var Bmp: PBitmapEx;
//.
begin
	RESULT := FALSE;
//?{Bmp}
	Bmp := PBitmapEx(X_B);
    if Bmp = nil then Exit;
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		Bmp.Bmp.SaveToStream(S);
		RESULT := TRUE; 
	finally
		S.Free;
	end;
//.
end;

function Do_Save_bitmap(
	X_B: Integer; const X_Path: String): Boolean;
//?{Bmp}
var B: PBitmapEx;
//.
begin
//?{Bmp}
    B := PBitmapEx(X_B);
    TRY
    B.Bmp.SaveToFile(X_Path);
    Result := FileExists(X_Path);
    EXCEPT
    Result := FALSE;
    END;
//.
end;

	
function Do_Save_bitmap_jpg(
	X_B: Integer; const X_Path: String; X_Quality: Integer): Boolean;
//?{Jpeg}
var B: PBitmapEx;
	J: PJpeg;
//.
begin
	Result := FALSE;
//?{Jpeg}   
    B := PBitmapEx(X_B);
    TRY
    	J := NewJpeg;
    	try
    	J.Bitmap := B.Bmp;
    	J.SaveToFile(X_Path);
    	finally
    	J.Free;
    	end;
    Result := FileExists(X_Path);
    EXCEPT
    END;
//.
end;

function Do_Save_to_stream_jpg(
X_B: Integer; X_Stream: Ref_obj; X_Quality: Integer): Boolean;
//?{Jpeg}
var Bmp: PBitmapEx;
	J: PJpeg;
	S: PStream;
//.
begin
//?{Jpeg}
    S := Stream_from_C_Stream(C_Stream(X_Stream.Obj));
    Bmp := PBitmapEx(X_B);
    J := NewJpeg;
    try
    	J.Bitmap := Bmp.Bmp;
    	J.SaveToStream(S);
    	Result := TRUE;
    finally
    	J.Free;
    	S.Free;
    end;
//.
end;

function Do_Save_to_stream_png(
	X_B: Integer; X_Stream: Ref_obj): Boolean;
//?{Png}
var B: PBitmapEx;
	P: PPngObject;
var S: PStream;
//.
begin
//?{Png}
    Result := FALSE;
    S := Stream_from_C_Stream(C_Stream(X_Stream.Obj));
    try
    B := PBitmapEx(X_B);
    TRY
    	P := NewPngObject;
    	try
    	P.AssignHandle(B.Bmp.Handle, FALSE, 0);
    	P.SaveToStream(S);
    	finally
    	P.Free;
    	end;
    	Result := TRUE;
    EXCEPT
    END;
    finally
    	S.Free;
    end;
//.
end;

function Do_Save_bitmap_png(
	X_B: Integer; const X_Path: String): Boolean;
//?{Png}
var B: PBitmapEx;
	P: PPngObject;
//.
begin
    Result := FALSE;
//?{Png}
    B := PBitmapEx(X_B);
    TRY
    	P := NewPngObject;
    	try
    	P.AssignHandle(B.Bmp.Handle, FALSE, 0);
    	P.SaveToFile(X_Path);
    	finally
    	P.Free;
    	end;
    Result := FileExists(X_Path);
    EXCEPT
    END;
//.
end;

(*
/*

FUN Draw_bitmap_rotated_flipped(
	INT Target|_bitmap_handle, INT Source|_bitmap_handle,
	INT Angle|_0_90_180_270,
	BOOL Flip_w|idth, BOOL Flip_h|eight), NATIVE : @
	"Do_Draw_bitmap_rotated_flipped(X_Target, X_Source, X_Angle, "
	"	X_Flip_w, X_Flip_h);" .
	
*/
*)
procedure Do_Draw_bitmap_rotated_flipped(
X_Target, X_Source, X_Angle: Integer; Flip_w, Flip_h: Boolean);
var Dst, Src: PBitmapEx;
	q: TRGBQuad;
	y1, x1, i1, dx1, y2, x2, dy2, dx2, line_start2: Integer;
	from, to_: PRGBQuad;
begin
	Dst := PBitmapEx(X_Target);
	Src := PBitmapEx(X_Source);
    y2 := 0;
    x2 := 0;
    dx1 := 4;
    case Src.Bmp.PixelFormat of
    pf32bit: dx1 := 4;
    pf24bit: dx1 := 3;
    else Exit;
    end;
    case Dst.Bmp.PixelFormat of
    pf32bit: dx2 := 4;
    pf24bit: dx2 := 3;
    else Exit;
    end;
    line_start2 := 0;
    dy2 := 1;
    case X_Angle of
    0:  begin
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bmp.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bmp.Height-1;
				dy2 := -1;
			end;
    	end;
    90: begin
    		x2 := (Dst.Bmp.Width-1) * dx2;
    		dx2 := -dx2;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bmp.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bmp.Height-1-y2;
				dy2 := -dy2;
			end;
    	end;
    180: begin
    		line_start2 := Dst.Bmp.Height-1;
    		dy2 := -1;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bmp.Width-1-line_start2) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bmp.Height-1-y2;
				dy2 := -dy2;
			end;
    	 end;
    270: begin
    		line_start2 := Dst.Bmp.Height-1;
    		dy2 := -1;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bmp.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bmp.Height-1-y2;
				dy2 := -dy2;
			end;
    	 end;
    end;
    
    if (X_Angle = 0) or (X_Angle = 180) then
	    if dx2 = 4 then
		    for y1 := 0 to Src.Bmp.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
		    	to_ := PRGBQuad(Int64(Dst.Bmp.ScanLine[y2]) + line_start2);
		    	for x1 := 0 to Src.Bmp.Width-1 do
		    	begin
		    		q := from^;
		    		to_^ := q;
		    		from := PRGBQuad(Int64(from) + dx1);
		    		to_ := PRGBQuad(Int64(to_) + dx2);
		    	end;
		    	y2 := y2 + dy2;
		    end
	    else
		    for y1 := 0 to Src.Bmp.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
		    	to_ := PRGBQuad(Int64(Dst.Bmp.ScanLine[y2]) + line_start2);
		    	for x1 := 0 to Src.Bmp.Width-1 do
		    	begin
		    		q := from^;
	    			to_^.rgbRed := q.rgbRed;
	    			to_^.rgbGreen := q.rgbGreen;
	    			to_^.rgbBlue := q.rgbBlue;
		    		from := PRGBQuad(Int64(from) + dx1);
		    		to_ := PRGBQuad(Int64(to_) + dx2);
		    	end;
		    	y2 := y2 + dy2;
		    end
    else
	    if dx2 = 4 then
		    for y1 := 0 to Src.Bmp.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
		    	y2 := line_start2;
		    	for x1 := 0 to Src.Bmp.Width-1 do
		    	begin
		    		to_ := PRGBQuad(Int64(Dst.Bmp.ScanLine[y2]) + x2);
		    		q := from^;
		    		to_^ := q;
		    		from := PRGBQuad(Int64(from) + dx1);
		    		y2 := y2 + dy2;
		    	end;
		    	x2 := x2 + dx2;
		    end
	    else
		    for y1 := 0 to Src.Bmp.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
		    	y2 := line_start2;
		    	for x1 := 0 to Src.Bmp.Width-1 do
		    	begin
		    		to_ := PRGBQuad(Int64(Dst.Bmp.ScanLine[y2]) + x2);
		    		q := from^;
	    			to_^.rgbRed := q.rgbRed;
	    			to_^.rgbGreen := q.rgbGreen;
	    			to_^.rgbBlue := q.rgbBlue;
		    		from := PRGBQuad(Int64(from) + dx1);
		    		y2 := y2 + dy2;
		    	end;
		    	x2 := x2 + dx2;
		    end
    
end;

(*
/*

FUN Draw_bitmap_inverted(
	INT Target|_bitmap_handle, INT Source|_bitmap_handle), NATIVE : @
	"Do_Draw_bitmap_inverted(X_Target, X_Source);" .
	
*/
*)
procedure Do_Draw_bitmap_inverted(X_Target, X_Source: Integer);
var Dst, Src: PBitmapEx;
	q: TRGBQuad;
	y1, x1, i1, dx1, y2, x2, dy2, dx2, line_start2: Integer;
	from, to_: PRGBQuad;
begin
	Dst := PBitmapEx(X_Target);
	Src := PBitmapEx(X_Source);
    y2 := 0;
    x2 := 0;
    dx1 := 4;
    case Src.Bmp.PixelFormat of
    pf32bit: dx1 := 4;
    pf24bit: dx1 := 3;
    else Exit;
    end;
    case Dst.Bmp.PixelFormat of
    pf32bit: dx2 := 4;
    pf24bit: dx2 := 3;
    else Exit;
    end;
    if dx2 = 4 then
	    for y1 := 0 to Src.Bmp.Height-1 do
	    begin
	    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
	    	to_ := Dst.Bmp.ScanLine[y2];
	    	for x1 := 0 to Src.Bmp.Width-1 do
	    	begin
	    		q := from^;
	    		q.rgbRed := 255 - q.rgbRed;
	    		q.rgbGreen := 255 - q.rgbGreen;
	    		q.rgbBlue := 255 - q.rgbBlue;
	    		to_^ := q;
	    		from := PRGBQuad(Int64(from) + dx1);
	    		to_ := PRGBQuad(Int64(to_) + dx2);
	    	end;
	    	y2 := y2 + 1;
	    end
    else
	    for y1 := 0 to Src.Bmp.Height-1 do
	    begin
	    	from := PRGBQuad(Src.Bmp.ScanLine[y1]);
	    	to_ := Dst.Bmp.ScanLine[y2];
	    	for x1 := 0 to Src.Bmp.Width-1 do
	    	begin
	    		q := from^;
    			to_^.rgbRed := 255 - q.rgbRed;
    			to_^.rgbGreen := 255 - q.rgbGreen;
    			to_^.rgbBlue := 255 - q.rgbBlue;
	    		from := PRGBQuad(Int64(from) + dx1);
	    		to_ := PRGBQuad(Int64(to_) + dx2);
	    	end;
	    	y2 := y2 + 1;
	    end;
end;

(*
/*
// Destroy Bitmap object
//----------------------

FUN Destroy_bitmap(INT B|itmap_handle), NATIVE :
    "     Do_Destroy_bitmap(X_B);" .
*/
*)
procedure Do_Destroy_bitmap(X_B: Integer);
var B: PBitmapEx;
begin
    B := PBitmapEx(X_B);
    TRY
    B.Free;
    EXCEPT
    END;
end;

destructor TBitmapEx.Destroy;
begin
    Free_And_Nil(AlphaChannel);
    Free_And_Nil(Bmp);
    Free_And_Nil(Ico);
//?{Gif}
	Free_And_Nil(Gif);
//.
    if Assigned(LocalCopyPixels) then
        FreeMem(LocalCopyPixels);
end;

function UnitsToCoords(C: PCanvas; 
	C_C: C_Canvas; Value_units: Double): Integer;
var r: Integer;
begin
	r := GetDeviceCaps(C.Handle, LOGPIXELSX);
	
	// writeln(Int2Str(r));
	
    CASE C_C.F_Units OF
    0: Result := Round(Value_units / 72.0 * r);
    1: Result := Trunc(Value_units);
    2: Result := Round(Value_units * r);
    3: Result := Round(Value_units / 2.54 * r);
    else Result := 0;
    END;
end;

procedure select_clip_rect(Canv: PCanvas; C_C: C_Canvas);
var CR: HRGN;
	C_Units, x, y: Integer;
	M: TXForm;
	clip_w, clip_h, clip_x, clip_y: Double;
begin
    clip_w := {$IFDEF STRUCTUREASCLASS}
	  		  PSt_rect__C_Geometry(C_C.F_Clip.Obj).f_Width
			  {$ELSE} 
		      C_C.F_Clip.f_Width
		   	  {$ENDIF};
    clip_h := {$IFDEF STRUCTUREASCLASS}
	  		  PSt_rect__C_Geometry(C_C.F_Clip.Obj).f_Height
			  {$ELSE} 
		      C_C.F_Clip.f_Height
		   	  {$ENDIF};
		   	  
    clip_x := {$IFDEF STRUCTUREASCLASS}
			  PSt_point__C_Geometry(
				  PSt_rect__C_Geometry(C_C.F_Clip.Obj).f_Loc.Obj
			  ).f_X
			  {$ELSE}
			  C_C.F_Clip.f_Loc.f_X
			  {$ENDIF};
	clip_y := {$IFDEF STRUCTUREASCLASS}
			  PSt_point__C_Geometry(
				  PSt_rect__C_Geometry(C_C.F_Clip.Obj).f_Loc.Obj
			  ).f_Y
			  {$ELSE}
			  C_C.F_Clip.f_Loc.f_Y
			  {$ENDIF};

	if (clip_w = 0) and (clip_h = 0) then 
	begin
		SelectClipRgn(Canv.Handle, 0); 
		Exit;
	end;
	C_Units := C_C.F_Units;
	x := UnitsToCoords(Canv, C_C, clip_x);
	y := UnitsToCoords(Canv, C_C, clip_y);
	
	
	
	GetWorldTransform(Canv.Handle, M);
	if (M.eM11 <> 1.0) or (M.eM12 <> 0.0) or (M.eM21 <> 0.0) or (M.eM22 <> 1.0)
		then Exit;
		
		
	CR := CreateRectRgn(
		x,
		y,
		x + UnitsToCoords(Canv, C_C, clip_w),
		y + UnitsToCoords(Canv, C_C, clip_h));
		
		
	OffsetRgn(CR, Round(M.eDx), Round(M.eDy));
	
	SelectClipRgn(Canv.Handle, CR);
	DeleteObject(CR);
end;

function Get_canvas_1(
	X_Bmp: Ref_obj; var C: C_Canvas; var A: PCanvas): PCanvas;
var B: PBitmapEx;
    CRef: Ref_obj;
begin
	C := C_Canvas(X_Bmp.Obj);
    B := PBitmapEx(C.F_Handle);
    A := nil;
//?{Printer}    
	if B.Printer <> nil then
    	Result := B.Printer.Canvas
    else
//.
	Result := nil;
	
	if B = nil then Exit;
	if Result = nil then 
	   Result := B.Bmp.Canvas;
    	
    if  (C <> nil) and (Result <> nil) then
    begin
        Result.Pen.Color := C.F_Foreground  and $FFFFFF;
        Result.Pen.PenWidth := Trunc(C.F_Pen_width);
        Result.Pen.PenStyle := psSolid;
        if (C.F_Pen_style = 1) then
           Result.Pen.PenStyle := psClear;
        Result.Brush.Color := C.F_Background and $FFFFFF;
        Result.Brush.BrushStyle := TBrushStyle(C.F_Brush);
//?{Printer}
		if B.Printer = nil then 
//.
			select_clip_rect(Result, C);
    end;

    if (C <> nil) and (C.F_Alpha) and (B.Bmp.PixelFormat = pf32bit) then
    begin
        if (B.AlphaChannel = nil) then
        begin
            B.AlphaChannel := NewDibBitmap(B.Bmp.Width, B.Bmp.Height, pf32bit);
        end;
        A := B.AlphaChannel.Canvas;
        A.Brush.Color :=
        	{$IFDEF INT_32} C.F_Background shr 24
        	{$ELSE} ((C.F_Background shr 24) and $FF) or
        			((((C.F_Background shr 16) shr 16) shl 16) shl 16)
        	{$ENDIF};
        A.Brush.BrushStyle := Result.Brush.BrushStyle;
        A.Pen.Color := 
        	{$IFDEF INT_32} C.F_Foreground shr 24
        	{$ELSE} ((C.F_Foreground shr 24) and $FF) or
        			((((C.F_Foreground shr 16) shr 16) shl 16) shl 16)
        	{$ENDIF};
        A.Pen.PenStyle := Result.Pen.PenStyle;
        A.Pen.PenWidth := Result.Pen.PenWidth;
    end
    else if B.AlphaChannel <> nil then
        Free_And_Nil(B.AlphaChannel);
end;

var Bitmap_1x1: KOL.PBitmap;

function Get_canvas(
	X_Bmp: Ref_obj; var C: C_Canvas; var A: PCanvas): PCanvas;
begin
    Result := Get_canvas_1(X_Bmp, C, A);
    if Result <> nil then Exit;
    if Bitmap_1x1=nil then Bitmap_1x1 := NewBitmap(1, 1);
    Result := Bitmap_1x1.Canvas;
end;	


function UnitsFromCoords(C: PCanvas;  
	C_C: C_Canvas; Value_pixels: Double): Double;
var r: Integer;
begin
	r := GetDeviceCaps(C.Handle, LOGPIXELSX);
    CASE C_C.F_Units OF
    0: Result := Value_pixels * 72.0 / r;
    1: Result := Value_pixels;
    2: Result := Value_pixels / r;
    3: Result := Value_pixels * 2.54 / r;
    else Result := 0;
    END;
end;

(*
/*

FUN Canvas_copy_rect(
{Canvas} Dest|ination_canvas, {rect} R_dest|ination_rectangle,
{Canvas} Source|_canvas, {rect} R_source|_rectangle)
	:
	CASE Dest == NONE || Source == NONE ? ==> ;
	
	do_canvas_copy_rect(Dest, R_dest.Loc.X, R_dest.Loc.Y,
		R_dest.Width, R_dest.Height,
		Source, R_source.Loc.X, R_source.Loc.Y,
		R_source.Width, R_source.Height)
	.
FUN do_canvas_copy_rect(
{Canvas} Dest|ination_canvas, REAL X_dest|ination, REAL Y_dest|ination,
REAL W_dest|ination, REAL H_dest|ination,
{Canvas} Source|_canvas, REAL X_source, REAL Y_source,
REAL W_source, REAL H_source) , NATIVE :
	NATIVE @
	"var Cdest, Adest, C_src, Asource: PCanvas;"
	"var CCdest, CCsrc: C_Canvas;"
	"var U1, U2: Integer;"
	"Cdest := Get_canvas(X_Dest, CCdest, Adest);"
	"C_src := Get_canvas(X_Source, CCsrc, Asource);"
	"Cdest.CopyRect(MakeRect("
	"		Trunc(X_X_dest),"
	"		Trunc(X_Y_dest),"
	"		Trunc(X_X_dest + X_W_dest),"
	"		Trunc(X_Y_dest + X_H_dest) ),"
	"	C_src, MakeRect("
	"		Trunc(X_X_source),"
	"		Trunc(X_Y_source),"
	"		Trunc(X_X_source + X_W_source),"
	"		Trunc(X_Y_source + X_H_source) )"
	"		);" .



FUN Draw_bitmap_on_canvas(
    INT B|itmap_handle,
    {Canvas} D|est_canvas_handle,
    REAL X|_destination_in_pixels,
    REAL Y|_destination_in_pixels,
    REAL W|idth_pixels,
    REAL H|eight_ixels), NATIVE :
    CASE B == 0 ? ==> ;
    NATIVE @
    "   Do_draw_bitmap(X_B, X_D, X_X, X_Y, X_W, X_H);" .
*/
*)

procedure Do_draw_bitmap(
	X_B: Integer; X_D: Ref_obj; X, Y, W, H: Double);
var B: PBitmapEx;
	//D: PBitmapEx;
    C_C: C_Canvas;
    C, A: PCanvas;
    Xform: TXForm;
    restore_X: Boolean;
begin
    B := PBitmapEx(X_B);
    //D := PBitmapEx(C_Bitmap(X_D.Obj).F_Handle);
    
    C := Get_canvas(X_D, C_C, A);
    if C = nil then Exit;
    
	restore_X := FALSE;
    //if  GetGraphicsMode(C.Handle) <> GM_COMPATIBLE then
    //begin
    //    restore_X := TRUE;
    //    GetWorldTransform(C.Handle, Xform);
    //    ModifyWorldTransform(C.Handle, Xform, MWT_IDENTITY);
    //    SetGraphicsMode(C.Handle, GM_COMPATIBLE);
    //end;
    
    if (B.Bmp.Width = W) and (B.Bmp.Height = H)
//?{Gif}
    	and (B.Gif = nil)
//. 
    then
        B.Bmp.Draw(C.Handle, Round(X), Round(Y))
    else
    begin
    	{$IFnDEF SMALLEST_CODE}
    	if C_C.F_Quality <= 1 then
	    begin
	    	SetStretchBltMode(C.Handle, HALFTONE);
	    	{$IFnDEF SMALLER_CODE}
	    	SetBrushOrgEx(C.Handle, 0, 0, nil);
	    	{$ENDIF}
	    end;
    	{$ENDIF}
    	if B.Ico <> nil then
    	   B.Ico.StretchDraw(C.Handle, MakeRect(
                    Round(X),
                    Round(Y),
                    Round(X + W), 
                    Round(Y + H)))
//?{Gif}
    	else if B.Gif <> nil then
    		B.Gif.StretchDraw(C.Handle, MakeRect(
                    Round(X),
                    Round(Y),
                    Round(X + W), 
                    Round(Y + H)))
//.
    	else B.Bmp.StretchDraw(C.Handle, MakeRect(
                    Round(X),
                    Round(Y),
                    Round(X + W), 
                    Round(Y + H)));
    end;
    
	if restore_X then
	begin
		SetGraphicsMode(C.Handle, GM_ADVANCED);
		ModifyWorldTransform(C.Handle, XForm, MWT_LEFTMULTIPLY);
	end;
end;

(*
/*

FUN Capture_screen_rectangle_to_bitmap(
	INT B|itmap_handle, REAL X|_coordinate, REAL Y|_coordinate), NATIVE : @
	"var DC: HDC;"
	"var B: PBitmapEx;"
    "    B := PBitmapEx(X_B);"
    "	 DC := GetDC(0);"
    "	 try"
    "	   BitBlt(B.Bmp.Canvas.Handle, 0, 0, B.Bmp.Width, B.Bmp.Height,"
    "			DC, AL4_Form.Points(X_X), AL4_Form.Points(X_Y), SRCCOPY);"
    "	 finally"
    "	   ReleaseDC(0, DC);"
    "	 end;" .
    
    
FUN Screen_desktop|_pixels ==> {rect}:
	INT coord|inates_desktop[] << 0 << 0 << 0 << 0
	get_Screen_desktop(coord[0 TO *])
	RESULT = {rect}(Loc=Pt(coord[0], coord[1]), Width=coord[2], Height=coord[3])
	.
FUN get_Screen_desktop(INT coord|inates_desktp[*]), NATIVE : @
"var DR: TRect;"
"	DR := GetDesktopRect;"
"	X_coord.SetIntegers(0, DR.Left);"
"	X_coord.SetIntegers(1, DR.Top);"
"	X_coord.SetIntegers(2, DR.Right - DR.Left);"
"	X_coord.SetIntegers(3, DR.Bottom - DR.Top);" .
	

FUN Get_bitmap_from_clipboard(
	INT B|itmap_handle) ==> BOOL, NATIVE :
@	"RESULT := Do_get_bitmap_from_clipboard(X_B);" .

FUN Put_bitmap_to_clipboard(
	INT B|itmap_handle) ==> BOOL, NATIVE :
@	"RESULT := Do_put_bitmap_to_clipboard(X_B);" .

*/
*)

function Do_get_bitmap_from_clipboard(X_B: Integer): Boolean;
var B: PBitmapEx;
	CB: C_Bitmap;
begin
  Result := FALSE;
  B := PBitmapEx(X_B);
  B.Bmp := NewBitmap(0, 0);
  B.Bmp.PasteFromClipboard;
  CB := C_Bitmap(B.Bitmap_object.Obj);
  CB.F_Width := B.Bmp.Width;
  CB.F_Height := B.Bmp.Height;
  Result := not B.Bmp.Empty;
  //if Result then B.Bmp.SaveToFile('test_from_clip.bmp');
end;

function Do_put_bitmap_to_clipboard(X_B: Integer): Boolean;
var B: PBitmapEx;
	CB: C_Bitmap;
begin
  Result := FALSE;
  B := PBitmapEx(X_B);
  RESULT := B.Bmp.CopyToClipboard;
  //if Result then B.Bmp.SaveToFile('test_from_clip.bmp');
end;

//----------------------------------------------- {Icon}


// Create Icon object, return descriptor.
//-------------------------------------------
(*
/*



FUN Create_icon(
	{Icon} Icon|_object) ==> INT, NATIVE :
    "    RESULT := Do_Create_bitmap(X_Icon, 32);" .
*/
*)



// Load icon from stream
//----------------------
(*
/*

FUN Load_icon_from_stream(
	INT B|itmap_handle, {Stream} In|_stream),
    NATIVE :
    "     Do_load_icon(X_B, X_In);" .
    
FUN Load_icon_from_file(
	INT B|itmap_handle, STR Path|_icon)
	:
	{File_stream} fs|tream_temp = Read_file_stream(Path)
	Load_icon_from_stream(B, fs) .	
*/
*)

procedure Do_load_icon(
	X_B: Integer; X_In: Ref_obj);
var B: PBitmapEx;
    CS: C_Stream;
    S: PStream;
    C_B: C_Bitmap;
begin
    B := PBitmapEx(X_B);
    CS := C_Stream(X_In.Obj);
    S := NATIVE_Stream_on_C_Stream.Stream_from_C_Stream(CS);
    try
        if B.Ico = nil then
            B.Ico := NewIcon;
        try
            B.Ico.LoadFromStream(S);
        	C_B := C_Bitmap(B.Bitmap_object.Obj);
        	C_B.F_Width := B.Ico.Size;
        	C_B.F_Height := B.Ico.Size;
        except B.Ico.Free;
               B.Ico := nil;
        end;
    finally
        S.Free;
    end;
    if  (B.Ico <> nil) and B.Ico.Empty then
    begin
        B.Ico.Free;
        B.Ico := nil;
    end;
end;



//------------------------------------------------ {Bitmap_direct}

(*
/*
// Lock bitmap pixels
//----------------------

FUN LockBitmapPixels(
	{Bitmap_direct} B|itmap_handle, INT Y|_position,
    INT H|eight_rectangle, BOOL Read|_source), NATIVE :
    "   Do_LockBitmapPixels(X_B, X_Y, X_H, X_Read);" .
*/
*)

procedure Do_LockBitmapPixels(
	X_B: Ref_obj; X_Y, X_H: Integer; X_Read: Boolean);
//? {Bitmap_direct}
var B: PBitmapEx;
    bits_per_pixel: Integer;
    D: C_Bitmap_direct;
    Pixels: PByte_Array;
    s0, s1: Int64;
    y, x, row_start_to: Integer;
    curr_scan: PByte_Array;
//.
begin
//? {Bitmap_direct}
    B := PBitmapEx(C_Bitmap_direct(X_B.Obj).F_Handle);
    case B.Bmp.PixelFormat of
    pf1bit:     bits_per_pixel := 1;
    pf4bit:     bits_per_pixel := 4;
    pf8bit:     bits_per_pixel := 8;
    pf15bit, pf16bit: bits_per_pixel := 16;
    pf24bit:    bits_per_pixel := 24;
    pf32bit:    bits_per_pixel := 32;
    else Exit;
    end;
    D := C_Bitmap_direct(B.Bitmap_object.Obj);
    D.F_Row_width := bits_per_pixel * B.Bmp.Width div 8;
    Pixels := B.Bmp.ScanLine[X_Y];
    if (X_H > 1) or (B.AlphaChannel <> nil) then
    begin
        s0 := Int64(B.Bmp.ScanLine[0]);
        s1 := s0;
        if B.Bmp.Height > 1 then
            s1 := Int64(B.Bmp.ScanLine[1]);
        if (s0 > s1) or (s1 - s0 <> D.F_Row_width) or (B.AlphaChannel <> nil) then
        begin
            if (s0 > s1) then
                Pixels := B.Bmp.ScanLine[X_Y + X_H -1];
            if Assigned(B.LocalCopyPixels) and 
            	(B.LocalSize = D.F_Row_width * X_H) then
            else 
            begin
            	 if Assigned(B.LocalCopyPixels) then
            	 	FreeMem(B.LocalCopyPixels);
            	 B.LocalSize := D.F_Row_width * X_H;
            	 GetMem(B.LocalCopyPixels, D.F_Row_width * X_H);
            	 D.F_Pixels.Free;
            	 D.F_Pixels := New_FixAByte_Array(nil, 
            	 	B.LocalCopyPixels, B.LocalSize, 0, B.LocalSize-1 );
            end;
            if Assigned(B.LocalCopyPixels) then
            begin
                Pixels := B.LocalCopyPixels;
                if X_Read then
                for y := X_Y to X_Y + X_H - 1 do
                    Move(B.Bmp.ScanLine[y]^, Pixels[y * D.F_Row_width], 
                    D.F_Row_width);
                if (B.AlphaChannel <> nil) and (X_Read) then
                begin
                    for y := X_Y to X_Y + X_H - 1 do
                    begin
                        row_start_to := 3 + y * D.F_Row_width;
                        curr_scan := B.AlphaChannel.ScanLine[y];
                        for x := 0 to B.Bmp.Width - 1 do
                            Pixels[row_start_to + x * 4] := curr_scan[2 + x * 4]; 
                    end;
                end;
            end;
        end;
    end;
    D.F_Pixels.Free;
	D.F_Pixels := New_FixAByte_Array(nil,
		@Pixels[0], D.F_Row_width * X_H, 
		0, D.F_Row_width * X_H - 1);
    B.locked_Y := X_Y;
    B.locked_H := X_H;
//.
end;

(*
/*
// Unlock bitmap pixels
//----------------------

FUN UnlockBitmapPixels(
	{Bitmap_direct} B|itmap_handle, BOOL Write|_back), 
    NATIVE : @
    "   Do_UnlockBitmapPixels(X_B, X_Write);" .
*/
*)

procedure Do_UnlockBitmapPixels(
	X_B: Ref_obj; X_Write: Boolean);
//? {Bitmap_direct}
var B: PBitmapEx;
    D: C_Bitmap_direct;
    Pixels: PByte_Array;
    s0, s1: Int64;
    y, x, row_start_from: Integer;
    curr_scan: PByte_Array;
//.
begin
//? {Bitmap_direct}
    B := PBitmapEx(C_Bitmap_direct(X_B.Obj).F_Handle);
    D := C_Bitmap_direct(B.Bitmap_object.Obj);
    
    if Assigned(B.LocalCopyPixels) and X_Write then
    begin
        s0 := Int64(B.Bmp.ScanLine[0]);
        s1 := s0;
        if B.Bmp.Height > 1 then
            s1 := Int64(B.Bmp.ScanLine[1]);
        if (s0 > s1) or (s1 - s0 <> D.F_Row_width) or (B.AlphaChannel <> nil) then
        begin
            Pixels := B.LocalCopyPixels;
            for y := B.locked_Y to B.locked_Y + B.locked_H - 1 do
                Move(Pixels[y * D.F_Row_width], B.Bmp.ScanLine[y]^, D.F_Row_width);
            if B.AlphaChannel <> nil then
            begin
                for y := B.locked_Y to B.locked_Y + B.locked_H - 1 do
                begin
                    row_start_from := 3 + y * D.F_Row_width;
                    curr_scan := B.AlphaChannel.ScanLine[y];
                    for x := 0 to B.Bmp.Width - 1 do
                        curr_scan[2 + x * 4] := Pixels[row_start_from + x * 4];
                end;
            end;
        end;
    end;
//.
end;

//------------------------------------------------------------------ C A N V A S

(*
/*

FUN Need_erase_paintbox_1|st_time_buffer_created ==> BOOL : = TRUE 
.


FUN Get_mask_RGB({Bitmap_direct}.{rgb} C|omponent) ==> INT :
	RESULT = (0xFF).ShiftL(Get_shift_RGB(C)) .

FUN Get_shift_RGB(
{Bitmap_direct}.{rgb} C|omponent) ==> INT
	:
	CASE C ?
	['R']: RESULT = 16
	['G']: RESULT = 8
	['B']: RESULT = 0
	['A']: RESULT = 24 ; .

// Create TCanvas object, return descriptor.
//-------------------------------------------

FUN Create_bitmap_canvas({Canvas} C|anvas_object,
    {Bitmap} B|itmap_object) ==> INT, NATIVE :
    "    RESULT := Do_Create_bitmap_canvas(X_C, X_B);" .
    
FUN Direct_draw_canvas(INT H|andle_control_dummy) ==> BOOL :
    RESULT = FALSE .

FUN Create_control_canvas(
    {Canvas} Canv|as_object_dummy, 
    {Control} Cont|rol_object_dummy) ==> INT RESULT|Handle
    :
    RESULT = 0 .
    
FUN Create_printer_canvas(
	{Canvas} C|anvas_object,
	INT Printer_handle) ==> INT, NATIVE :
@	"	RESULT := Do_create_printer_canvas(X_C, X_Printer_handle);" .
*/
*)

function Do_Create_bitmap_canvas(
	X_C: Ref_obj; X_B: Ref_obj): Integer;
//?{Canvas}
var Bmp: PBitmapEx;
//.
begin
//?{Canvas}
    Bmp := PBitmapEx(C_Bitmap(X_B.Obj).F_Handle);
    Bmp.CanvasObject := Integer(X_C);
    Result := Integer(Bmp);
//.
end;

function Do_Create_printer_canvas(
	X_C: Ref_obj; X_Printer_handle: Integer): Integer;
//?{Canvas}
//?{Printer}
var Bmp: PBitmapEx;
	P: PMHPrinter;
//.
//.
begin
//?{Canvas}
//?{Printer}
    new(Bmp, Create);
    P := PMHPrinter(X_Printer_handle);
    Bmp.Printer := P;
    Bmp.CanvasObject := Integer(X_C);
    Result := Integer(Bmp);
//.
//.
end;	

(*
/*
// Destroy TCanvas object (actually not needed, still it is owned by TBitmapEx)
//-----------------------------------------------------------------------------

FUN Destroy_canvas|_dummy(
	INT C|anvas_handle_dummy) : .
*/
*)

(*
/*
// Erase rect
//-----------

FUN Erase_rect(
	{Canvas} C|anvas_object, {rect} R|ectangle)
	:
	do_Erase_rect(C, R.Loc.X, R.Loc.Y, R.Width, R.Height) .
FUN do_Erase_rect({Canvas} C|anvas_object, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_of_rect, REAL H|eight_of_rect), NATIVE :
@  "var	C_C: C_Canvas;"
   "var C, A: PCanvas;"
   "var	R_erase: TRect;"
   "	C := Get_canvas(X_C, C_C, A);"  
   "	R_erase := MakeRect("
   "		UnitsToCoords(C, C_C, X_X), UnitsToCoords(C, C_C, X_Y),"
   "		UnitsToCoords(C, C_C, X_X+X_W),"
   "		UnitsToCoords(C, C_C, X_Y+X_H));"
   "	C.FillRect(R_erase);"
   "	if A <> nil then"
   "		A.FillRect(R_erase);"
   .
   
// Paint rect
//-----------

FUN Paint_rect(
	{Canvas} C|anvas_object, {rect} R|ectangle)
	:
	do_Paint_rect(C, R.Loc.X, R.Loc.Y, R.Width, R.Height) .
FUN do_Paint_rect({Canvas} C|anvas_object, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_of_rect, REAL H|eight_of_rect), NATIVE : @
"var C, A: PCanvas;"
"var C_C: C_Canvas;"
"var R_fill: TRect;"
   "C := Get_canvas(X_C, C_C, A);"
   "R_fill := MakeRect("
   "	UnitsToCoords(C, C_C, X_X),"
   "	UnitsToCoords(C, C_C, X_Y),"
   "	UnitsToCoords(C, C_C, X_X+X_W),"
   "	UnitsToCoords(C, C_C, X_Y+X_H));"
   "C.FillRect(R_fill);"
   "C.Rectangle(R_fill.Left, R_fill.Top, R_fill.Right-1, R_fill.Bottom-1);"
   "if A <> nil then"
   "begin"
       "A.Rectangle(R_fill.Left, R_fill.Top, R_fill.Right-1, R_fill.Bottom-1);"
   "end;"
   .
   
// Paint line
//-----------

FUN Paint_line(
	{Canvas} C|anvas_object, {Geometry}.{point} P1|_point, {point} P2|_point)
	:
	do_Paint_line(C, P1.X, P1.Y, P2.X, P2.Y) .
FUN do_Paint_line({Canvas} C|anvas_object,
REAL P1x|_coordinate, REAL P1y|_coordinate,
REAL P2x|_coordinate, REAL P2y|_coordinate), NATIVE : @
"var C, A: PCanvas;"
"var C_C: C_Canvas;"
   "C := Get_canvas(X_C, C_C, A);"
   "C.MoveTo(UnitsToCoords(C, C_C, X_P1x), UnitsToCoords(C, C_C, X_P1y));"
   "C.LineTo(UnitsToCoords(C, C_C, X_P2x), UnitsToCoords(C, C_C, X_P2y));"
   "if A <> nil then"
   "begin"
   "	A.MoveTo(UnitsToCoords(C, C_C, X_P1x), UnitsToCoords(C, C_C, X_P1y));"
   "	A.LineTo(UnitsToCoords(C, C_C, X_P2x), UnitsToCoords(C, C_C, X_P2y));"
   "end;"
   .
   
// Paint ellipse
//--------------

FUN Paint_ellipse(
	{Canvas} C|anvas_object, {rect} R|ectangle_ellipse)
	:
	do_Paint_ellipse(C, R.Loc.X, R.Loc.Y, R.Width, R.Height) .
FUN do_Paint_ellipse({Canvas} C|anvas_object, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_of_rect, REAL H|eight_of_rect), NATIVE : @
"var C, A: PCanvas;"
"var C_C: C_Canvas;"
"var R_ell: TRect;"
   "C := Get_canvas(X_C, C_C, A);"
   "R_ell := MakeRect(UnitsToCoords(C, C_C, X_X),"
   "	UnitsToCoords(C, C_C, X_Y),"
   "	UnitsToCoords(C, C_C, X_X + X_W),"
   "	UnitsToCoords(C, C_C, X_Y + X_H));"
   "C.Ellipse(R_ell.Left, R_ell.Top, R_ell.Right, R_ell.Bottom);"
   "if A <> nil then"
   "	A.Ellipse(R_ell.Left, R_ell.Top, R_ell.Right+1, R_ell.Bottom+1);"
   .
   
// Paint arc/pie
//--------------

FUN Paint_arc(
	{Canvas} C|anvas_object, {Canvas}.{arc} A|rc_information)
	:
	do_Paint_arc(C, A.Rect.Loc.X, A.Rect.Loc.Y, A.Rect.Width, A.Rect.Height,
	A.Angles.X, A.Angles.Y, A.Sided)
	.
FUN do_Paint_arc({Canvas} C|anvas_object, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_of_rect, REAL H|eight_of_rect, REAL Fr|om_angle, REAL To|_angle,
BOOL Sided|_arc), NATIVE : @
"var C, A: PCanvas;"
"var C_C: C_Canvas;"
"var R: TRect;"
"var P1, P2: TPoint;"
   "C := Get_canvas(X_C, C_C, A);"
   "R := MakeRect(UnitsToCoords(C, C_C, X_X),"
   "	UnitsToCoords(C, C_C, X_Y),"
   "	UnitsToCoords(C, C_C, X_X + X_W),"
   "	UnitsToCoords(C, C_C, X_Y + X_H));"
   "P1 := MakePoint( (R.Left + R.Right) div 2 "
   "				 + Trunc(100 * Cos(X_Fr * PI / 180.0)),"
   "				 (R.Top + R.Bottom) div 2 "
   "				 + Trunc(100 * Sin(X_fr * PI / 180.0)));"
   "P2 := MakePoint( (R.Left + R.Right) div 2 "
   "				 + Trunc(100 * Cos(X_To * PI / 180.0)),"
   "				 (R.Top + R.Bottom) div 2 "
   "				 + Trunc(100 * Sin(X_To * PI / 180.0)));"
   "if  X_Sided then"
   "	C.Pie(R.Left, R.Top, R.Right, R.Bottom, P2.X, P2.Y, P1.X, P1.Y)"
   "else C.Arc(R.Left, R.Top, R.Right, R.Bottom, P2.X, P2.Y, P1.X, P1.Y);"
   "if A <> nil then"
   "begin"
   "	if X_Sided then"
   "		A.Pie(R.Left, R.Top, R.Right, R.Bottom, P2.X, P2.Y, P1.X, P1.Y)"
   "	else A.Arc(R.Left, R.Top, R.Right, R.Bottom, P2.X, P2.Y, P1.X, P1.Y);"
   "end;"
   .
   
// Paint text
//--------------

FUN Paint_text(
	{Canvas} C|anvas_object, {point} P|oint_top_left, STR Text|_draw)
	:
	do_Paint_text(C, P.X, P.Y, Text) .
FUN do_Paint_text({Canvas} C|anvas_object, REAL X|_position, REAL Y|_position,
STR Text|_to_draw), NATIVE :
    "     Do_Paint_text(X_C, X_X, X_Y, X_Text);" .
*/
*)

procedure Do_Paint_text(
	X_C: Ref_obj; X_X, X_Y: Double; const Text: String);
var C, A: PCanvas;
    C_C: C_Canvas;
//?{Font}
    C_F: C_Font;
    Font: PGraphicTool;
//.
    PP: TPoint;
begin
    C := Get_canvas(X_C, C_C, A);
    PP := MakePoint(UnitsToCoords(C, C_C, X_X), UnitsToCoords(C, C_C, X_Y));
//?{Font}
    C_F := C_Font(C_C.F_Font.Obj);
	Font := NewFont;
	
    if C_F.F_Face <> '' then Font.FontName := C_F.F_Face
    					else Font.FontName := 'Arial';
	Font.FontHeight :=  -Trunc( 
    	C_F.F_Size * GetDeviceCaps(C.Handle, LOGPIXELSY) / 72.0 );
    Font.FontStyle := Get_font_style(C_F); 
	Font.Color := C.Pen.Color; 
 	C.Font.Assign(Font);
 	Font.Free;   
//.
	
    C.Brush.BrushStyle := bsClear;
    C.TextOut(PP.X, PP.Y, Text);
    if A <> nil then
    begin
        A.Font.FontHeight := C.Font.FontHeight; //Trunc(Points(C_F.F_Size));
//?{Font}
        A.Font.FontName := C_F.F_Face;
        A.Font.FontStyle := Get_font_style(C_F);
//.
        A.Font.Color :=
        	{$IFDEF INT_32} C_C.F_Foreground shr 24
        	{$ELSE} ((C_C.F_Foreground shr 24) and $FF) or
        			((((C_C.F_Foreground shr 16) shr 16) shl 16) shl 16)
        	{$ENDIF};
        A.Brush.BrushStyle := bsClear;
        A.TextOut(PP.X, PP.Y, Text);
    end;
end;
 
(*
/*
// Paint polygon/polyline
//-----------------------

FUN Paint_poly(
	{Canvas} C|anvas_object,
    {point} P|oints_array[*], BOOL Closed|_polygon)
    :
    REAL coord|inates[]
    FOR i IN [0 TO P[].Count-1] : coord[] << P[i].X << P[i].Y ;
	do_Paint_poly(C, coord[], Closed) .
FUN do_Paint_poly({Canvas} C|anvas_object, REAL Coord|inates[],
BOOL Closed|_polygon), NATIVE : @
"var C, A: PCanvas;"
"var C_C: C_Canvas;"
"var Pts: array of TPoint;"
"var i: Integer;"
   "if  X_Coord.Count = 0 then Exit;"
   "C := Get_canvas(X_C, C_C, A);"
   "SetLength(Pts, X_Coord.Count div 2);"
   "for i := 0 to X_Coord.Count-1 do"
   "begin"
   "	if i mod 2 = 1 then continue;"
   "	Pts[i div 2] := MakePoint("
   "		UnitsToCoords(C, C_C, X_Coord.GetReals(i)),"
   "		UnitsToCoords(C, C_C, X_Coord.GetReals(i+1)));"
   "end;"
   "if  Length(Pts) = 1 then"
   "	C.Pixels[Pts[0].X, Pts[0].Y] := C.Pen.Color"
   "else"
   "if  X_Closed then"
   "	C.Polygon(Pts)"
   "else C.Polyline(Pts);"
   "if A <> nil then"
   "begin"
   "	if  Length(Pts) = 1 then"
   "		A.Pixels[Pts[0].X, Pts[0].Y] := A.Pen.Color"
   "	else"
   "	if  X_Closed then"
   "		A.Polygon(Pts)"
   "	else A.Polyline(Pts);"
   "end;"
   .

// Reset transforms
//-----------------

FUN Canvas_transform_reset(
	{Canvas} C|anvas_object), NATIVE :
    "     Do_transform_reset(X_C);" .
*/
*)

procedure Do_transform_reset(
	X_C: Ref_obj);
var C, A: PCanvas;
    C_C: C_Canvas;
    X: TXForm;
begin
    C := Get_canvas(X_C, C_C, A);
    X.eM11 := 1;    X.eM12 := 0;
    X.eM21 := 0;    X.eM22 := 1;
    X.eDx := 0;     X.eDy := 0;
    ModifyWorldTransform(C.Handle, X, MWT_IDENTITY);
    SetGraphicsMode(C.Handle, GM_COMPATIBLE);
    if A <> nil then
    begin
        ModifyWorldTransform(A.Handle, X, MWT_IDENTITY);
        SetGraphicsMode(A.Handle, GM_COMPATIBLE);
    end;
end;

(*
/*
// Offset transformation
//----------------------

FUN Canvas_transform_offset(
	{Canvas} C|anvas_object, REAL Dx|_delta, REAL Dy|_delta),
    NATIVE :
    "     Do_transform_offset(X_C, X_Dx, X_Dy);" .
*/
*)
const MULT_DIRECTION = MWT_LEFTMULTIPLY;

procedure Do_transform_offset(
	X_C: Ref_obj; Dx, Dy: Double);
var C, A: PCanvas;
    C_C: C_Canvas;
    X: TXForm;
begin
    C := Get_canvas(X_C, C_C, A);
    
    X.eM11 := 1;    X.eM12 := 0;
    X.eM21 := 0;    X.eM22 := 1;
    X.eDx := UnitsToCoords(C, C_C, Dx);
    X.eDy := UnitsToCoords(C, C_C, Dy);
    if  GetGraphicsMode(C.Handle) <> GM_ADVANCED then
        SetGraphicsMode(C.Handle, GM_ADVANCED);
    ModifyWorldTransform(C.Handle, X, MULT_DIRECTION);
    if A <> nil then
    begin
        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
            SetGraphicsMode(A.Handle, GM_ADVANCED);
        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
    end;
end;

(*
/*
// Rotation transformation
//------------------------

FUN Canvas_transform_rotate(
	{Canvas} C|anvas_object, REAL Angle|_degrees),
    NATIVE :
    "     Do_transform_rotate(X_C, X_Angle);" .
*/
*)

procedure Do_transform_rotate(
	X_C: Ref_obj; Angle: Double);
var C, A: PCanvas;
    C_C: C_Canvas;
    X: TXForm;
    cos_, sin_: Single;
begin
    C := Get_canvas(X_C, C_C, A);
    cos_ := Cos(Angle * PI / 180.0);
    sin_ := Sin(Angle * PI / 180.0);
    X.eM11 := cos_; X.eM12 := sin_;
    X.eM21 := -sin_;X.eM22 := cos_;
    X.eDx := 0;     X.eDy := 0;
    if  GetGraphicsMode(C.Handle) <> GM_ADVANCED then
        SetGraphicsMode(C.Handle, GM_ADVANCED);
    ModifyWorldTransform(C.Handle, X, MULT_DIRECTION);
    if A <> nil then
    begin
        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
            SetGraphicsMode(A.Handle, GM_ADVANCED);
        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
    end;
end;

(*
/*
// Scale transformation
//---------------------

FUN Canvas_transform_scale(
	{Canvas} C|anvas_object, REAL Scale_x|_value,
    REAL Scale_y|_value), NATIVE :
    "     Do_transform_scale(X_C, X_Scale_x, X_Scale_y);" .
*/
*)

procedure Do_transform_scale(
	X_C: Ref_obj; Sx, Sy: Double);
var C, A: PCanvas;
    C_C: C_Canvas;
    X: TXForm;
begin
    C := Get_canvas(X_C, C_C, A);
    X.eM11 := Sx; X.eM12 := 0;
    X.eM21 := 0;  X.eM22 := Sy;
    X.eDx := 0;   X.eDy := 0;
    if  GetGraphicsMode(C.Handle) <> GM_ADVANCED then
        SetGraphicsMode(C.Handle, GM_ADVANCED);
    ModifyWorldTransform(C.Handle, X, MULT_DIRECTION);
    if A <> nil then
    begin
        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
            SetGraphicsMode(A.Handle, GM_ADVANCED);
        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
    end;
end;

(*
/*


FUNCTION Set_paint_lines_cursor_shape(
    INT H|andle_paint_lines,
    {Paintbox}.{cursor} C|ursor_shape )
    :
    Set_control_cursor_shape(H, C) .

FUNCTION Set_control_cursor_shape(
    INT H|andle_control,
    {cursor} C|ursor_shape ), NATIVE :
@   "var C: PControl;"
    "    C := PControl(X_H);"
    "case X_C of"
    "0: C.Cursor := LoadCursor(0, IDC_Arrow);"
    "1: C.Cursor := LoadCursor(0, IDC_IBeam);"
    "2: C.Cursor := LoadCursor(0, IDC_No);"
    "3: C.Cursor := LoadCursor(0, IDC_Cross);"
    "4: C.Cursor := LoadCursor(0, IDC_Hand);"
    "5: C.Cursor := LoadCursor(0, IDC_Wait);"
    "6: C.Cursor := LoadCursor(0, IDC_AppStarting);"
    "7: C.Cursor := LoadCursor(0, IDC_UpArrow);"
    "8: C.Cursor := LoadCursor(0, IDC_SizeAll);"
    "9: C.Cursor := LoadCursor(0, IDC_SizeWE);"
    "10: C.Cursor := LoadCursor(0, IDC_SizeNS);"
    "11: C.Cursor := LoadCursor(0, IDC_SizeNESW);"
    "12: C.Cursor := LoadCursor(0, IDC_SizeNWSE);"
    "13: C.Cursor := LoadCursor(0, IDC_Help);"
    "end;"
    .
*/
*)

//----------------------------------------------- C A R E T ------------
(*
/*

FUNCTION Provide_window_caret(
    INT S|crolled_paintbox_handle,
    REAL X|_pos_points,
    REAL Y|_pos_points,
    REAL Caret_w|idth_points,
    REAL Caret_h|eight_points), NATIVE
    :
    CASE S == 0 ? ==> ;
    INT off_x|_in_pixels = Points(X)
    INT off_y|_in_points = Points(Y)
    INT w_caret|_pixels = Points(Caret_w)
    INT h_caret|_pixels = Points(Caret_h)
    NATIVE @
    "Do_provide_window_caret(X_S, X_off_x, X_off_y, X_w_caret, X_h_caret);" .
*/
*)

procedure Do_provide_window_caret(
	X_S, off_x, off_y, w_caret, h_caret: Integer);
var SPB: PScrolled_paintbox;
    W: THandle;
    Pn: PControl;
begin
    Pn := PControl(X_S);
    SPB := PScrolled_paintbox(Pn.CustomData);
    W := SPB.PBox.Handle;
    if w_caret < 1 then w_caret := 1;
    CreateCaret(W, 0, w_caret, h_caret);
    if GetFocus = W then
    begin
        SetCaretPos(off_x, off_y);
        ShowCaret(W);
        SPB.caret_active := true;
    end
        else
    if SPB.caret_active then
    begin
        HideCaret(W);
        SPB.caret_active := false;
    end;
end;

(*
/*

FUNCTION Destroy_window_caret(
	INT S|crolled_paintbox_handle), NATIVE :
@   "Do_destroy_window_caret(X_S);" .
*/
*)

procedure Do_destroy_window_caret(
	X_S: Integer);
var SPB: PScrolled_paintbox;
    Pn: PControl;
begin
    Pn := PControl(X_S);
    SPB := PScrolled_paintbox(Pn.CustomData);
    HideCaret(SPB.PBox.Handle);
end;


(*
/*
// String measure for current font
//---------------------------------

FUN String_measure(
	{Canvas} C|anvas_object, STR S|tring_to_measure) ==> {rect}
	:
	REAL m|easured_values[] << 0 << 0
	do_String_measure(C, S, m[])
	RESULT = {rect}(Width = m[0], Height = m[1]) .
FUN do_String_measure({Canvas} C|anvas_object, STR S|tring_to_measure,
REAL M|easured_values[]), NATIVE : @
    "var C, A: PCanvas;"
    "var C_C: C_Canvas;"
    "var C_F: C_Font;"
    "var Sz: TSize;"
    "    C := Get_canvas(X_C, C_C, A);"
    "    C_F := C_Font(C_C.F_Font.Obj);"
    "    C.Font.FontName := C_F.F_Face;"
    "    //C.Font.FontHeight := -Trunc(Points(C_F.F_Size));"
    "    C.Font.FontHeight := -Trunc(Points(Abs(C_F.F_Size)));"
    "    C.Font.FontStyle := Get_font_style(C_F);"
    "    Sz := C.TextExtent(X_S);"
    "    X_M.SetReals(0, UnitsFromCoords(C,  C_C, Sz.cx));"
    "    X_M.SetReals(1, UnitsFromCoords(C,  C_C, Sz.cy));"
    .
    

    
    FUNCTION Set_canvas_quality(
    	{Canvas} C|anvas_object, {Canvas}.{quality} Q|uality_set) : .
    	
    FUN End_paint_of_canvas(
	{Canvas} C|anvas_object_dummy): .



*/
*)


end.
(*
/*
END
*/
*)



