(*
/*

// wrapper for {Picture} control, {Bitmap}, {Canvas}, {Font}

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

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

NATIVE:@"uses AL4_form, AL4_font"
        "  , Forms, Controls, Graphics, printers"
        "  {$IFDEF LINUX}"
        "  {$ELSE} "
        "			, Windows"
        "  {$ENDIF},"
        "  {$IFDEF BGRABITMAP}"
        "		{$IFDEF BGRABITMAP_OLD}"     
        "			BGRABitmap, BGRABitmapTypes,"
        "		{$ELSE}"
        "			bgrabitmap, bgrabitmaptypes,"
        "		{$ENDIF}"     
        "	{$ELSE} {$UNDEF BGRABITMAP_CANVAS}"
        "  {$ENDIF}"
        "  			AL4_drawing "
        ";" .
        
NATIVE: "{$I AL4_options.inc}" .
NATIVE: "/// COPY AL4_options.inc" .

NATIVE: "///copy NATIVE_Stream_on_C_Stream.pas" .
NATIVE: "///copy AL4_drawing.pas" .
//NATIVE: "///copy NATIVE_Printers.pas" .
        
*/
*)
unit AL4_drawing;

interface

{$I AL4_options.inc}

//defines

uses Classes, Forms, Controls, Printers, Menus,
// use AL4 to access system functions (AL4.pas inserted by the compiler into
// a project folder)
     AL4,
     NATIVE_Stream_on_C_Stream,
// use All_classes from a project folder (generated for a certain project)
     All_classes, 
     AL4_form,
     unitC_Control {to access NoneObj_C_Control},
     StdCtrls, ExtCtrls, ComCtrls, Dialogs
     {$IFDEF FPC}, IntfGraphics, LCLType, LCLIntf, GraphType, Clipbrd
     {$ELSE}
//?{Jpeg}
     , jpeg
//.
     , Clipbrd
     {$ENDIF}
     {$IFDEF LINUX} , Types
     {$ELSE} , Windows, Messages
//?{Gif}
		{$IFnDEF FPC}
		{$IFDEF RXGIF}
		, RxGif
		{$ENDIF}
		{$ENDIF}
//.
//?{Png}
		{$IFDEF PngObject}
		, pngimage
		{$ENDIF}
//.
     {$ENDIF}
     , Graphics, Math
     {$IFDEF BGRABITMAP}
     , BGRABitmap, BGRABitmapTypes
//?{Png}
     , BGRAWritePng, BGRAReadPng
//.
//?{Jpeg}
     , BGRAReadJpeg
//.
//?{Pcx}
	 , BGRAReadPCX
//.
//?{Psd}
	 , BGRAReadPSD
//.
//?{Tga}
	 , BGRAReadTGA
//.
//?{Tiff}
	 {$IFnDEF NO_TIFF}
	 , BGRAReadTiff
	 {$ENDIF}
//.
//?{WebP}
	 {$IFnDEF NO_WEBP}
	 , BGRAReadWebP
	 , BGRAWriteWebP
	 {$ENDIF}
//.
//?{Xpm}
	 , BGRAReadXPM
//.
	 {$ELSE} {$UNDEF BGRABITMAP_CANVAS}
     {$ENDIF}
     ;
     
{$IFDEF LINUX}
	{$DEFINE SIMULATED_TRANSFORMS}
	{$DEFINE SIMULATED_CARET}
{$ENDIF}

   
type
	THackGraphicControl = class(TGraphicControl)
	end;
     
const DPI_DEFAULT = 72.0;

type
	TMatrixRec = record
		m11, m12, m21, m22: Double;
		mtx, mty: Double;
	end;
	
type
  TPaintPanel = class(TPanel)
  private
  		fOnPaint_Scrolled_paintbox: TNotifyEvent;
  public
        Can_focus: Boolean;
        AL4form: TAL4Form;
        procedure Paint; override;
        {$IFNDEF LINUX}
        procedure WMErase(var M: TMessage); message WM_ERASEBKGND;
        procedure WMLButtonDown(var Message: TWMLButtonDown); 
        	message WM_LBUTTONDOWN;
        procedure WMRButtonDown(var Message: TWMRButtonDown); 
        	message WM_RBUTTONDOWN;
        //procedure WndProc(var Message: TMessage); override;
        {$ENDIF}
  public
        property OnPaint_Scrolled_paintbox: TNotifyEvent 
            read fOnPaint_Scrolled_paintbox 
            write fOnPaint_Scrolled_paintbox;
  end;
  
  TScroller = class(TScrollBar)
  		constructor Create(AOwner: TComponent); override;
  		function CanFocus: Boolean; override; 
  end;
  
  TScrolled_paintbox = class(TPanel)
  public
        AL4Form: TAL4Form;
        PBox: TPaintPanel;
        VBar: TScroller;
        HBar: TScroller;
        BRspace: TPanel;
        scrolling: Boolean;
        {$IFDEF SIMULATED_CARET}
        CaretBox: TPaintPanel;
        CaretTimer: TTimer;
        CaretColor: Integer;
        {$ENDIF}
        caret_active: Boolean;
        Content_width: Double;
        Content_height: Double;
        row_width: Double;
        line_height: Double;
        coeff_vert: Double;
        coeff_horz: Double;
        
        suspend_count: Integer;
        
        procedure Paint_box_paint(Sender: TObject);
        {$IFDEF SIMULATED_CARET}
        procedure CaretTick(Sender: TObject);
        procedure CaretPaint(Sender: TObject);
        {$ELSE}
        {$ENDIF}
        procedure SPB_Resize(Sender: TObject);
        constructor Create(AOwner: TComponent; V, H, X_Can_focus: Boolean);
            reintroduce;
        destructor Destroy; override;
        procedure Adjust_components;
        function ParentForm: TForm;
        procedure pbox_Scrolled(Sender: TObject; ScrollCode: TScrollCode; 
        		var ScrollPos: Integer);
        procedure Control_Enter(Sender: TObject);
        procedure Control_Leave(Sender: TObject);
        //{$IFNDEF LINUX}
        //procedure WndProc(var Message: TMessage); override;
        //{$ENDIF}
        
        //procedure Redirect_focus_to_pbox(Sender: TObject);
        //procedure WM_Focus_pbox(var Message: TMessage); message WM_USER+1022;
    end;
    
    
    {$DEFINE SUPPORT_PRINTER}
    TBitmap_Ex = class
    public Bm: {$IFDEF BGRABITMAP_CANVAS} TBGRABitmap {$ELSE} Graphics.TBitmap {$ENDIF};
    public Ico: TIcon;
//?{Gif}
	{$IFDEF RXGIF}
	public Gif: TGifImage; // used from RxGif
	{$ENDIF}
	public Gif_buffer: {$IFDEF BGRABITMAP} TBGRABitmap {$ELSE} TBitmap {$ENDIF};
//.
    public Tag_bitmap_object_: Ref_obj;
    {$IFDEF SUPPORT_PRINTER}
    	public Printer: TPrinter;
    {$ENDIF}
    public CanvasObject_: Ref_obj;
    public LocalCopyPixels: Pointer;
    public LocalSize: Integer;
    {$IFnDEF BGRABITMAP_CANVAS}
    public AlphaChannel: TBitmap;
    {$ENDIF}
    public locked_Y: Integer;
    public locked_H: Integer;
    constructor Create(w, h: Integer);
    destructor Destroy; override;
    public // only for SIMULATED_TRANSFORMS:
    	Transformed: Boolean;
    	Matrix: {$IFDEF SIMULATED_TRANSFORMS} TMatrixRec
    			{$ELSE} TXForm {$ENDIF} ;
    end;

    TCanvasEx = class(TCanvas)
    end;
    
function UnitsFromCoords(C: TCanvas;
	C_Units: Integer; Value_pixels: Double): Double;

// paint box functions 
function Do_Create_paint_box(P: Integer; X_P: Pointer;
    X_V, X_H, X_Can_focus, X_Call_paint: Boolean): Integer;
procedure Do_Set_paint_lines_cursor_shape(X_H, X_C: Integer);
procedure Do_set_wincontrol_cursor(C: TWinControl; Cursor: Integer);
procedure Do_set_scroll_position(X_H: Integer; 
	X_v, X_hor: Boolean; X_Value: Double);
procedure Do_Set_paintbox_content_area(X_P: Integer;
	X_W, X_H, X_Row_w, X_Line_h: Double);    
    
// 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);
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;

// gif functions
function Do_Get_animated_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;
function Do_Save_to_stream_gif(X_B: Integer; X_S: Ref_obj) : Boolean;

//jpeg
function Do_get_jpeg_from_stream_ex(
	X_A: DynAByte; X_B, X_Div: Integer): Boolean;
function Do_Save_to_stream_jpg(
		 X_B: Integer; X_Stream: Ref_obj; X_Quality: Integer): Boolean;
function Do_Save_bitmap_jpg(X_B: Integer; const X_Path: String;
		 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_S: Ref_obj; X_Quality: Integer): Boolean;
function Do_Save_bitmap_png(X_B: Integer; const X_Path: String): Boolean;

//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;

//tga
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;

//webp
function Do_get_webp_from_stream(X_S: Ref_obj; X_B: Integer): Boolean;
function Do_Save_to_stream_webp(
	X_B: Integer; X_S: Ref_obj; X_Quality: Integer; X_Lossless: Boolean)
	: Boolean;

//xpm
function Do_get_xpm_from_stream(X_S: Ref_obj; X_B: Integer): Boolean;

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

procedure Do_Destroy_bitmap(X_B: Integer);
procedure Do_draw_bitmap(X_B: Integer; X_D: Ref_obj; X, Y, W, H: Double);
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_Capture_screen(X_B: Integer; X_X, X_Y: Double);
function Do_get_bitmap_from_clipboard(X_B: Integer): Boolean;
function Do_put_bitmap_to_clipboard(X_B: Integer): Boolean;


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

{$IFDEF linux}
{$ELSE}
procedure Do_load_icon_from_file(X_B: Integer; const X_Path: String);
procedure Do_load_cursor(X_B: Integer; const X_Path: String);
{$ENDIF}
function icon_info(X_B: Integer): String;

// {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 Is_Direct_draw_canvas: Boolean;
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_Destroy_canvas(X_C: Integer);
procedure Do_Erase_rect(X_C: Ref_obj; X, Y, W, H: Double);
procedure Do_Paint_rect(X_C: Ref_obj; _X, _Y, _W, _H: Double);
procedure Do_Paint_line(X_C: Ref_obj; X1, Y1, X2, Y2: Double);



procedure Do_Paint_ellipse( X_C: Ref_obj; _X, _Y, _W, _H: Double);
procedure Do_Paint_arc(X_C: Ref_obj; _X, _Y, _W, _H, _Fr, _To: Double; Sided: Boolean);
procedure Do_Paint_text(X_C: Ref_obj; X, Y: Double; const Text: String);
procedure Do_Paint_poly(X_C: Ref_obj; X_X: DynAReal; X_Y: DynAReal; X_Closed: Boolean);

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);
procedure Do_String_measure(X_C: Ref_obj; const X_S: String; X_V: DynAReal);

function Get_canvas(
	R_C: Ref_obj; var C_Units: Integer 
	{$IFnDEF BGRABITMAP_CANVAS} ; var A: TCanvas {$ENDIF} ): TCanvas;

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

{$IFDEF USE_LISTS_OF_DESCRIPTORS}
var All_bitmaps: TList;
{$ENDIF}

const XIdentity: TMatrixRec = (m11: 1; m12: 0; m21: 0; m22: 1; mtx:0; mty:0);
procedure call_form_scrolled(SPB: TScrolled_paintbox);

var All_printers: TList;

implementation

uses SysUtils;

(*
/*

FUNCTION Get_system_color(
	{Canvas}.{system_color} C|olor_index) ==> INT, NATIVE :
@   "var i: TColor;"
    "i := clACTIVECAPTION;"
    "case X_C of"
    "0: i := clACTIVECAPTION;"
    "1: i := {clGRADIENTACTIVECAPTION} TColor(27 or $80000000);"
    "2: i := clACTIVEBORDER;"
    "3: i := clCAPTIONTEXT;"
    "4: i := clBTNFACE;"
    "5: i := clBTNTEXT;"
    "6: i := clBTNHIghLIGHT;"
    "7: i := clBTNSHADOW;"
    "8: i := clWindowFrame;"
    "9: i := clGRAYTEXT;"
    "10: i := clINFOBK;"
    "11: i := clINFOTEXT;"
    "12: i := clINACTIVECAPTION;"
    "13: i := {clGRADIENTACTIVECAPTION} TColor(27 or $80000000);"
    "14: i := clINACTIVEBORDER;"
    "15: i := clINACTIVECAPTIONTEXT;"
    "16: i := clMENU;"
    "17: i := clMENUTEXT;"
    "18: i := {clMENUHIGHLIGHT} TColor(29 or $80000000);"
    "19: i := clSCROLLBAR;"
    "20: i := clWINDOW;"
    "21: i := clWINDOWTEXT;"
    "22: i := clWINDOWFRAME;"
    "23: i := clHighlight;"
    "24: i := clHighlightText;"
    "end;"
    "RESULT := ColorToRGB(i);" .
    
FUN Get_rgba_order ==> {Canvas}.{rgba_order}, NATIVE : @
"var probe: {$IFDEF BGRABITMAP} TBGRAPixel {$ELSE} DWORD {$ENDIF} ;"
"	 {$IFDEF BGRABITMAP}"
"	 PDWORD(@probe)^ := 0;"
"	 probe.Red := 1;"
"	 if PDWORD(@probe)^ = 1 then Result := 1;"
"	 {$ELSE}"
"		{$IFDEF LINUX} Result := 0; {$ENDIF}"
"	 {$ENDIF}" .

*/
*)

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

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

FUN Create_paint_box(
    {Control} P|aint_box_control,
    STR Op|tions_V_H_Focus) ==> INT
    :
    INT form|_handle = P.Form_.Handle
	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|aint_box,
    BOOL V|ertical_scrollbar,
    BOOL H|orizontal_scrollbar,
    BOOL Can|_focus,
    BOOL Call_paint) ==> INT, NATIVE :
    NATIVE @
    "RESULT := Do_Create_paint_box(X_Form, X_P, X_V, X_H, X_Can, X_Call_paint);"
    .
    
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(
P: Integer; X_P: Pointer;
    X_V, X_H, X_Can_focus, X_Call_paint: Boolean): Integer;
var Parent: TAL4Column;
    C: TScrolled_paintbox;
    F: TAL4Form;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	F := TAL4Form(All_forms[P]);
	{$ELSE}
    	F := TAL4Form(P);
	{$ENDIF}
    Parent := F.Get_current_column;
    C := TScrolled_paintbox.Create(Parent, X_V, X_H, X_Can_focus);
  
    {$IFDEF CPU64}
    	C.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_P);
    	C.PBox.Tag := {$IFDEF FPC} IntPtr {$ELSE} Int64 {$ENDIF}(X_P);
    {$ELSE}
    	C.Tag := Integer(X_P);
    	C.PBox.Tag := Integer(X_P);
    {$ENDIF}
    C.Parent := Parent;
    Adjust_control_location(Parent, C);
    
    Set_control_events(Parent, C);
    Set_Win_control_events(Parent, C);
    C.OnClick := nil;
    C.OnMouseMove := nil;
    C.OnMouseDown := nil;
    C.OnMouseUp := nil;
    C.OnDblClick := nil;
    
	C.OnResize := {$IFDEF OBJFPC}@{$ENDIF} C.SPB_Resize;
    
    Set_control_events(Parent, C.PBox);
    Set_Win_control_events(Parent, C.PBox);

	C.PBox.OnPaint_Scrolled_paintbox := 
    	{$IFDEF OBJFPC} @ {$ENDIF} C.Paint_box_paint;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := allocate_control(C);
    {$ELSE}
    	Result := Integer(C);
    {$ENDIF}
end;

(*
/*

FUNCTION Set_paint_lines_cursor_shape(
    INT H|andle_paint_lines,
    {cursor} C|ursor_shape ), NATIVE :
	"	Do_Set_paint_lines_cursor_shape(X_H, X_C);" .
*/
*)

procedure Do_Set_paint_lines_cursor_shape(X_H, X_C: Integer);
var P: TScrolled_paintbox;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		P := TScrolled_paintbox(All_controls[X_H]);
	{$ELSE}
		P := TScrolled_paintbox(X_H);
	{$ENDIF}
	Do_set_wincontrol_cursor(P.PBox, X_C);
end;
(*
/*

FUN Invalidate_paintbox(
    INT H|andle_paint_box,
    {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|_rectangle, REAL Y|_rectangle,
REAL W|idth_rect, REAL H|eight_rect), NATIVE : @
	"var P: TScrolled_paintbox;"
    "if (X_PB = 0) or (Application.Terminated) then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "	P := TScrolled_paintbox(All_controls[X_PB]);"
    "{$ELSE}"
    "	P := TScrolled_paintbox(X_PB);"
    "{$ENDIF}"
    "if (P <> nil) and (P.PBox <> nil) then"
    "	P.PBox.Invalidate;" .
    
FUN Update_paintbox(INT PB|ox_handle), NATIVE: @
	"var P: TScrolled_paintbox;"
    "if (X_PB = 0) or (Application.Terminated) then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "	P := TScrolled_paintbox(All_controls[X_PB]);"
    "{$ELSE}"
    "	P := TScrolled_paintbox(X_PB);"
    "{$ENDIF}"
    "if (P <> nil) and (P.PBox <> nil) then"
    "	P.PBox.Repaint;" .

    
    
FUN Get_invalid_rect(
    INT H|andle_paint_box, REAL A|rray_coords[]), NATIVE: @
    "var P: TScrolled_paintbox;"
    "var R: TRect;"
    "{$IFnDEF FPC}"
    "if (X_H = 0) or (Application.Terminated) then Exit;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "	P := TScrolled_paintbox(All_controls[X_H]);"
    "{$ELSE}"
    "	P := TScrolled_paintbox(X_H);"
    "{$ENDIF}"
    "if (P = nil) or (P.PBox = nil) then Exit;"
    "if not GetUpdateRect(P.PBox.Handle, R, false) then Exit;"
    "X_A.Add(-1, Pixels(R.Left));"
    "X_A.Add(-1, Pixels(R.Top));"
    "X_A.Add(-1, Pixels(R.Right - R.Left));"
    "X_A.Add(-1, Pixels(R.Bottom - R.Top));"
    "{$ENDIF}".

    
    
    
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
    :
    "Do_Set_paintbox_content_area(X_P, X_W, X_H, X_Row_w, X_Line_h);" .
*/
*)

procedure Do_Set_paintbox_content_area(
X_P: Integer; X_W, X_H, X_Row_w, X_Line_h: Double);  
var P: TScrolled_paintbox;
begin
 	if X_P = 0 then Exit;
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 		P := TScrolled_paintbox(All_controls[X_P]);
 	{$ELSE}
    	P := TScrolled_paintbox(X_P);
 	{$ENDIF}
 	P.Content_width := AL4_Form.Points(X_W);
 	P.Content_height := AL4_Form.Points(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 - 1) / MaxInt;
 	if X_H <= MaxInt then P.coeff_vert := 1
 	else P.coeff_vert := (X_H - 1) / MaxInt;
    P.Adjust_components;
end;
(*
/*
    
FUN Paintbox_client_width(
INT P|aint_box_handle) ==> REAL, NATIVE :
@	"var P: TScrolled_paintbox;"
	"	 if X_P = 0 then Exit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_P]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_P);"
	"	{$ENDIF}"
	"	 RESULT := Pixels(P.PBox.Width);" .
	
FUN Paintbox_client_height(
INT P|aint_box_handle) ==> REAL, NATIVE :
@	"var P: TScrolled_paintbox;"
	"	 if X_P = 0 then Exit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_P]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_P);"
	"	{$ENDIF}"
	"	 RESULT := Pixels(P.PBox.Height);" .
    
FUN Set_paint_lines_line_height(
	INT P|aint_box_handle,
    REAL H|eight_area_points), NATIVE
    :
@   "var P: TScrolled_paintbox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_P]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_P);"
	"	{$ENDIF}"
	"	 if P = nil then Exit;"     
    "    if P.VBar <> nil then "
    "    begin"
    "		P.VBar.SmallChange := AL4_form.Points(X_H);"
    "    end;"
    "    P.Adjust_components;" .
    
FUN Get_hscroll_height(
INT H|andle_paint_box) ==> REAL RESULT|_points,
    NATIVE :
@   "var P: TScrolled_paintbox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_H]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_H);"
	"	{$ENDIF}"
    "    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: TScrolled_paintbox;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_H]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_H);"
	"	{$ENDIF}"
    "    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
    :
    BOOL v|ertical = "v" IN What.Lower
    BOOL hor|izontal = "h" IN What.Lower
    NATIVE @
    "var P: TScrolled_paintbox;"
    "	 if X_H = 0 then Exit;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 P := TScrolled_paintbox(All_controls[X_H]);"
	"	{$ELSE}"
	"    P := TScrolled_paintbox(X_H);"
	"	{$ENDIF}"
    "    if (X_v) and (P.VBar <> nil) then"
    "	 begin"
    "		if P.coeff_vert <= 1 then"     
    "       	RESULT := P.VBar.Position"
    "		else RESULT := P.VBar.Position * P.coeff_vert;"     
    "	 end"
    "    else if (X_hor) and (P.HBar <> nil) then"
    "	 begin"
    "		if P.coeff_horz <= 1 then"     
    "       	RESULT := P.HBar.Position"
    "       else RESULT := P.HBar.Position * P.coeff_horz;"
    "	 end;" 
    "	 RESULT := AL4_form.Pixels(RESULT);" .
    
    
FUN Set_scroll_position(
    INT H|andle_paint_box,
    STR What|_box_VH, REAL Value|_points), NATIVE
    :
    BOOL v|ertical = "v" IN What.Lower
    BOOL hor|izontal = "h" IN What.Lower
    //DEBUG: << "set " What " scroll position=" Value.S #NL ;
    NATIVE @
    "	Do_set_scroll_position(X_H, X_v, X_hor, AL4_form.Points(X_Value));" .
    
*/
*)

procedure Do_set_scroll_position(X_H: Integer; 
	X_v, X_hor: Boolean; X_Value: Double);
var P: TScrolled_paintbox;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 P := TScrolled_paintbox(All_controls[X_H]);
 	{$ELSE}
     P := TScrolled_paintbox(X_H);
 	{$ENDIF}
    if P.scrolling then Exit;
    if (X_v) and (P.VBar <> nil) then
    begin
       P.VBar.Position := Round(X_Value / P.coeff_vert)
    end
    else if (X_hor) and (P.HBar <> nil) then
    begin
       P.HBar.Position := Round(X_Value / P.coeff_horz);
       //P.HBar.Position := Round(X_Value / P.row_width / P.coeff_horz);
    end;
end;

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

(*
/*
// Create TBitmap_Ex 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" .
*/
*)

{$IFDEF USE_LISTS_OF_DESCRIPTORS}

function Allocate_bitmap(B: TBitmap_Ex): Integer;
var dummy_bitmap: TBitmap_ex;
begin
	if All_bitmaps = nil then
	begin
	   All_bitmaps :=  TList.Create;
	   dummy_bitmap := TBitmap_Ex.Create(1,1);
	   All_bitmaps.Add(dummy_bitmap);
	end;
	Result := All_bitmaps.IndexOf(nil);
	if Result < 0 then
	begin
		Result := All_bitmaps.Count;
		All_bitmaps.Add(nil);
	end; 
	All_bitmaps[Result] := B;
end;
{$ENDIF}

function Do_Create_bitmap(
	X_B: Ref_obj; X_Bpp: Integer): Integer;
var Bmp: TBitmap_Ex;
	C_B: C_Bitmap;
begin
	C_B := C_Bitmap(X_B.Obj);
	Bmp := TBitmap_Ex.Create(C_B.F_Width, C_B.F_Height);
	{$IFnDEF BGRABITMAP_CANVAS}
	    CASE X_Bpp OF
	    1: Bmp.Bm.PixelFormat := pf1bit;
	    4: Bmp.Bm.PixelFormat := pf4bit;
	    8: Bmp.Bm.PixelFormat := pf8bit;
	    15: Bmp.Bm.PixelFormat := pf15bit;
	    16: Bmp.Bm.PixelFormat := pf16bit;
	    24: Bmp.Bm.PixelFormat := pf24bit;
	    else Bmp.Bm.PixelFormat := pf32bit;
	    END;
	{$ENDIF}
    Object_assign_weak(Bmp.Tag_bitmap_object_, X_B.Obj);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	Result := Allocate_bitmap(Bmp);
    {$ELSE}
    	Result := Integer(Bmp);
    {$ENDIF}
end;

(*
/*

FUN Get_bitmap_depth(
	INT B|itmap_handle) ==> INT RESULT|bpp_or_0, NATIVE :
@   "var B: TBitmap_Ex;"
    "{$IFDEF BGRABITMAP_CANVAS}"
    "	RESULT := 4;"
    "{$ELSE}"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
	"	 B := TBitmap_ex(All_bitmaps[X_B]);"
	"	{$ELSE}"
    "    B := TBitmap_Ex(X_B);"
    "	{$ENDIF}"
    "	case B.Bm.PixelFormat of" 
    "    pf1bit: RESULT := 1;"
    "    pf4bit: RESULT := 4;"
    "    pf8bit: RESULT := 8;"
    "    pf15bit, pf16bit: RESULT := 16;"
    "    pf24bit: RESULT := 24;"
    "    pf32bit: RESULT := 32;"
    "    end;"
    "{$ENDIF}"
    .
*/
*)


(*
/*
// 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 Bmp: TBitmap_Ex;
{$IFDEF BGRABITMAP_CANVAS}
	Old: TBGRABitmap;
{$ENDIF}
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    TRY
    {$IFDEF BGRABITMAP_CANVAS}
    	if (Bmp.Bm.Width <> X_W) or (Bmp.Bm.Height <> X_H) then
    	begin
    		Old := Bmp.Bm;
    		Bmp.Bm := TBGRABitmap.Create(X_W, X_H, BGRABlack);
    		if (Old.Width > 1) or (Old.Height > 1) then
    			Old.Draw(Bmp.Bm.Canvas, 0, 0, TRUE);
    		Old.Free; 
    	end;
    {$ELSE}
	    Bmp.Bm.Width := X_W;
	    Bmp.Bm.Height := X_H;
	    if Bmp.AlphaChannel <> nil then
	    begin
	        Bmp.AlphaChannel.Width := X_W;
	        Bmp.AlphaChannel.Height := X_H;
	    end;
    {$ENDIF}
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    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_2_4_8) ==> 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_2_4_8) ==> 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_animated_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_animated_gif_from_stream(X_a, X_B);" . 

*/
*)

function Do_Get_animated_gif_from_stream(
X_a: DynAByte; X_B: Integer): Boolean;
{$IFDEF FPC}
var Bmp: TBitmap_Ex;
	B_ref: Ref_obj;
	B: C_Bitmap;
	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
	gif: TGifImage;
{$ELSE}
//?{Gif}
var Bmp: TBitmap_Ex;
	B_ref: Ref_obj;
	B: C_Bitmap;
	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
//.
{$ENDIF}
begin
	RESULT := FALSE;
{$IFDEF FPC}
	{$IFDEF DO_NOT_USE_NATIVE_GIF_LOAD}
	Exit;
	{$ENDIF}
	MS := TMemoryStream.Create();
	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;

	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
	
    gif := TGifImage.Create;
    try
	    TRY
		    gif.LoadFromStream(MS);
		    RESULT := (gif.Width > 0) and (gif.Height > 0);
		    if RESULT then
		    begin
			    {$IFDEF BGRABITMAP_CANVAS}
			    	if (Bmp.Bm.Width <> gif.Width) or 
			    	   (Bmp.Bm.Height <> gif.Height) then
			    	begin
			    		Bmp.Bm.Free;
			    		Bmp.Bm := TBGRABitmap.Create(
			    			gif.Width, gif.Height, BGRABlack);
			    	end;
			    {$ELSE}
				    Bmp.Bm := TBitmap.Create;
				    Bmp.Bm.Width := gif.Width;
				    Bmp.Bm.Height := gif.Height;
			    {$ENDIF}
			    Bmp.Bm.Canvas.Draw(0, 0, gif);
			    B_ref := Bmp.Tag_bitmap_object_;
			    B := C_Bitmap(B_ref.Obj);
			    B.F_Width := gif.Width;
			    B.F_Height := gif.Height;
		    end;
	    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    END;
    finally
    	MS.Free;
    	gif.Free;
    end;
{$ELSE}
//?{Gif}
	{$IFDEF RXGIF}
	MS := TMemoryStream.Create();
	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;

	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    try
	    TRY
		    Bmp.Gif := TGifImage.Create;
		    Bmp.Gif.LoadFromStream(MS);
		    RESULT := not Bmp.Gif.Corrupted or (Bmp.Gif.Count > 0);
		    B_ref := Bmp.Tag_bitmap_object_;
		    B := C_Bitmap(B_ref.Obj);
		    B.F_Width := Bmp.Gif.Width;
		    B.F_Height := Bmp.Gif.Height;
	    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    END;
    finally
    	MS.Free;
    end;
    {$ENDIF}
//.
{$ENDIF}
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: TBitmap_Ex;
begin
	RESULT := 0;
	{$IFDEF FPC}
	{$ELSE}
//?{Gif}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFDEF RXGIF}
    if (Bmp.Gif <> nil) then RESULT := Bmp.Gif.Count;
    {$ENDIF}
//.
	{$ENDIF}
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: TBitmap_Ex;
begin
	{$IFDEF FPC}
	{$ELSE}
//?{Gif}
{$IFDEF RXGIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    if Bmp.Gif <> nil then
    begin
    	if Bmp.Gif_buffer = nil then
    	begin
    		Bmp.Gif_buffer := {$IFDEF BGRABITMAP_CANVAS} TBGRABitmap 
			    		  	  {$ELSE} TBitmap {$ENDIF}.Create;
    		Bmp.Gif_buffer.Width := Bmp.Gif.Width;
    		Bmp.Gif_buffer.Height := Bmp.Gif.Height;
			Bmp.Gif_buffer.Canvas.Brush.Color := clBlack;
			Bmp.Gif_buffer.Canvas.FillRect(
				Classes.Rect(
				0,0,Bmp.Gif_buffer.Width,Bmp.Gif_buffer.Height));
    		Bmp.Gif_buffer.Canvas.Draw(0, 0, Bmp.Gif);
    	end;
    	Bmp.Gif.FrameIndex := X_I;
    	CASE Bmp.Gif.Frames[X_I].DisposalMethod of
	    	dmUndefined, dmLeave: ;
	    	dmRestoreBackground:
				begin
					Bmp.Gif_buffer.Canvas.Brush.Color := clBlack;
					Bmp.Gif_buffer.Canvas.FillRect(
						Classes.Rect(
						0,0,Bmp.Gif_buffer.Width,Bmp.Gif_buffer.Height));
				end;
    	end;
    	Bmp.Gif_buffer.Canvas.Draw(Bmp.Gif.Frames[X_I].Origin.X,
    		Bmp.Gif.Frames[X_I].Origin.Y, Bmp.Gif);
    end;
{$ENDIF}
//.
	{$ENDIF}
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: TBitmap_Ex;
begin
	RESULT := 0;
	{$IFDEF FPC}
	{$ELSE}
//?{Gif}
{$IFDEF RXGIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    if (Bmp.Gif <> nil) then 
    	RESULT := Bmp.Gif.Frames[Bmp.Gif.FrameIndex].AnimateInterval;
{$ENDIF}
//.
	{$ENDIF}
end; 
 

function Do_Get_bitmap_from_stream(
X_A: DynAByte; X_B: Integer): Boolean;
//?{Bmp}
var Bmp: TBitmap_Ex;
	B_ref: Ref_obj;
	B: C_Bitmap;
	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
//.
begin
	RESULT := FALSE;
//?{Bmp}
	MS := TMemoryStream.Create();
	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;

	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    try
	    TRY
	    Bmp.Bm.LoadFromStream(MS);
	    {$IFDEF BGRABITMAP}
            //if Bmp.Bm.LineOrder = riloBottomToTop then
            //    Bmp.Bm.VerticalFlip;
	    {$ENDIF}
	    B_ref := Bmp.Tag_bitmap_object_;
	    B := C_Bitmap(B_ref.Obj);
	    B.F_Width := Bmp.Bm.Width;
	    B.F_Height := Bmp.Bm.Height;
	    RESULT := (B.F_Width > 0) and (B.F_Height > 0);
	    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    END;
    finally
    	MS.Free;
    end;
//.
end;

function Do_get_jpeg_from_stream_ex(
	X_A: DynAByte; X_B, X_Div: Integer): Boolean;
//?{Jpeg}
var Bmp: TBitmap_Ex;
	B_ref: Ref_obj;
	B: C_Bitmap;
	J: TJpegImage;
	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
	{$IFDEF BGRABITMAP}
	r: TBGRAReaderJpeg;
	tmp: TBGRABitmap;
	{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Jpeg}
	MS := TMemoryStream.Create();
	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 := TJpegImage.Create;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFDEF BGRABITMAP}
    r := TBGRAReaderJpeg.Create;
    try
	    case X_Div of
	    2: r.Scale := jsHalf;
	    4: r.Scale := jsQuarter;
	    8: r.Scale := jsEighth;
	    else r.Scale := jsFullSize;
	    end;
	    
	    {$IFDEF BGRABITMAP_CANVAS}
    	Bmp.Bm.Free;
    	Bmp.Bm := TBGRABitmap.Create;
    	Bmp.Bm.LoadFromStream(MS, r);
    	{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(MS, r);
				try
				Bmp.Bm.Width := tmp.Width;
		    	Bmp.Bm.Height := tmp.Height;
		    	Bmp.Bm.PixelFormat := pf24bit;
		    	Bmp.Bm.Canvas.Brush.Color := clWhite;
		    	//B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//Bmp.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(Bmp.Bm.Canvas, 0, 0);
		    	Bmp.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
    	{$ENDIF}
    	
	    B_ref := Bmp.Tag_bitmap_object_;
	    B := C_Bitmap(B_ref.Obj);
	    B.F_Width := Bmp.Bm.Width;
	    B.F_Height := Bmp.Bm.Height;
	    RESULT := (B.F_Width > 0) and (B.F_Height > 0);
    finally
    	r.Free;
    end;
    {$ELSE}
    try
	    TRY
	    {$IFDEF FPC}
	    {$ELSE} 
		    J.PixelFormat := jf24Bit; 
		    J.Performance := jpBestQuality;
		    case X_Div of
		    2: J.Scale := jsHalf;
		    4: J.Scale := jsQuarter;
		    8: J.Scale := jsEighth;
		    else J.Scale := jsFullSize;
		    end;
	    {$ENDIF}
	    J.LoadFromStream(MS);
	    {$IFDEF FPC}
	    {$ELSE} 
	    	J.DIBNeeded;
	    {$ENDIF}
	    
	    {$IFDEF BGRABITMAP_CANVAS}
	    	if (Bmp.Bm.Width <> J.Width) or (Bmp.Bm.Height <> J.Height) then
	    	begin
		    	Bmp.Bm.Free;
	    		Bmp.Bm := TBGRABitmap.Create(J.Width, J.Height, BGRABlack);
    		end;
    		Bmp.Bm.Canvas.Draw(0, 0, J);
            //if Bmp.Bm.LineOrder = riloBottomToTop then
            //    Bmp.Bm.VerticalFlip;
	    {$ELSE}
		    Bmp.Bm.Width := J.Width;
		    Bmp.Bm.Height := J.Height;
		    Bmp.Bm.PixelFormat := pf32bit;
		    Bmp.Bm.Assign(J);
	    {$ENDIF}
	    B_ref := Bmp.Tag_bitmap_object_;
	    B := C_Bitmap(B_ref.Obj);
	    B.F_Width := Bmp.Bm.Width;
	    B.F_Height := Bmp.Bm.Height;
	    RESULT := (B.F_Width > 0) and (B.F_Height > 0);
	    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    END;
    finally
    	J.Free;
    	MS.Free;
    end;
    {$ENDIF}
//.
end;

function Do_get_png_from_stream_ex(
X_A: DynAByte; X_B: Integer; X_Div: Integer): Boolean;
//?{Png}
{$IFDEF FPC}
var B: TBitmap_Ex;
    B_ref: Ref_obj;
    CB: C_Bitmap;
    P: TPicture;
var	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
{$ELSE}
	{$IFDEF PngObject}
	var	p_o: TPngObject;
	MS: TMemoryStream;
	i: Integer;
	buf: Byte;
	B: TBitmap_Ex;
	{$ENDIF}
{$ENDIF}
{$IFDEF BGRABITMAP}
	r: TBGRAReaderPNG;
	tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Png}
{$IFDEF FPC}
	MS := TMemoryStream.Create();
	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;

    P := TPicture.Create;
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFDEF BGRABITMAP}
        //writeln('loading png !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' +
        //    'MS.Size=' + IntToStr(MS.Size));
    	r := TBGRAReaderPNG.Create;
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    			B.Bm.Free;
				B.Bm := TBGRABitmap.Create;
				B.Bm.LoadFromStream(MS, r);
        //writeln('LOADED with BGRABitmap_CANVAS:' +
        //IntToStr(B.Bm.Width) + ' x ' + IntToStr(B.Bm.Height));
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(MS, r);
        //writeln('LOADED without BGRABitmap_CANVAS:' +
        //    IntToStr(tmp.Width) + ' x ' + IntToStr(tmp.Height));
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	B.Bm.Canvas.FillRect(
		    		Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
        //writeln('LOADED png !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  ' +
        //    IntToStr(CB.F_Width) + ' x ' + IntToStr(CB.F_Height));
    	finally
    		r.Free;
    	end;
    {$ELSE}
    try
        TRY
        //writeln('loading png ' + X_Path
        //+ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
        P.LoadFromStream(MS);
        //writeln('loaded png ' + X_Path + ': WxH = ' + IntToStr(P.Width) + 'x' +
        //    IntToStr(P.Height) + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
        	
	    if (P.Width > 0) and (P.Height > 0) then
	    begin
		    B.Bm.Width := P.Width;
	    	B.Bm.Height := P.Height;
	    	B.Bm.PixelFormat := pf32bit;
	    	B.Bm.Canvas.Brush.Color := clWhite;
	    	B.Bm.Canvas.FillRect(Classes.Rect(0, 0, P.Width, P.Height));
	    	B.Bm.Canvas.Draw(0, 0, P.Graphic);
	    	B.Bm.Canvas.Changed;
	    end; 
        B_ref := B.Tag_bitmap_object_;
        CB := C_Bitmap(B_ref.Obj);
        CB.F_Width := B.Bm.Width;
        CB.F_Height := B.Bm.Height;
        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
        EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
        END;
    finally
        P.Free;
        MS.Free;
    end;
    {$ENDIF}
{$ELSE} //////////////////////////////////////////// Delphi --> via TPngObject
	{$IFDEF PngObject}
		p_o := TPngObject.Create();
		MS := TMemoryStream.Create();
		try
			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;
			p_o.LoadFromStream(MS);
			RESULT := (p_o.Width > 0) and (p_o.Height > 0);
			if RESULT then
			begin
			    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
					B := TBitmap_ex(All_bitmaps[X_B]);
				{$ELSE}
			    	B := TBitmap_Ex(X_B);
			    {$ENDIF}
		    	B.Bm.Assign(p_o);
		    end;
		finally
			MS.Free;
			p_o.Free;
		end;
	{$ENDIF}
{$ENDIF}
//.
end;

(*
/*

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

function Do_get_pcx_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Pcx}
{$IFDEF BGRABITMAP}
var S: TStream;
	r: TBGRAReaderPCX;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Pcx}
    {$IFDEF BGRABITMAP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderPCX.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(S, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	//B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//B.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
//.
end;

(*
/*

FUN Get_psd_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	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 BGRABITMAP}
var S: TStream;
	r: TBGRAReaderPSD;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Psd}
    {$IFDEF BGRABITMAP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderPSD.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(S, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//B.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
//.
end;


(*
/*

FUN Get_tga_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	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 BGRABITMAP}
var S: TStream;
	r: TBGRAReaderTarga;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Tga}
    {$IFDEF BGRABITMAP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderTarga.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(S, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	//B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//B.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
//.
end;


(*
/*
FUN Get_tiff_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	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;
//?{Tif}
{$IFDEF BGRABITMAP}
var S: TStream;
	r: TBGRAReaderTiff;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Tif}
    {$IFDEF BGRABITMAP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderTiff.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(MS, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	B.Bm.Canvas.Draw(0, 0, tmp);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
//.
end;


(*
/*

FUN Get_webp_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL, NATIVE :
	NATIVE @
    "     RESULT := Do_get_webp_from_stream(X_Source, X_B);" .
    
FUN Save_to_stream_webp(INT B|itmap_handle,
{Stream} S|tream_dest, INT Q|uality_compression, BOOL Lossless) ==> BOOL,
NATIVE :
    "     RESULT := Do_Save_to_stream_webp(X_B, X_S, X_Q, X_Lossless);" .
    
*/
*)

function Do_get_webp_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{WebP}
{$IFDEF BGRABITMAP}
{$IFnDEF NO_WEBP}
var S: TStream;
	r: TBGRAReaderWebp;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{WebP}
    {$IFDEF BGRABITMAP}
    {$IFnDEF NO_WEBP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderWebp.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(S, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//B.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
    {$ENDIF}
//.
end;

function Do_Save_to_stream_webp(
	X_B: Integer; X_S: Ref_obj; X_Quality: Integer; X_Lossless: Boolean)
	: Boolean;
//?{WebP}
{$IFDEF BGRABITMAP}
{$IFDEF BGRABITMAP_CANVAS}
	{$IFnDEF NO_WEBP}
	var WebP: TBGRAWriterWebp; 
		Bmp: TBitmap_Ex;
	var	S: TStream;
	{$ENDIF}
{$ENDIF}
{$ENDIF}
//.
begin
    Result := FALSE;
//?{WebP}
{$IFDEF BGRABITMAP}
{$IFDEF BGRABITMAP_CANVAS}
	{$IFnDEF NO_WEBP}
		{$IFDEF USE_LISTS_OF_DESCRIPTORS}
			Bmp := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	Bmp := TBitmap_Ex(X_B);
	    {$ENDIF}
	    {$IFDEF BGRABITMAP}
	    S := Stream_from_C_Stream(C_Stream(X_S.Obj));
		WebP := TBGRAWriterWebp.Create;
		try
			WebP.QualityPercent := X_Quality;
			WebP.Lossless := X_Lossless;
			Bmp.Bm.SaveToStream(S, WebP);
			Result := TRUE;
		finally
			WebP.Free;
			S.Free;
		end;
	    {$ENDIF}
	{$ENDIF}
{$ENDIF}
{$ENDIF}
//.
end;

(*
/*

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

function Do_get_xpm_from_stream(
X_S: Ref_obj; X_B: Integer): Boolean;
//?{Xpm}
{$IFDEF BGRABITMAP}
var S: TStream;
	r: TBGRAReaderXpm;
	B: TBitmap_Ex;
	B_ref: Ref_obj;
    CB: C_Bitmap;
    tmp: TBGRABitmap;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Xpm}
    {$IFDEF BGRABITMAP}
	    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
    	r := TBGRAReaderXpm.Create;
    	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
    	try
    		{$IFDEF BGRABITMAP_CANVAS}
    		B.Bm.Free;
			B.Bm := TBGRABitmap.Create;
			B.Bm.LoadFromStream(S, r);
			{$ELSE}
				tmp := TBGRABitmap.Create;
				tmp.LoadFromStream(S, r);
				try
				B.Bm.Width := tmp.Width;
		    	B.Bm.Height := tmp.Height;
		    	B.Bm.PixelFormat := pf32bit;
		    	B.Bm.Canvas.Brush.Color := clWhite;
		    	B.Bm.Canvas.FillRect(Classes.Rect(0, 0, tmp.Width, tmp.Height));
		    	//B.Bm.Canvas.Draw(0, 0, tmp);
		    	tmp.Draw(B.Bm.Canvas, 0, 0);
		    	B.Bm.Canvas.Changed;
		    	finally	
		    	tmp.Free;
		    	end;
			{$ENDIF}
	        B_ref := B.Tag_bitmap_object_;
	        CB := C_Bitmap(B_ref.Obj);
	        CB.F_Width := B.Bm.Width;
	        CB.F_Height := B.Bm.Height;
	        RESULT := (CB.F_Width > 0) and (CB.F_Height > 0);
    	finally
    		r.Free;
    		S.Free;
    	end;
    {$ENDIF}
//.
end;

(*
/*

FUN Get_pcd_from_stream(
{Stream} Source|_stream, INT B|itmap_handle) ==> BOOL : .

// 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_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_bitmap_bmp(INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap(X_B, X_Path);" .
	
FUN Save_bitmap_gif(INT B|itmap_handle,
STR Path|_image_file) ==> BOOL
	:
	{Memory_stream_contig} s|tream_temp = {Memory_stream_contig}
	RESULT = Save_to_stream_gif(B, s)
	CASE !RESULT ? ==> ;
	s.Allocate(s.Position.To_int)
	s.Set_position(0.To_long, 'BEGINNING')
	{File_stream} f|ile_stream_temp =  Write_file_stream(Path, FALSE)
	f.Copy_stream(s)
	RESULT = Path.Exists .
    
FUN Save_to_stream_gif(INT B|itmap_handle,
{Stream} S|tream_dest) ==> BOOL, NATIVE :
	"RESULT := Do_save_to_stream_gif(X_B, X_S);" .
	
*/
*)

function Do_Save_to_stream_gif(
	X_B: Integer; X_S: Ref_obj) : Boolean;
//?{Gif}
{$IFDEF RXGIF}
var Gif: TGifImage; 
	Bmp: TBitmap_Ex;
	var	S: TStream;
{$ENDIF}
//.
begin
    Result := FALSE;
//?{Gif}
{$IFDEF RXGIF}
    S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    Gif := TGifImage.Create;
    try
    	Gif.Assign(Bmp.Bm);
    	Gif.SaveToStream(S);
    	////Bmp.Bm.SaveToFile('bmp_to_gif.bmp');
    	RESULT := TRUE;
    finally
    	Gif.Free;
    end;
{$ENDIF}
//.
end;


(*
/*

FUN Save_to_stream_png(INT B|itmap_handle,
{Stream} S|tream_dest, INT Q|uality_compression) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_to_stream_png(X_B, X_S, X_Q);" .
    
FUN Save_bitmap_png(INT B|itmap_handle,
    STR Path|_image_file) ==> BOOL, NATIVE :
    "     RESULT := Do_Save_bitmap_png(X_B, X_Path);" .
    
FUN Can_load_bitmap_fmt(
		STR Format|_BMP_JPG_PNG_GIF) ==> BOOL, NATIVE:
	"	RESULT := Do_Can_load_bitmap_fmt(X_Format);" .
	
FUN Can_save_bitmap_fmt(
		STR Format|_BMP_JPG_PNG_GIF) ==> BOOL, NATIVE:
	"	RESULT := Do_Can_save_bitmap_fmt(X_Format);" .
	
*/
*)

function Do_Save_to_stream_bmp(
X_B: Integer; X_S: Ref_obj): Boolean;
//?{Bmp}
var S: TNATIVE_Stream_on_C_Stream;
var Bmp: TBitmap_Ex;
{$IFDEF BGRABITMAP}
	//w: TBGRAWriterBmp;
{$ENDIF}
//.
begin
	RESULT := FALSE;
//?{Bmp}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    if Bmp = nil then Exit;
	S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	try
		{$IFDEF BGRABITMAP_CANVAS}
			//w := TBGRAWriterBmp.Create;
			try
				Bmp.Bm.SaveToStream(S, nil);
			finally
				//w.Free;
			end;
		{$ELSE}
			Bmp.Bm.SaveToStream(S);
		{$ENDIF}	
		RESULT := TRUE; 
	finally
		S.Free;
	end;
//.
end;

function Do_Save_bitmap(
X_B: Integer; const X_Path: String): Boolean;
//?{Bmp}
var Bmp: TBitmap_Ex;
//.
begin
	RESULT := FALSE;
//?{Bmp}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    if Bmp = nil then Exit;
    TRY
    	Bmp.Bm.SaveToFile(X_Path);
    	{$IFnDEF BGRABITMAP}
	    if Assigned(Bmp.AlphaChannel) then
	        Bmp.AlphaChannel.SaveToFile(X_Path + '.alpha.bmp');
	    {$ENDIF}
    	Result := FileExists(X_Path);
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    END;
//.
end;

function Do_Save_bitmap_jpg(
X_B: Integer; const X_Path: String; X_Quality: Integer): Boolean;
//?{Jpeg}
var Bmp: TBitmap_Ex;
	jpg: TJpegImage;
//.
begin
	Result := FALSE;
//?{Jpeg}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    TRY
		jpg := TJpegImage.Create;
		try
			{$IFDEF FPC}
				Bmp.Bm.Canvas.Changed;
			{$ENDIF}
			jpg.Assign(Bmp.Bm);
        //WriteLn('jpg assigned: ' + IntToStr(jpg.Width) +
        //'x' + IntToStr(jpg.Height) );
			{$IFDEF FPC}
			jpg.CompressionQuality := X_Quality;
			{$ENDIF}
			jpg.SaveToFile(X_Path);
        //WriteLn('jpg saved: ' + IntToStr(jpg.Width) +
        //'x' + IntToStr(jpg.Height) );
		finally
			jpg.Free;
		end;
    	Result := FileExists(X_Path);
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    END;
//.
end;

function Do_Save_to_stream_jpg(
X_B: Integer; X_Stream: Ref_obj; X_Quality: Integer): Boolean;
//?{Jpeg}
var Bmp: TBitmap_Ex;
	jpg: TJpegImage;
	S: TStream;
//.
begin
	Result := FALSE;
//?{Jpeg}
    S := Stream_from_C_Stream(C_Stream(X_Stream.Obj));
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    try
	    TRY
			jpg := TJpegImage.Create;
			try
				{$IFDEF FPC}
					Bmp.Bm.Canvas.Changed;
				{$ENDIF}
				jpg.Assign(Bmp.Bm);
	        //WriteLn('jpg assigned: ' + IntToStr(jpg.Width) +
	        //'x' + IntToStr(jpg.Height) );
				{$IFDEF FPC}
				jpg.CompressionQuality := X_Quality;
				{$ELSE}
				jpg.CompressionQuality := X_Quality;
				{$ENDIF}
				jpg.SaveToStream(S);
	        //WriteLn('jpg saved: ' + IntToStr(jpg.Width) +
	        //'x' + IntToStr(jpg.Height) );
			finally
				jpg.Free;
			end;
	    	Result := TRUE;
	    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
	    END;
    finally
    	S.Free;
    end;
//.
end;

function Do_Save_to_stream_png(
X_B: Integer; X_S: Ref_obj; X_Quality: Integer): Boolean;
//?{Png}
{$IFDEF BGRABITMAP_CANVAS}
var WPng: TBGRAWriterPng; 
	Bmp: TBitmap_Ex;
{$ELSE}
	{$IFDEF FPC}
	var P: TPortableNetworkGraphic;
		Bmp: TBitmap_Ex;
		LII, LII2, LII3: TLazIntfImage;
		Dest: TBitmap;
		y, x: Integer;
		Row1, Row2: PRGBQuad;
		Row3: PRGBQuad;
		dx1, dx2: Integer;
	{$ENDIF}
{$ENDIF}
var	S: TStream;
//.
begin
    Result := FALSE;
//?{Png}
{$IFDEF FPC}
    S := Stream_from_C_Stream(C_Stream(X_S.Obj));
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFDEF BGRABITMAP_CANVAS}
    	WPng := TBGRAWriterPng.Create;
    	try
    		Bmp.Bm.SaveToStream(S, WPng);
    		RESULT := true;
    	finally
    		WPng.Free;
    	end;
    {$ELSE}
    TRY
    	LII := Bmp.Bm.CreateIntfImage;
    	LII3 := LII;
    	LII2 := nil;
    	Dest := nil;
    	if Bmp.AlphaChannel <> nil then
    	begin
    		LII2 := Bmp.AlphaChannel.CreateIntfImage;
    		if (LII.Width = LII2.Width) and (LII.Height = LII2.Height) and 
    			(Bmp.Bm.PixelFormat in [pf32bit, pf24bit]) then
    		begin
    			Dest := TBitmap.Create;
    			Dest.Width := LII.Width;
    			Dest.Height := LII.Height;
    			Dest.PixelFormat := pf32bit;
    			LII3 := Dest.CreateIntfImage;
    			dx1 := 4;
    			if Bmp.Bm.PixelFormat = pf24bit then dx1 := 3;
    			dx2 := 4;
    			if Bmp.AlphaChannel.PixelFormat = pf24bit then dx2 := 3;
	    		for y := 0 to LII.Height-1 do
	    		begin
	    			Row1 := LII.GetDataLineStart(y);
	    			Row2 := LII2.GetDataLineStart(y);
	    			Row3 := LII3.GetDataLineStart(y);
	    			for x := 0 to LII.Width-1 do
	    			begin
	    				Row3^.rgbRed := Row1^.rgbRed;
	    				Row3^.rgbGreen := Row1^.rgbGreen;
	    				Row3^.rgbBlue := Row1^.rgbBlue;
	    				Row3^.rgbReserved := 
	    					{$IFDEF LINUX} Row2^.rgbBlue
	    					{$ELSE} Row2^.rgbRed
	    					{$ENDIF} ;
	    				Row1 := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}
	    						(Row1) + dx1);
	    				Row2 := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}
	    						(Row2) + dx2);
	    				inc(Row3);
	    			end;
	    		end;
    		end;
    	end;
		P := TPortableNetworkGraphic.Create;
		try
			//P.Assign(Bmp);
			P.LoadFromIntfImage(LII3);
			P.SaveToStream(S); 
				// works OK in Windows, does not work correctly in Linux ?
		finally
			P.Free;
			if LII3 <> LII then LII3.Free;
			LII.Free;
			LII2.Free;
			Dest.Free;
		end;
    	Result := TRUE;
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    END;
    {$ENDIF}
//todo: {$ELSEIF DEFINED(FMX)}
{$ENDIF}
//.
end;

function Do_Save_bitmap_png(
X_B: Integer; const X_Path: String): Boolean;
//?{Png}
{$IFDEF BGRABITMAP_CANVAS}
var WPng: TBGRAWriterPng; 
	Bmp: TBitmap_Ex;
{$ELSE}
	{$IFDEF FPC}
	var P: TPortableNetworkGraphic;
		Bmp: TBitmap_Ex;
		LII, LII2, LII3: TLazIntfImage;
		Dest: TBitmap;
		y, x: Integer;
		Row1, Row2: PRGBQuad;
		Row3: PRGBQuad;
		dx1, dx2: Integer;
	{$ENDIF}
{$ENDIF}
//.
begin
    Result := FALSE;
//?{Png}
{$IFDEF FPC}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFDEF BGRABITMAP_CANVAS}
    	WPng := TBGRAWriterPng.Create;
    	try
    		Bmp.Bm.SaveToFileUTF8(X_Path, WPng);
    		Result := true;
    	finally
    		WPng.Free;
    	end;
    {$ELSE}
    TRY
    	LII := Bmp.Bm.CreateIntfImage;
    	LII3 := LII;
    	LII2 := nil;
    	Dest := nil;
    	if Bmp.AlphaChannel <> nil then
    	begin
    		LII2 := Bmp.AlphaChannel.CreateIntfImage;
    		if (LII.Width = LII2.Width) and (LII.Height = LII2.Height) and 
    			(Bmp.Bm.PixelFormat in [pf32bit, pf24bit]) then
    		begin
    			Dest := TBitmap.Create;
    			Dest.Width := LII.Width;
    			Dest.Height := LII.Height;
    			Dest.PixelFormat := pf32bit;
    			LII3 := Dest.CreateIntfImage;
    			dx1 := 4;
    			if Bmp.Bm.PixelFormat = pf24bit then dx1 := 3;
    			dx2 := 4;
    			if Bmp.AlphaChannel.PixelFormat = pf24bit then dx2 := 3;
	    		for y := 0 to LII.Height-1 do
	    		begin
	    			Row1 := LII.GetDataLineStart(y);
	    			Row2 := LII2.GetDataLineStart(y);
	    			Row3 := LII3.GetDataLineStart(y);
	    			for x := 0 to LII.Width-1 do
	    			begin
	    				Row3^.rgbRed := Row1^.rgbRed;
	    				Row3^.rgbGreen := Row1^.rgbGreen;
	    				Row3^.rgbBlue := Row1^.rgbBlue;
	    				Row3^.rgbReserved := 
	    					{$IFDEF LINUX} Row2^.rgbBlue
	    					{$ELSE} Row2^.rgbRed
	    					{$ENDIF} ;
	    				Row1 := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}
	    						(Row1) + dx1);
	    				Row2 := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}
	    						(Row2) + dx2);
	    				inc(Row3);
	    			end;
	    		end;
    		end;
    	end;
		P := TPortableNetworkGraphic.Create;
		try
			P.LoadFromIntfImage(LII3);
			P.SaveToFile(X_Path); 
				// works OK in Windows, does not work correctly in Linux ?
		finally
			P.Free;
			if LII3 <> LII then LII3.Free;
			LII.Free;
			LII2.Free;
			Dest.Free;
		end;
    	Result := FileExists(X_Path);
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    END;
    {$ENDIF}
{$ENDIF}
//.
end;

function Do_Can_load_bitmap_fmt(const X_Format: String): Boolean;
begin
	Result := FALSE;
//?{Bmp} 
	Result := Result or(X_Format = 'BMP');
//. 
//?{Jpeg}
	Result := Result or(X_Format = 'JPG');
//.
//?{Icon}
	{$IFDEF LINUX}
	{$ELSE}
	Result := Result or(X_Format = 'ICO') or (X_Format = 'CUR');
	{$ENDIF}
//.
//?{Gif}
	Result := Result or(X_Format = 'GIF');
//.
{$IFDEF FPC}
	{$IFDEF BGRABITMAP}
//?{Png}
		Result := Result or(X_Format = 'PNG');
//.
//?{Pcx}
		Result := Result or(X_Format = 'PCX');
//.
//?{Psd}
	{$IFDEF BGRABITMAP}
		Result := Result or(X_Format = 'PSD');
	{$ENDIF}
//.
//?{Tga}
		Result := Result or(X_Format = 'TGA');
//.
//?{Tiff}
		Result := Result or(X_Format = 'TIF');
		Result := Result or(X_Format = 'TIFF');
//.
//?{WebP}
		{$IFNDEF NO_WEBP}
		Result := Result or(X_Format = 'WEBP');
		{$ENDIF}
//.
//?{Xpm}
		Result := Result or(X_Format = 'XPM');
//.
	{$ENDIF}
{$ELSE}
//?{Gif}
		Result := Result or(X_Format = 'GIF');
//.
{$ENDIF}
end;

function Do_Can_save_bitmap_fmt(const X_Format: String): Boolean;
begin
	Result := FALSE;
//?{Bmp} 
 	Result := Result or(X_Format = 'BMP');
//.
//?{Jpeg}
	Result := Result or(X_Format = 'JPG');
//.
		{$IFDEF FPC}
//?{Png} 
	Result := Result or(X_Format = 'PNG');
//.
		{$ENDIF}
		{$IFDEF BGRABITMAP}
//?{WebP}
	Result := Result or(X_Format = 'WEBP');
//.
		{$ENDIF}
//?{Gif}
	{$IFDEF RXGIF}
	{$IFNDEF FPC}
	Result := Result or (X_Format = 'GIF');
	{$ENDIF}
	{$ENDIF}
//.
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: TBitmap_Ex;
	q: TRGBQuad;
	y1, x1, i1, dx1, y2, x2, dy2, dx2, line_start2: Integer;
	from, to_: PRGBQuad;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Dst := TBitmap_ex(All_bitmaps[X_Target]);
		Src := TBitmap_ex(All_bitmaps[X_Source]);
	{$ELSE}
    	Dst := TBitmap_Ex(X_Target);
    	Src := TBitmap_Ex(X_Source);
    {$ENDIF}
    y2 := 0;
    x2 := 0;
    dx1 := 4;
    {$IFDEF BGRABITMAP}
    	dx1 := 4;
    	dx2 := 4;
    {$ELSE}
	    case Src.Bm.PixelFormat of
	    pf32bit: dx1 := 4;
	    pf24bit: dx1 := 3;
	    else Exit;
	    end;
	    case Dst.Bm.PixelFormat of
	    pf32bit: dx2 := 4;
	    pf24bit: dx2 := 3;
	    else Exit;
	    end;
    {$ENDIF}
    line_start2 := 0;
    dy2 := 1;
    case X_Angle of
    0:  begin
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bm.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bm.Height-1;
				dy2 := -1;
			end;
    	end;
    90: begin
    		x2 := (Dst.Bm.Width-1) * dx2;
    		dx2 := -dx2;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bm.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bm.Height-1-y2;
				dy2 := -dy2;
			end;
    	end;
    180: begin
    		line_start2 := Dst.Bm.Height-1;
    		dy2 := -1;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bm.Width-1-line_start2) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bm.Height-1-y2;
				dy2 := -dy2;
			end;
    	 end;
    270: begin
    		line_start2 := Dst.Bm.Height-1;
    		dy2 := -1;
			if Flip_w then 
			begin 
				line_start2 := (Dst.Bm.Width-1) * dx2;
				dx2 := -dx2;
			end;
			if Flip_h then
			begin 
				y2 := Dst.Bm.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.Bm.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
		    	to_ := PRGBQuad(Int64(Dst.Bm.ScanLine[y2]) + line_start2);
		    	for x1 := 0 to Src.Bm.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.Bm.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
		    	to_ := PRGBQuad(Int64(Dst.Bm.ScanLine[y2]) + line_start2);
		    	for x1 := 0 to Src.Bm.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.Bm.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
		    	y2 := line_start2;
		    	for x1 := 0 to Src.Bm.Width-1 do
		    	begin
		    		to_ := PRGBQuad(Int64(Dst.Bm.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.Bm.Height-1 do
		    begin
		    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
		    	y2 := line_start2;
		    	for x1 := 0 to Src.Bm.Width-1 do
		    	begin
		    		to_ := PRGBQuad(Int64(Dst.Bm.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: TBitmap_Ex;
	q: TRGBQuad;
	y1, x1, i1, dx1, y2, x2, dy2, dx2, line_start2: Integer;
	from, to_: PRGBQuad;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Dst := TBitmap_ex(All_bitmaps[X_Target]);
		Src := TBitmap_ex(All_bitmaps[X_Source]);
	{$ELSE}
    	Dst := TBitmap_Ex(X_Target);
    	Src := TBitmap_Ex(X_Source);
    {$ENDIF}
    y2 := 0;
    x2 := 0;
    dx1 := 4;
    {$IFDEF BGRABITMAP}
    	dx1 := 4;
    	dx2 := 4;
    {$ELSE}
	    case Src.Bm.PixelFormat of
	    pf32bit: dx1 := 4;
	    pf24bit: dx1 := 3;
	    else Exit;
	    end;
	    case Dst.Bm.PixelFormat of
	    pf32bit: dx2 := 4;
	    pf24bit: dx2 := 3;
	    else Exit;
	    end;
    {$ENDIF}
    if dx2 = 4 then
	    for y1 := 0 to Src.Bm.Height-1 do
	    begin
	    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
	    	to_ := PRGBQuad(Dst.Bm.ScanLine[y2]);
	    	for x1 := 0 to Src.Bm.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.Bm.Height-1 do
	    begin
	    	from := PRGBQuad(Src.Bm.ScanLine[y1]);
	    	to_ := PRGBQuad(Dst.Bm.ScanLine[y2]);
	    	for x1 := 0 to Src.Bm.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 Bmp: TBitmap_Ex;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[X_B]);
		All_bitmaps[X_B] := nil;
	{$ELSE}
    	Bmp := TBitmap_Ex(X_B);
    {$ENDIF}
    TRY
	    Bmp.Free;
    EXCEPT on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    END;
end;

constructor TBitmap_Ex.Create(w, h: Integer);
begin
	inherited Create;
//?{Canvas}
	CanvasObject_ := C_Canvas.None_obj_instance;
//.
//?{Bitmap}
	Tag_bitmap_object_ := C_Bitmap.None_obj_instance;
//.
	{$IFDEF BGRABITMAP_CANVAS}
		Bm := TBGRABitmap.Create(w, h, BGRABlack);
	{$ELSE}
		Bm := TBitmap.Create;
		Bm.Width := w;
		Bm.Height := h;
	{$ENDIF}
end;

destructor TBitmap_Ex.Destroy;
begin
	FreeAndNil(Bm);
	{$IFnDEF BGRABITMAP}
	FreeAndNil(AlphaChannel);
	{$ENDIF}
	FreeAndNil(Ico);
    if Assigned(LocalCopyPixels) then
        FreeMem(LocalCopyPixels);
//?{Gif}
	{$IFDEF RXGIF}
	FreeAndNil(Gif);
	{$ENDIF}
	FreeAndNil(Gif_buffer);
//.
    inherited;
end;

function UnitsToCoords(C: TCanvas; 
	C_Units: Integer; Value_units: Double): Integer;
var r: Double;
begin
	Result := 0;
	if (Value_units=INFINITY) or (Value_units=-INFINITY) then Exit;
	//r := InchesToPixels(C, 1);
	r := GetDeviceCaps(C.Handle, LOGPIXELSX);
    CASE C_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;

function UnitsFromCoords(C: TCanvas;
	C_Units: Integer; Value_pixels: Double): Double;
var r: Double;
begin
	Result := 0;
	if (Value_pixels=INFINITY) or (Value_pixels=-INFINITY) then Exit;
	//r := InchesToPixels(C, 1);
	r := GetDeviceCaps(C.Handle, LOGPIXELSX);
    CASE C_Units OF
    0: Result := Value_pixels * DPI_DEFAULT / r;
    1: Result := Value_pixels;
    2: Result := Value_pixels / r;
    3: Result := Value_pixels * 2.54 / r;
    //else Result := 0;
    END;
end;



procedure select_clip_rect(Canv: TCanvas; C_C: C_Canvas);
var CR: HRGN;
	C_Units, x, y: Integer;
	{$IFDEF LINUX}
	{$ELSE}
	M: TXForm;
	{$ENDIF}
	clip_x, clip_y, clip_w, clip_h: Double;
begin
	clip_w := {$IFDEF STRUCTUREASCLASS}
	  		  St_rect__C_Geometry(C_C.F_Clip.Obj).f_Width
			  {$ELSE} 
		      C_C.F_Clip.f_Width
		   	  {$ENDIF};
	clip_h := {$IFDEF STRUCTUREASCLASS}
	  		  St_rect__C_Geometry(C_C.F_Clip.Obj).f_Height
			  {$ELSE} 
		      C_C.F_Clip.f_Height
		   	  {$ENDIF};
		   	  
	clip_x := {$IFDEF STRUCTUREASCLASS}
			  St_point__C_Geometry(
				  St_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}
			  St_point__C_Geometry(
				  St_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_Units, clip_x);
	y := UnitsToCoords(Canv, C_Units, clip_y);
	
	{$IFDEF LINUX}
	{$ELSE}
	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;
	{$ENDIF}
	
	CR := CreateRectRgn(
		x,
		y,
		x + UnitsToCoords(Canv, C_Units,clip_w),
		y + UnitsToCoords(Canv, C_Units, clip_h));
	{$IFDEF LINUX}
	{$ELSE}
	OffsetRgn(CR, Round(M.eDx), Round(M.eDy));
	{$ENDIF}
	SelectClipRgn(Canv.Handle, CR);
	DeleteObject(CR);
end;

{$IFNDEF LINUX}
const MULT_DIRECTION = MWT_LEFTMULTIPLY;
{$ENDIF}
//{$define debug_draw}

function Get_canvas(
	R_C: Ref_obj; var C_Units: Integer 
	{$IFnDEF BGRABITMAP_CANVAS} ; var A: TCanvas {$ENDIF} ): TCanvas;
//? {Canvas}
var B: TBitmap_Ex;
    C_C: C_Canvas;
    C: C_Canvas;
    X_B: Integer;
    {$IFDEF DIRECT_DRAW_CANVAS}
    Contr: TControl;
    {$ENDIF}
    
    {$IFDEF debug_draw}
    //Xform: TXForm;
    CC: TCanvas;
    {$ENDIF}
//.
begin
    Result := nil;
//? {Canvas}
	C_C := C_Canvas(R_C.Obj);
	X_B := C_C.F_Handle;
	B := nil;
	{$IFDEF DIRECT_DRAW_CANVAS}
		{$IFnDEF BGRABitmap_CANVAS}
		A := nil;
		{$ENDIF}
		if not C_C.F_Control_.Obj.Is_NONE_object then
		begin
		   Contr := HackControl(
		   		C_Control(C_C.F_Control_.Obj).F_Handle);
		   if Contr is TScrolled_paintbox then
		   	   	  Result := TScrolled_paintbox(Contr).PBox.Canvas
		   else
			   if Contr is TGraphicControl then 
			   	  Result := THackGraphicControl(Contr).Canvas;
		end;
	if Result = nil then
	{$ENDIF}
	begin
		{$IFDEF USE_LISTS_OF_DESCRIPTORS}
			B := TBitmap_ex(All_bitmaps[X_B]);
		{$ELSE}
	    	B := TBitmap_Ex(X_B);
	    {$ENDIF}
	    if B = nil then Exit;
	    
	    {$IFDEF SUPPORT_PRINTER}
	    if B.Printer <> nil then
	    begin
	    	Result := B.Printer.Canvas;
	    end
	    else
	    {$ENDIF}
	    	Result := B.Bm.Canvas;
	end;
    
    C := C_Canvas(R_C.Obj);
    C_Units := C.F_Units;
    
    {$IFDEF SIMULATED_TRANSFORMS}
    {$ELSE}
	    if (GetGraphicsMode(Result.Handle) = GM_COMPATIBLE)
	    and (B <> nil)
	    and ((B.Matrix.eM11 <> 1) or (B.Matrix.eM12 <> 0) or
	    	 (B.Matrix.eM21 <> 0) or (B.Matrix.eM22 <> 1) or
	    	 (B.Matrix.eDx <> 0) or (B.Matrix.eDy <> 0))
	    and not((B.Matrix.eM11 = 0) and (B.Matrix.eM12 = 0) and
	    		(B.Matrix.eM21 = 0) and (B.Matrix.eM22 = 0) and
	    	 	(B.Matrix.eDx = 0) and (B.Matrix.eDy = 0))
	    then
	    begin
	    	SetGraphicsMode(Result.Handle, GM_ADVANCED);
	    	ModifyWorldTransform(Result.Handle, B.Matrix, MULT_DIRECTION);
	    end;
    {$ENDIF}
    
    {$IFDEF debug_draw}
    CC := Result;
    //if  GetGraphicsMode(CC.Handle) <> GM_COMPATIBLE then
    //    begin
    //        GetWorldTransform(CC.Handle, Xform);
    //        writeln('Get_canvas, matrix: m11=' + FloatToStr(Xform.eM11)
    //        + ' m12=' + FloatToStr(Xform.eM12)
    //        + ' m21=' + FloatToStr(Xform.eM21)
    //        + ' m22=' + FloatToStr(Xform.eM22)
    //        + ' Dx=' + FloatToStr(Xform.eDx)
    //        + ' Dy=' + FloatToStr(Xform.eDy));
    //    end;
    {$ENDIF}
    
    Result.Pen.Color := C.F_Foreground and $FFFFFF;
    Result.Pen.Width := Trunc(C.F_Pen_width);
    Result.Pen.Style := psSolid;
    if C.F_Pen_style = 1 then Result.Pen.Style := psClear;
    Result.Brush.Color := C.F_Background and $FFFFFF;
    Result.Brush.Style := TBrushStyle(C.F_Brush);
    
    {$IFDEF DIRECT_DRAW_CANVAS}
    if X_B = 0 then Exit;
    {$ENDIF}
    
    	{$IFDEF SUPPORT_PRINTER}
		if B.Printer = nil then
		{$ENDIF}
			select_clip_rect(Result, C);
	{$IFnDEF BGRABITMAP_CANVAS}
    A := nil;
    if (C.F_Alpha) and (B.Bm.PixelFormat = pf32bit) then
    begin
        if (B.AlphaChannel = nil) then 
        begin
            B.AlphaChannel := TBitmap.Create;
            B.AlphaChannel.Width := B.Bm.Width;
            B.AlphaChannel.Height := B.Bm.Height;
            B.AlphaChannel.PixelFormat := pf32bit;
        end;
        A := B.AlphaChannel.Canvas;
        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.Style := Result.Pen.Style;
        A.Pen.Width := Result.Pen.Width;
        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.Style := Result.Brush.Style;
    end
    else if B.AlphaChannel <> nil then
        FreeAndNil(B.AlphaChannel);
    {$ENDIF}
//.        
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, C_src "
	"		{$IFnDEF BGRABITMAP_CANVAS}, Adest, Asource {$ENDIF} : TCanvas;"
	"var U1, U2: Integer;"
	"Cdest := Get_canvas(X_Dest, U1 {$IFnDEF BGRABITMAP_CANVAS},"
	" 		  Adest {$ENDIF} );"
	"C_src := Get_canvas(X_Source, U2 {$IFnDEF BGRABITMAP_CANVAS},"
	"		  Asource {$ENDIF});"
	"Cdest.CopyRect({$IFDEF FPC} Classes. {$ENDIF} Rect("
	"		Trunc(X_X_dest),"
	"		Trunc(X_Y_dest),"
	"		Trunc(X_X_dest + X_W_dest),"
	"		Trunc(X_Y_dest + X_H_dest) ),"
	"	C_src, {$IFDEF FPC} Classes. {$ENDIF} Rect("
	"		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,
    REAL X|_destination_in_pixels,
    REAL Y|_destination_in_pixels,
    REAL W|idth_pixels,
    REAL H|eight_ixels), NATIVE
    :
    "   Do_draw_bitmap(X_B, X_D, X_X, X_Y, X_W, X_H);" .
*/
*)

{$IFDEF debug_draw}
var draw_count: Integer;
{$ENDIF}

procedure do_copy_rect(dest: TCanvas; r_dest: TRect; src: TCanvas; r_src: TRect);
begin
	dest.CopyRect(r_dest, src, r_src);
end;

//?{Gif}
	{$DEFINE GIF_USED}
//.

function XPixels_to_printer_points(Csrc, Cdst: TCanvas): Double;
begin
	RESULT := GetDeviceCaps(Cdst.Handle, LOGPIXELSX) 
			/ GetDeviceCaps(Csrc.Handle, LOGPIXELSX) ;
end;
    	 
function YPixels_to_printer_points(Csrc, Cdst: TCanvas): Double;
begin
	RESULT := GetDeviceCaps(Cdst.Handle, LOGPIXELSY) 
			/ GetDeviceCaps(Csrc.Handle, LOGPIXELSY) ;
end;
    	 
procedure Do_draw_bitmap(
	X_B: Integer; X_D: Ref_obj; X, Y, W, H: Double);
//?{Canvas}
var B: TBitmap_Ex;
    C_Units: Integer;
    C_D: C_Canvas;
    Cdst {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    Csrc: TCanvas;
    R: TRect;
    kX, kY: Double;
    {$IFDEF SIMULATED_TRANSFORMS}
    {$ELSE}
	    restore_X, restore_srcX: Boolean;
	    Xform, srcXform: TXForm;
    {$ENDIF}
    {$IFDEF BGRABITMAP}
	    D: TBitmap_Ex;
	    was_y: Double;
	    tmp_image: TBGRABitmap;
    {$ENDIF}
//.
{$IFDEF debug_draw}
var s: String;
	C_C: C_Canvas;
	BB: TBitmap_Ex;
{$ENDIF}
begin
//?{Canvas}
	if (X_B = 0) then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    
    Cdst := Get_canvas(X_D, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF} );
    if Cdst = nil then Exit;

    {$IFDEF SIMULATED_TRANSFORMS}
    {$ELSE}
	    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;
	    
	    restore_srcX := FALSE;
	    Csrc := nil;
	    if B.Bm <> nil then 
	    begin
		    Csrc := B.Bm.Canvas;
		    //if true then B.Bm.SaveToFile('test.jpg');
		    
            if  GetGraphicsMode(Csrc.Handle) <> GM_COMPATIBLE then
            begin
                restore_srcX := TRUE;
                GetWorldTransform(Csrc.Handle, srcXform);
                ModifyWorldTransform(Csrc.Handle, srcXform, MWT_IDENTITY);
                SetGraphicsMode(Csrc.Handle, GM_COMPATIBLE);
            end;
	    end;
    {$ENDIF}
    
    if  (B.Bm.Width = W) and (B.Bm.Height = H)
		{$IFDEF RXGIF}
    	and (B.Gif = nil)
    	{$ENDIF}
    then
    begin
    //write(' . ');
    	{$IFDEF BGRABITMAP_CANVAS} 
    	B.Bm.Draw(Cdst, Round(X), Round(Y), true);
    	{$ELSE}
        Cdst.Draw(Round(X), Round(Y),B.Bm);
        {$ENDIF}
    end
    else
    begin
    //writeln(':' + IntToStr(B.Bm.Width) + '<>' + IntToStr(W) +
    //      ' ' + IntToStr(B.Bm.Height) + '<>' + IntToStr(H));
	    C_D := C_Canvas(X_D.Obj);
	    R.Left := Round(X);
	    R.Top := Round(Y);
	    R.Right := Round(X + W);
	    R.Bottom := Round(Y + H);
	    {$IFDEF debug_draw} s := ''; {$ENDIF}
	    
	    if (C_D.F_printer_handle <> 0) then
	    begin
	    	kX := XPixels_to_printer_points(Csrc, Cdst);
	    	kY := YPixels_to_printer_points(Csrc, Cdst);
	    	R.Left := Round(X * kX);
	    	R.Top := Round(Y * kY);
	    	R.Right := Round(R.Left + W * kX);
	    	R.Bottom := Round(R.Top + H * kY);
	    end;
	    
	    if C_D.F_Quality <= 1 then
	    begin
	    	//SetStretchBltMode(Cdst.Handle, HALFTONE);
	    	{$IFnDEF Linux}
	    	SetBrushOrgEx(Cdst.Handle, 0, 0, nil);
	    	{$ENDIF}
	    end;
	    
	    if B.Ico <> nil then
	    	Cdst.StretchDraw(R, B.Ico)
		{$IFDEF GIF_USED}
		else if B.Gif_buffer <> nil then
		begin
			{$IFDEF BGRABITMAP}
	            //writeln('Gif_buffer ' +
	            //    IntToStr(Integer(B.Gif_buffer.LineOrder = riloTopToBottom)));
	////////////////////////////////////////////////////////////////////////////				
	            BGRABitmapDraw(Cdst, R, B.Gif_buffer.Data, 
	            	B.Gif_buffer.LineOrder = riloTopToBottom,
	                B.Gif_buffer.Width, B.Gif_buffer.Height, FALSE);
			{$ELSE}
	    		Cdst.StretchDraw(R, B.Gif_buffer);
			{$ENDIF}
			{$IFDEF debug_draw} s := '(gif_buffer)'; {$ENDIF}
		end
			{$IFDEF RXGIF}
			    else if B.Gif <> nil then
			    begin
			        //writeln('gif');
			    	Cdst.StretchDraw(R, B.Gif);
			    	{$IFDEF debug_draw} s := '(gif)'; {$ENDIF}
			    end
		    {$ENDIF RXGIF}
		{$ENDIF GIF_USED}
	    else
	    begin
	    	{$IFDEF BGRABITMAP_CANVAS}
	            //writeln('Bm ' +
	            //    IntToStr(Integer(B.Bm.LineOrder = riloTopToBottom)));
	/////////////////////////////////////////////////////////////////////	
				if (R.Right-R.Left=B.Bm.Width)and(R.Bottom-R.Top=B.Bm.Height) then			
		            BGRABitmapDraw(Cdst, R, B.Bm.Data, B.Bm.LineOrder = riloBottomToTop,
		                B.Bm.Width, B.Bm.Height, FALSE)
				else
				begin
					tmp_image := B.Bm.Resample(R.Right-R.Left, R.Bottom-R.Top) 
								 as TBGRABitmap;
					tmp_image.Draw(Cdst, R.Left, R.Top, True);
					tmp_image.Free;
				end;
	    	{$ELSE}
	    		do_copy_rect(Cdst, R, B.Bm.Canvas, {$IFDEF FPC}Bounds{$ELSE}Rect{$ENDIF}(
		     0, 0, B.Bm.Width, B.Bm.Height));
	    	{$ENDIF}
	    end;
	    {$IFDEF FPC}
	    {$IFNDEF LINUX}
	    Cdst.Changed();
	    {$ENDIF}
	    {$ENDIF}
	    	
	    {$IFnDEF BGRABITMAP}
	    if A <> nil then
	    begin
	    	A.Brush.Color := $FFFFFF;
	    	A.FillRect(R);
	    end;
	    {$ENDIF}
	end;
	            
	{$IFDEF SIMULATED_TRANSFORMS}
	{$ELSE}
		if restore_X then
		begin
		   SetGraphicsMode(Cdst.Handle, GM_ADVANCED);
		   ModifyWorldTransform(Cdst.Handle, XForm, MWT_LEFTMULTIPLY);
		end;
		if restore_srcX and (Csrc <> nil) then
		begin
			SetGraphicsMode(Csrc.Handle, GM_ADVANCED);
			ModifyWorldTransform(Csrc.Handle, srcXForm, MWT_LEFTMULTIPLY);
		end;
	{$ENDIF}
	
	{$IFDEF debug_draw}
		C_C := C_Canvas(X_D.Obj);
    	X_B := C_C.F_Handle;
    	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
    			BB := TBitmap_ex(All_bitmaps[X_B]);
    	{$ELSE}
    	    	BB := TBitmap_Ex(X_B);
    	{$ENDIF}
        //writeln('debug draw bitmap: ' + 'from_' + IntToStr(draw_count) + s
        //    + '.bmp');
	    if BB = nil then Exit;
	    if BB.Bm <> nil then
	    begin
	       inc(draw_count);
	       BB.Bm.SaveToFile('drawn' + IntToStr(draw_count) + '_' + 
	        'X_B=' + IntToStr(X_B) + ' ' +
	       	IntToStr(BB.Bm.Width) + 'x' + IntToStr(BB.Bm.Height) + '.bmp');
	       {$IFDEF GIF_USED}
	       {$IFDEF RXGIF}
	       if (B <> nil) and (B.Gif <> nil) then
	       	  B.Gif.SaveToFile('from_' + IntToStr(draw_count) + s + '.bmp')
	       else
	       {$ENDIF}
	       {$ENDIF} 
	       if (B <> nil) and (B.Bm <> nil) then
	       		B.Bm.SaveToFile('from_' + IntToStr(draw_count) + s + '.bmp');
	    end;
    {$ENDIF}
//.
end;

(*
/*

FUN Capture_screen_rectangle_to_bitmap(
	INT B|itmap_handle, REAL X|_coordinate, REAL Y|_coordinate), NATIVE :
@	"Do_Capture_screen(X_B, X_X, X_Y);" .
*/
*)

procedure Do_Capture_screen(X_B: Integer; X_X, X_Y: Double);
var DC: HDC;
var B: TBitmap_Ex;
	{$IFDEF FPC}
	SB: {$IFDEF BGRABITMAP} TBGRABitmap {$ELSE} TBitmap {$ENDIF};
	{$ENDIF}
	{$IFnDEF LINUX}
	H: THandle;
	{$ENDIF}
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    {$IFnDEF LINUX}
    H := B.Bm.Canvas.Handle;
    {$ENDIF}
    {$IFDEF FPC}
 	DC := {$IFDEF FPC} LCLIntf. {$ENDIF} 
 		{$IFDEF FPC} {$IFDEF LINUX} GetDC(0) 
 					 {$ELSE} GetDc(GetDeskTopWindow)
 					 {$ENDIF} 
 		{$ELSE} GetDC(0) {$ENDIF} ;
 	{$IFDEF FPC}
 	SB := {$IFDEF BGRABITMAP} TBGRABitmap 
 		  {$ELSE} TBitmap {$ENDIF}.Create;
 	{$ENDIF}
 	try
 	  {$IFDEF FPC}
 	  	{$IFDEF LINUX}
	 		SB.LoadFromDevice(DC);
	 		B.Bm.Canvas.CopyRect(Classes.Rect(0, 0, B.Bm.Width, B.Bm.Height),
	 			SB.Canvas,
	 			Classes.Rect(AL4_Form.Points(X_X), AL4_Form.Points(X_Y),
	 			AL4_Form.Points(X_X) + B.Bm.Width,
	 			AL4_Form.Points(X_Y) + B.Bm.Height));
 	  	{$ELSE}
 	  		BitBlt(H, 0, 0, B.Bm.Width, B.Bm.Height,
 	  		DC, {Screen.DesktopLeft +} AL4_Form.Points(X_X),
 	  			{Screen.DesktopTop +} AL4_Form.Points(X_Y),
 	  		SRCCOPY);
 		{$ENDIF}
 	  {$ELSE}
 	    BitBlt(H, 0, 0, B.Bm.Width, B.Bm.Height,
 		   DC, AL4_Form.Points(X_X), AL4_Form.Points(X_Y), SRCCOPY);
 	  {$ENDIF}
 	finally
 	  {$IFDEF FPC} LCLIntf. {$ENDIF} 
 	  
 	  {$IFDEF FPC} {$IFDEF LINUX} ReleaseDC(0, DC)
 	  			   {$ELSE} ReleaseDC(GetDeskTopWindow, DC)
 	  			   {$ENDIF} 
 	  {$ELSE} ReleaseDC(0, DC) {$ENDIF}
 	  ;
 	  
 	  {$IFDEF FPC} SB.Free; {$ENDIF}
 	end;
 	{$ELSE}
 		DC := GetDC(0);
 		BitBlt(H, 0, 0, B.Bm.Width, B.Bm.Height,
 		   DC, AL4_Form.Points(X_X), AL4_Form.Points(X_Y), SRCCOPY);
 		ReleaseDC(0, DC);
 	{$ENDIF}
end;

(*
/*

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: TBitmap_Ex;
    CF: DWORD;
    CB: C_Bitmap;
{$IFDEF BGRABITMAP}
	tmp: TBitmap;
{$ENDIF}
begin
  Result := FALSE;
  {$IFDEF USE_LISTS_OF_DESCRIPTORS}
	  B := TBitmap_ex(All_bitmaps[X_B]);
  {$ELSE}
      B := TBitmap_Ex(X_B);
  {$ENDIF}
  {$IFDEF FPC}
  	  {$IFDEF BGRABITMAP} tmp := nil; {$ENDIF}
  	  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfBitmap)) then
  	  begin
  	  	{$IFDEF BGRABITMAP}
  	  		tmp := TBitmap.Create;
  	  		tmp.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfBitmap));
  	  	{$ELSE}
  	  	B.Bm.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfBitmap));
  	  	{$ENDIF}
  	  end
  	  else
  	  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfPicture)) then
  	  begin
  	  	{$IFDEF BGRABITMAP}
  	  		tmp := TBitmap.Create;
  	  		tmp.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfPicture));
  	  	{$ELSE}
  	  	B.Bm.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfPicture));
  	  	{$ENDIF}
  	  end
  	  else
  	  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfPixmap)) then
  	  begin
  	  	{$IFDEF BGRABITMAP}
  	  		tmp := TBitmap.Create;
  	  		tmp.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfPixmap));
  	  	{$ELSE}
  	  	B.Bm.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfPixmap));
  	  	{$ENDIF}
  	  end;
  	  {$IFDEF BGRABITMAP_CANVAS}
  	  if tmp <> nil then
  	  begin
  	  	try
            B.Bm.Free;
            B.Bm := TBGRABitmap.Create(tmp.Width, tmp.Height);
            B.Bm.Canvas.Draw(0, 0, tmp);
  	  		//B.Bm.Assign(tmp);
            //B.Bm.Transparent := false;
            //B.Bm.TransparentColor := clNone;
  	  	finally
  	  		tmp.Free;
  	  	end;
  	  end;
  	  {$ENDIF}
  	  Result := not B.Bm.Empty;
  {$ELSE}
	  Clipboard.Open;
	  TRY
		  if IsClipboardFormatAvailable( CF_DIB ) then
		  begin
		  	 B.Bm.Assign(Clipboard);
		  	 //B.Bm.SaveToFile('test_from_clip.bmp');
		  	 Result := not B.Bm.Empty;
		  end;
	  FINALLY
	  	  Clipboard.Close;
	  END;
  {$ENDIF}
  if Result then
  begin
  	 CB := C_Bitmap(B.Tag_bitmap_object_.Obj);
  	 CB.F_Width := B.Bm.Width;
  	 CB.F_Height := B.Bm.Height;
  end;
end;

function Do_put_bitmap_to_clipboard(X_B: Integer): Boolean;
var B: TBitmap_Ex;
    CF: DWORD;
    CB: C_Bitmap;
    {$IFDEF BGRABITMAP}
    tmp: TBitmap;
    {$ENDIF}
begin
  Result := FALSE;
  {$IFDEF USE_LISTS_OF_DESCRIPTORS}
	  B := TBitmap_ex(All_bitmaps[X_B]);
  {$ELSE}
      B := TBitmap_Ex(X_B);
  {$ENDIF}
  try
  	{$IFDEF BGRABITMAP}
  		tmp := TBitmap.Create;
  		tmp.Width := 1;
  		tmp.Height := 1;
  		tmp.PixelFormat := pf32bit;
  		tmp.Width := B.Bm.Width;
  		tmp.Height := B.Bm.Height;
    	tmp.Canvas.CopyRect(Classes.Rect(0,0,tmp.Width,tmp.Height),
    		B.Bm.Canvas, Classes.Rect(0,0,tmp.Width,tmp.Height));
  		//////////////////////////////
        //B.Bm.SaveToFile('C:\AL-IV\Projects\Zoomer6\_Compiled_FPC\from_' +
        //    '.bmp');
        //tmp.SaveToFile('C:\AL-IV\Projects\Zoomer6\_Compiled_FPC\tmp_' +
        //    IntToStr(tmp.Width) + 'x' + IntToStr(tmp.Height) + '.bmp');
	       	
  		Clipboard.Assign(tmp);
  		tmp.Free;
  	{$ELSE}
  		Clipboard.Assign(B.Bm);
  	{$ENDIF}
  	RESULT := TRUE;
  except on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
  end;
end;


	

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


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

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 : @
"	X_coord.SetIntegers(0, Screen.DesktopLeft);"
"	X_coord.SetIntegers(1, Screen.DesktopTop);"
"	X_coord.SetIntegers(2, Screen.DesktopWidth);"
"	X_coord.SetIntegers(3, Screen.DesktopHeight);" .
	
	

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



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

FUN Load_icon_from_file(
	INT B|itmap_handle, STR Path|_icon)
	:
	CASE Path.Ext.Lower == ".cur" ?
	     Load_cursor_from_file(B, Path)
	ELSE //{File_stream} fs|tream_temp = Read_file_stream(Path)
		 //Load_icon_from_stream(B, fs)
		 Do_load_icon_from_file(B, Path)
	;
	//DEBUG: << "load icon from file " Path ", RESULT " icon_info(B) #NL ;
	.
	
//FUN icon_info(INT B|itmap_handle) ==> STR, NATIVE:
//@	"	RESULT := icon_info(X_B);" .

FUN Load_icon_from_stream(
	INT B|itmap_handle, {Stream} In|_stream),
    NATIVE({NATIVE_Stream_on_C_Stream},
    {Stream}, {Stream}.Set_pos, {Stream}.Size, {Stream}.Read_bytes) :
    "     Do_load_icon(X_B, X_In);" .
    
FUN Do_load_icon_from_file(
	INT B|itmap_handle, STR Path|_cursor_file),
    NATIVE : @
    "var s: TStream;"
    "	{$IFDEF linux}"
    "	  s := TFileStream.Create(X_Path, fmOpenRead);"
    "	  try"
    "		Do_load_icon_from_stream(X_B, s);"
    "	  finally"
    "		s.Free;"
    "	  end;"
    "	{$ELSE}"
    "     Do_load_icon_from_file(X_B, X_Path);" 
    "	{$ENDIF}" .
    
FUN Load_cursor_from_file(
	INT B|itmap_handle, STR Path|_cursor_file),
    NATIVE :
    "	{$IFDEF LINUX}"
    "	{$ELSE}"
    "     Do_load_cursor(X_B, X_Path);" 
    "	{$ENDIF}" .
    
*/
*)
procedure Do_load_icon(X_B: Integer; X_In: Ref_obj);
var CS: C_Stream;
    S: TStream;
begin
    CS := C_Stream(X_In.Obj);
    S := NATIVE_Stream_on_C_Stream.Stream_from_C_Stream(CS);
    try
    	Do_load_icon_from_stream(X_B, S);
    finally
    	s.Free;
    end;
end;

procedure Do_load_icon_from_stream(X_B: Integer; s: TStream);
var B: TBitmap_Ex;
    CB: C_Bitmap;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    if B.Ico = nil then B.Ico := TIcon.Create;
    try
        B.Ico.LoadFromStream(s);
        CB := C_Bitmap(B.Tag_bitmap_object_.Obj);
        CB.F_Width := B.Ico.Width;
        CB.F_Height := B.Ico.Height;
        {$IFDEF BGRABITMAP}
        	{$IFDEF BGRABITMAP_CANVAS}
	        B.Bm := TBGRABitmap.Create(B.Ico.Width, B.Ico.Height, BGRAWhite);
	        {$ELSE}
	        B.Bm := TBitmap.Create;
	        B.Bm.Width := B.Ico.Width;
			B.Bm.Height := B.Ico.Height;
			B.Bm.Canvas.Brush.Color := clWhite;
			B.Bm.Canvas.FillRect(Classes.Rect(0, 0, B.Bm.Width, B.Bm.Height));
	        {$ENDIF}
	        B.Bm.Canvas.Draw(0, 0, B.Ico);
	        B.Ico.Free;
	        {$IFDEF BGRABITMAP_CANVAS}
			if B.Bm.LineOrder = riloTopToBottom then B.Bm.VerticalFlip;	
			{$ENDIF}
        {$ENDIF}
    except on E: Exception do
    	   begin
    	   	  if E is AL4_Exception then raise;
              Any_exception(E);
    	   end;
    end;
end;

{$IFDEF linux}
{$ELSE}
procedure Do_load_icon_from_file(X_B: Integer; const X_Path: String);
var B: TBitmap_Ex;
    CS: C_Stream;
    CB: C_Bitmap;
    II: TIconInfo;
    Buf: Windows.Bitmap;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    if B.Ico = nil then B.Ico := TIcon.Create;
    try
        //B.Ico.LoadFromFile(X_Path);
        B.Ico.Handle := LoadImage(0, PChar(X_Path), IMAGE_ICON, 0, 0, LR_LOADFROMFILE);
        if B.Ico.Handle = 0 then Exit;
        GetIconInfo(B.Ico.Handle, II);
        try
        	FillChar(buf, Sizeof(Buf), 0);
        	GetObject(II.hbmColor, Sizeof(Buf), @Buf);
	        CB := C_Bitmap(B.Tag_bitmap_object_.Obj);
	        CB.F_Width := Buf.bmWidth;
	        CB.F_Height := Buf.bmHeight;
        finally
        	DeleteObject(II.hbmMask);
        	DeleteObject(II.hbmColor);
        end;
    except on E: Exception do
    	   begin
    	   	  if E is AL4_Exception then raise;
              Any_exception(E);
    	   end;
    end;
end;

procedure Do_load_cursor(X_B: Integer; const X_Path: String);
var B: TBitmap_Ex;
    CB: C_Bitmap;
    II: TIconInfo;
    Buf: Windows.Bitmap;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
    if B.Ico = nil then B.Ico := TIcon.Create;
    try
        B.Ico.Handle := LoadImage(0, PChar(X_Path), IMAGE_CURSOR, 0, 0, LR_LOADFROMFILE);
        if B.Ico.Handle = 0 then Exit;
        GetIconInfo(B.Ico.Handle, II);
        try
        	FillChar(buf, Sizeof(Buf), 0);
        	GetObject(II.hbmMask, Sizeof(Buf), @Buf);
	        CB := C_Bitmap(B.Tag_bitmap_object_.Obj);
	        CB.F_Width := Buf.bmWidth;
	        CB.F_Height := Buf.bmHeight;
        finally
        	DeleteObject(II.hbmMask);
        	DeleteObject(II.hbmColor);
        end;
    except on E: Exception do
    	   begin
    	   	  if E is AL4_Exception then raise;
              Any_exception(E);
    	   end;
    end;
end;
{$ENDIF}

function icon_info(X_B: Integer): String;
var B: TBitmap_Ex;
begin
	RESULT := 'X_B=' + IntToStr(X_B);
	if X_B = 0 then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[X_B]);
	{$ELSE}
    	B := TBitmap_Ex(X_B);
    {$ENDIF}
	if B.Ico = nil then
	begin
		RESULT := RESULT + ' Ico=nil';
		Exit;
	end;
	RESULT := RESULT + ' Ico.Size=' + IntToStr(B.Ico.Width) + 'x' +
		IntToStr(B.Ico.Height);
end;

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

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

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

procedure move_row_swap_RB(
	source: PRGBQuad;
	dest: PRGBQuad;
	count_quads: Integer);
var i: Integer;
begin
	for i := count_quads downto 1 do
	begin
		dest^ := source^;
		dest^.rgbBlue := source^.rgbRed;
		dest^.rgbRed := source^.rgbBlue;
		inc(source);
		inc(dest);
	end;
end;

procedure move_row24_swap_RB(
	source: PRGBQuad;
	dest: PRGBQuad;
	count_quads: Integer;
	src_delta: Integer;
	dst_delta: Integer);
var i: Integer;
begin
	for i := count_quads downto 1 do
	begin
		dest^.rgbBlue := source^.rgbRed;
		dest^.rgbGreen := source^.rgbGreen;
		dest^.rgbRed := source^.rgbBlue;
		source := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(source)
				+ src_delta);
		dest := PRGBQuad({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(dest)
				+ dst_delta);
	end;
end;

{$IFDEF BGRABitmap_CANVAS}
	{$DEFINE LOCK_DIRECT}
{$ENDIF}
{$IFDEF FPC}
	{$UNDEF LOCK_DIRECT}
    //{$IFDEF BGRABITMAP}
    //    {$DEFINE FPC_BGRABITMAP}
    //{$ELSE}
    //    {$DEFINE FPC_NO_BGRABITMAP}
    //{$ENDIF}
{$ENDIF}

procedure Do_LockBitmapPixels(
	X_B: Ref_obj; X_Y, X_H: Integer; X_Read: Boolean);
//? {Bitmap_direct}
var B: TBitmap_Ex;
	D: C_Bitmap_direct;
{$IFDEF LOCK_DIRECT}
var w: Integer; ww: Int64;
{$ELSE}
	{$IFDEF FPC}
	var B_bm: TBitmap;
	var ii: TLazIntfImage;
		dd: TRawImageDescription;
		x, y, dy, bits_per_pixel, i: Integer;
		Pixels, DestPixels: PByte;
		color4: DWORD;
	    gshift, rshift, bshift, ashift: Integer;
	{$ELSE}
	var bits_per_pixel, src_bits_per_pixel: Integer;
	    Pixels: PByte;
	    s0, s1: Int64;
	    y, x, row_start_to: Integer;
	    curr_scan: PByte;
	{$ENDIF}
{$ENDIF}
//{$IFDEF FPC_NO_BGRABITMAP}
//{$ENDIF}
//.
begin
//? {Bitmap_direct}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[C_Bitmap_direct(X_B.Obj).F_Handle]);
	{$ELSE}
    	B := TBitmap_Ex(C_Bitmap_direct(X_B.Obj).F_Handle);
    {$ENDIF}
    D := C_Bitmap_direct(Ref_obj(B.Tag_bitmap_object_).Obj);
{$IFDEF LOCK_DIRECT}
	w := B.Bm.Width * 4;
	if B.Bm.Height > 1 then
	begin
		ww := Int64(B.Bm.ScanLine[1]);
		w := ww - Int64(Pointer(B.Bm.ScanLine[0]));
	end;
	D.F_Row_width := w;
	w := Abs(w);
		
	D.F_Pixels.Free;
	D.F_Pixels := New_FixAByte_Array(nil,
			PByte( Int64(B.Bm.Data) + D.F_Row_width * X_Y ), w * X_H, 
			0, w * X_H - 1);
	B.locked_Y := X_Y;
	B.locked_H := X_H;
{$ELSE}
{$IFDEF FPC}
	ii := TLazIntfImage.Create(0, 0);
	try
		{$IFDEF BGRABitmap}
			B_bm := TBitmap.Create;
			B_bm.PixelFormat := pf24bit;
			B_bm.Width := B.Bm.Width;
			B_bm.Height := X_H;
            {$IFDEF BGRABitmap_CANVAS}
                B.Bm.Draw(B_bm.Canvas, 0, -X_Y);
            {$ELSE}
            	B_bm.Canvas.CopyRect(
	                Classes.Rect(0,0,B_bm.Width,B_bm.Height),
    	            B.Bm.Canvas,
        	        Classes.Rect(0,X_Y,B_bm.Width,X_H));
            {$ENDIF}
			B.Bm.Canvas.Changed;
			
			///////////////
            //if X_Y = 1 then
            //    B_Bm.SaveToFile('C:\AL-IV\Projects\Zoomer6\_Compiled_FPC\bits_to_lock.bmp');
			///////////////
			y := 0;
		{$ELSE}
			B_bm := B.Bm;
			y := X_Y;
		{$ENDIF}
		ii.LoadFromBitmap(B_Bm.Handle, B_Bm.MaskHandle);
		dd := ii.DataDescription; 
		dy := dd.BytesPerLine;
		if dd.LineOrder = riloBottomToTop then
		begin
			dy := -dy;
			y := B_Bm.Height-1 - y;
		end;
		case dd.BitsPerPixel of
			32: bits_per_pixel := 32;
			24: bits_per_pixel := 24;
			16, 15: bits_per_pixel := 16;
			8: bits_per_pixel := 8;
			4: bits_per_pixel := 4;
			1: bits_per_pixel := 1;
			else Exit;
		end;
	    D.F_Row_width := (bits_per_pixel * B_Bm.Width) div 8;
	    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, B.LocalSize);
	    	 end;
	    if not Assigned(B.LocalCopyPixels) then Exit;
	    if X_Read then
	    begin
		    Pixels := PByte({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(ii.PixelData)
		    		+ y * dy);
		    DestPixels := B.LocalCopyPixels;
		    dy := dd.BytesPerLine;
			if dd.LineOrder = riloBottomToTop then
			begin
				dy := -dy;
				//y := B_Bm.Height-1 - y;
			end;
		    for i := 1 to X_H do
		    begin
		    	if (dd.RedShift = 16) or (bits_per_pixel <> 32) then
		    		Move(Pixels^, DestPixels^, D.F_Row_width)
		    	else
		    	begin
		    		rshift := dd.RedShift;
		    		gshift := dd.GreenShift;
		    		bshift := dd.BlueShift;
		    		ashift := dd.AlphaShift;
			    	for x := 0 to B_Bm.Width-1 do
			    	   begin
			    	   		color4 := PDWORD(Pixels)[x];
			    	   		color4 := (((color4 shr gshift) shl 8) and $000FF00) or	
			    	   			(((color4 shr bshift) shl 16)and $FF0000) or
			    	   			((color4 shr rshift) and $0000FF) or
			    	   			(((color4 shr ashift) shl 24)  and $FF000000);
			    	   		PDWORD(DestPixels)[x] := color4;
			    	   end;
		    	end;
		    	inc(Pixels, dy);
		    	inc(DestPixels, D.F_Row_width);
			end;
			{$IFnDEF BGRABitmap}
			if (B.AlphaChannel <> nil) and (bits_per_pixel = 32) then
            begin
            	//------------------ read alpha
            	ii.LoadFromBitmap(	B.AlphaChannel.Handle,
            						B.AlphaChannel.MaskHandle);
            	dd := ii.DataDescription;
            	dy := dd.BytesPerLine;
				if dd.LineOrder = riloBottomToTop then
				begin
					dy := -dy;
					//y := B_Bm.Height-1 - y;
				end;
                for i := 0 to X_H-1 do
                begin
	            	Pixels := PByte({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(
	            			ii.PixelData) + (y + i) * dy)
	            		{$IFDEF LINUX} {$ELSE} + 2 {$ENDIF} ;
	            	DestPixels := B.LocalCopyPixels + i * D.F_Row_width + 3;
                    for x := 0 to B_Bm.Width - 1 do
                    begin
                        DestPixels^ := Pixels^;
                        inc(DestPixels, 4);
                        inc(Pixels, dd.BitsPerPixel div 8);
                    end; 
                end;
            end;
            {$ENDIF}
		end;
		D.F_Pixels.Free;
		D.F_Pixels := New_FixAByte_Array(nil,
    		B.LocalCopyPixels, D.F_Row_width * X_H, 
    		0, D.F_Row_width * X_H - 1);
    	B.locked_Y := X_Y;
    	B.locked_H := X_H;
	finally
		ii.Free;
		{$IFDEF BGRABitmap}
			B_bm.Free;
		{$ENDIF}
	end;
{$ELSE}
    case B.Bm.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;
    src_bits_per_pixel := bits_per_pixel;
    D.F_Row_width := (bits_per_pixel * B.Bm.Width) div 8;
    Pixels := B.Bm.ScanLine[X_Y];
    if (X_H > 1) or (B.AlphaChannel <> nil) then
    begin
		// sometimes information about bits per pixel is incorrect and
		// in this portion of code we get correction on base of an actual
		// difference between physical addresses of the line 0 and 1:
        s0 := Int64(B.Bm.ScanLine[0]);
        s1 := s0;
        if B.Bm.Height > 1 then
            s1 := Int64(B.Bm.ScanLine[1]);
        if (D.F_Row_width <> Abs(s1 - s0)) and 
           (B.Bm.PixelFormat = pf24bit) then
        begin
        	src_bits_per_pixel := 32;
        end;
        if (s0 > s1) or (s1 - s0 <> D.F_Row_width) 
        	or (B.AlphaChannel <> nil)
        	or (src_bits_per_pixel <> bits_per_pixel) then
        begin
            if (s0 > s1) then
            	Pixels := B.Bm.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, B.LocalSize);
				    D.F_Pixels.Free;
				    D.F_Pixels := New_FixAByte_Array(nil,
				    	PByte(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
	                begin
	                	inc(Pixels, y * D.F_Row_width);
	                    Move(B.Bm.ScanLine[y]^, Pixels^, D.F_Row_width);
	                    dec(Pixels, y * D.F_Row_width);
	                end;
                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.Bm.Width - 1 do
                        begin
                        	inc(Pixels, row_start_to + x * 4);
                        	inc(curr_scan, 2 + x * 4);
                            Pixels^ := curr_scan^;
                            dec(Pixels, row_start_to + x * 4);
                            dec(curr_scan, 2 + x * 4);
                        end; 
                    end;
                end;
            end;
        end;
    end;
    D.F_Pixels.Free;
	D.F_Pixels := New_FixAByte_Array(nil,
		Pixels, D.F_Row_width * X_H, 
		0, D.F_Row_width * X_H - 1);
    B.locked_Y := X_Y;
    B.locked_H := X_H;
{$ENDIF}
{$ENDIF}
//.
end;

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

//- ATTENTION!!! - UnlockBitmapPixels is not yet tested for Linux + FPC !!!!!

FUN UnlockBitmapPixels(
	{Bitmap_direct} B|itmap_object, BOOL Write|_back), 
    NATIVE : @
    "   Do_UnlockBitmapPixels(X_B, X_Write);" .
*/
*)
procedure Do_UnlockBitmapPixels(X_B: Ref_obj; X_Write: Boolean);
//? {Bitmap_direct}
var B: TBitmap_Ex;
    D: C_Bitmap_direct;
{$IFDEF LOCK_DIRECT}
{$ELSE}
	{$IFDEF FPC}
	var B_Bm: TBitmap;
	var Pixels, FromPixels: PByte;
	    x, y, dy, i: Integer;
	    ii: TLazIntfImage;
	    dd: TRawImageDescription;
	    out1, out2: HBitmap;
	    color4: DWORD;
	    gshift, rshift, bshift, ashift: Integer;
	    TempBitmap: TBitmap;
	{$ELSE}
	var Pixels: PByte_Array;
	    s0, s1: Int64;
	    y, x, row_start_from: Integer;
	    curr_scan: PByte_Array;
	    dst_bytes_pixel, src_delta: Integer;
	{$ENDIF}
{$ENDIF}
//.
begin
//? {Bitmap_direct}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		B := TBitmap_ex(All_bitmaps[C_Bitmap_direct(X_B.Obj).F_Handle]);
	{$ELSE}
    	B := TBitmap_Ex(C_Bitmap_direct(X_B.Obj).F_Handle);
    {$ENDIF}
    D := C_Bitmap_direct(Ref_obj(B.Tag_bitmap_object_).Obj);
{$IFDEF LOCK_DIRECT}
	B.Bm.InvalidateBitmap;
{$ELSE}
{$IFDEF FPC}
    if Assigned(B.LocalCopyPixels) and X_Write then
    begin
	    ii := TLazIntfImage.Create(0, 0);
		try
	    	{$IFDEF BGRABitmap}
	    		B_bm := TBitmap.Create;
				B_bm.PixelFormat := pf24bit;
				B_bm.Width := B.Bm.Width;
				B_bm.Height := B.Locked_H;
				B_bm.Canvas.Changed;
				y := 0;
	    	{$ELSE}
	    		B_bm := B.Bm;
				y := B.locked_Y;
	    	{$ENDIF}
			ii.LoadFromBitmap(B_Bm.Handle, B_Bm.MaskHandle);
			dd := ii.DataDescription; 
			dy := dd.BytesPerLine;
			if dd.LineOrder = riloBottomToTop then
			begin
				dy := -dy;
				y := B_Bm.Height-1 - y;
			end;
		    Pixels := PByte({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(ii.PixelData)
		    		+ y * dy);
		    FromPixels := B.LocalCopyPixels;
	    	if (dd.RedShift=16) and (dd.BlueShift=0) and (dd.GreenShift=8)
	    	   or (dd.BitsPerPixel <> 32) then
	    	   rshift := -1
	    	else
	    	begin
	    		rshift := dd.RedShift;
	    		gshift := dd.GreenShift;
	    		bshift := dd.BlueShift;
	    		ashift := dd.AlphaShift;
	    	end;
            //Writeln('rshift=' + IntToStr(rshift) + ' Row_w=' + IntToStr(D.F_Row_width)
            //+ ' y=' + IntToStr(y) + ' B_bm.W=' + IntToStr(B_bm.Width)
            //+ ' B_bm.H=' + IntToStr(B_bm.Height) + ' bitsperpixel='
            //+ IntToStr(dd.BitsPerPixel) + ' bytesperline=' + IntToStr(dd.BytesPerLine)
            //+ ' locked_H=' + IntToStr(B.Locked_H) + ' dy=' + IntToStr(dy) +
            //' Handle=' + IntToStr(B_bm.Handle)
            //+ ' FromPixels=' + IntToHex(Int64(FromPixels), 1)
            //+ ' Pixels=' + IntToHex(Int64(Pixels), 1));
		    for i := 0 to B.locked_H-1 do
		    begin
		    	//++
		    	//```````````Pixels := ii.GetDataLineStart(i);
		    	//--
                //Writeln('i=' + IntToStr(i)
                //+ ' FromPixels=' + IntToHex(Int64(FromPixels), 1)
                //+ ' Pixels=' + IntToHex(Int64(Pixels), 1));
		    	if rshift = -1 then
		    	   Move(FromPixels^, Pixels^, D.F_Row_width)
		    	else
		    	begin
		    	   for x := 0 to B_Bm.Width-1 do
		    	   begin
		    	   		color4 := PDWORD(FromPixels)[x];
		    	   		color4 := (((color4 and $000FF00) shr 8) shl gshift) or	
		    	   			(((color4 and $FF0000) shr 16) shl bshift) or
		    	   			((color4 and $0000FF) shl rshift) or
		    	   			(((color4 and $FF000000) shr 24) shl ashift);
		    	   		PDWORD(Pixels)[x] := color4;
		    	   end;
		    	end;
		    	inc(Pixels, dy);
		    	inc(FromPixels, D.F_Row_width);
			end;    
			B_bm.Canvas.Changed;
			
			//B_Bm.SaveToFile('C:\AL-IV\Projects\Zoomer6\_Compiled_FPC\bits_unlock.bmp');   
			{$IFnDEF BGRABitmap}
			if (B.AlphaChannel <> nil) and (dd.BitsPerPixel = 32) then
            begin
            	//------------------ write AlphaChannel
            	ii.LoadFromBitmap(
            		B.AlphaChannel.Handle,
            		B.AlphaChannel.MaskHandle);
				dd := ii.DataDescription; 
				y := B.locked_Y;
				dy := dd.BytesPerLine;
				if dd.LineOrder = riloBottomToTop then
				begin
					dy := -dy;
					y := B_Bm.Height-1 - y;
				end;
                for y := B.locked_Y to B.locked_Y + B.locked_H - 1 do
                begin
                	Pixels := PByte({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(
                			ii.PixelData) + y * dy)
                		{$IFDEF LINUX} {$ELSE} + 2 {$ENDIF};
		    		FromPixels := PByte({$IFDEF FPC}QWORD{$ELSE}Integer{$ENDIF}(
		    				B.LocalCopyPixels) + (y - B.locked_Y) * D.F_Row_width);
                    for x := 0 to B_Bm.Width - 1 do
                    begin
                    	Pixels^ := FromPixels^;
                    	inc(Pixels, 4);
                    	inc(FromPixels, 4)
                    end;
                end;
            end;
            {$ENDIF}
			ii.CreateBitmaps(out1, out2, TRUE);
			{$IFDEF BGRABitmap}
				//B_Bm.Draw(B.Bm.Canvas, 0, B.Locked_H);
				TempBitmap := TBitmap.Create;
				TempBitmap.Handle := out1;
				TempBitmap.MaskHandle := out2; 
				B.Bm.Canvas.Draw(0, B.Locked_Y, TempBitmap);

                //B.Bm.Canvas.CopyRect(
                //    Classes.Rect(0,B.Locked_Y,B.Bm.Width,B.Locked_H),
                //    B_Bm.Canvas,
                //    Classes.Rect(0,0,B.Bm.Width,B_Bm.Height));
					
                //B.Bm.Canvas.Changed;
					
				//B.Bm.SaveToFile('C:\AL-IV\Projects\Zoomer6\_Compiled_FPC\unlocked.bmp');
			{$ELSE}
				B.Bm.Handle := out1;
			{$ENDIF}
		finally
			ii.Free;
			{$IFDEF BGRABitmap}
				B_Bm.Free;
			{$ENDIF}
		end;
    end;
    //D.F_Pixels.Free;
    //D.F_Pixels := FixAByte.Create;
    //if Assigned(B.LocalCopyPixels) then
    //begin
    //    FreeMem(B.LocalCopyPixels);
    //    B.LocalCopyPixels := nil;
    //end;
{$ELSE}
    if Assigned(B.LocalCopyPixels) and X_Write then
    begin
	    s0 := Int64( B.Bm.ScanLine[0] );
        s1 := s0;
        if B.Bm.Height > 1 then
            s1 := Int64( B.Bm.ScanLine[1] );
        dst_bytes_pixel := 4;
        if B.Bm.PixelFormat = pf24bit then
        begin
        	dst_bytes_pixel := 3;
        	if Abs(s1 - s0) div B.Bm.Width >= 4 then
        		dst_bytes_pixel := 4;
        end;
        src_delta := D.F_Row_width div B.Bm.Width;
        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
            	{$IFDEF LINUX}
	            	move_row24_swap_RB(PRGBQuad(@Pixels[y * D.F_Row_width]),
	            		PRGBQuad( B.Bm.ScanLine[y] ),
	            		B.Width, src_delta,
	            		dst_bytes_pixel);
            	{$ELSE}
	                Move(Pixels[y * D.F_Row_width],
	                	B.Bm.ScanLine[y]^,
	                	Abs(D.F_Row_width));
                {$ENDIF}
            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.Bm.Width - 1 do
                        curr_scan[
                        	{$IFDEF LINUX} 0 
                    		{$ELSE} 2 
                    		{$ENDIF} + x * dst_bytes_pixel] 
                    		:=
                        	Pixels[row_start_from + x * src_delta];
                end;
            end;
        end;
    end;
{$ENDIF}
{$ENDIF}
//.
end;

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

{TScroller}

constructor TScroller.Create(AOwner: TComponent);
begin
	inherited;
	{$IFDEF FPC}
	ControlStyle := ControlStyle + [csNoFocus] - [csRequiresKeyboardInput]
		- [csReflector];
	{$ENDIF}
	TabStop := false;
end;

function TScroller.CanFocus: Boolean;
begin
	Result := false;
end;

{ TScrolled_paintbox }

constructor TScrolled_paintbox.Create(
	AOwner: TComponent;
    V, H, X_Can_focus: Boolean);
var form: TAL4Form;
begin
  inherited Create(AOwner);
  //ControlStyle := ControlStyle + [csNoStdEvents] ;	
  BevelOuter := bvNone;
  Width := AL4_form.Points(100);
  Height := AL4_form.Points(100);
  coeff_horz := 1;
  coeff_vert := 1;
  line_height := 1;
  row_width := 1;
  form := TAL4Form(AOwner.Owner);
  PBox := TPaintPanel.Create(Self);
  PBox.AL4form := form;
  PBox.BevelOuter := bvNone;
  PBox.Parent := Self;
  if AOwner = nil then Exit;
  
  AL4Form := form;
  if X_Can_focus then
  begin
        PBox.Can_focus := true;
        PBox.TabStop := true;
        //TabStop := false;
        PBox.OnEnter := {$IFDEF OBJFPC} @ {$ENDIF} Control_enter;
        PBox.OnExit := {$IFDEF OBJFPC} @ {$ENDIF} Control_leave;
        if form.ControlsHandlingNavigationKeys = nil then
           form.ControlsHandlingNavigationKeys 
           := TList.Create;
        form.ControlsHandlingNavigationKeys.Add(PBox);
        //form.ControlsHandlingNavigationKeys.Add(Self);
        //TabStop := false;
        //OnEnter := {$IFDEF OBJFPC} @ {$ENDIF} Redirect_focus_to_pbox;
  end
    else
  begin 
    PBox.TabStop := false;
    TabStop := false;
  end;
  if V then
  begin 
         VBar := TScroller.Create(Self);
         VBar.Parent := Self;
         //VBar.TabStop := false;
         //{$IFDEF FPC}
         //VBar.ControlStyle := VBar.ControlStyle + [csNoFocus];
         //{$ENDIF}
         VBar.OnScroll := {$IFDEF OBJFPC}@{$ENDIF} pbox_Scrolled;
         VBar.Kind := sbVertical;
   end;
  if H then 
  begin
         HBar := TScroller.Create(Self);
         //HBar.TabStop := false;
         //{$IFDEF FPC}
         //HBar.ControlStyle := HBar.ControlStyle + [csNoFocus];
         //{$ENDIF}
         HBar.Parent := Self;
         HBar.OnScroll := {$IFDEF OBJFPC}@{$ENDIF} pbox_Scrolled;
  end;
  if V and H then 
  begin
         BRspace := TPanel.Create(Self);
         BRspace.Parent := Self;
         BRspace.BevelOuter := bvNone;
  end;
  Adjust_components;
end;


destructor TScrolled_paintbox.Destroy;
begin
	{$IFDEF SPB_KEYBOARD_LINUX}
	if AL4Form.Control_redirect_keys = Self then
	   AL4Form.Control_redirect_keys := nil;
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	release_control(Self);
	{$ENDIF}
	inherited;
end;

procedure TScrolled_paintbox.Control_Enter(
	Sender: TObject);
//? {Paintbox}.keyboard_focus
var CR: Ref_obj;
    CC: C_Paintbox;
    F: C_Form;
//.
begin
//writeln('entered pbox!!!');
	{$IFDEF SPB_KEYBOARD_LINUX}
	AL4Form.Control_redirect_keys := Self;
	{$ENDIF}

//? {Paintbox}.keyboard_focus
	CR := ref_obj_from_control(Self);
    CC := C_Paintbox(CR.Obj);
    
    F := C_Form(CC.F_Form_.Obj);
    
	operation_started(24, F);
	try
    CC.M_keyboard_focus(true);
    except //on EStop: Stop_exception do;
    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
    operation_ended(24, F);    
//.
end;

procedure TScrolled_paintbox.Control_Leave(
	Sender: TObject);
//? {Paintbox}.keyboard_focus
var CR: Ref_obj;
    CC: C_Paintbox;
    F: C_Form;
//.
begin
//writeln('leave pbox???');
	{$IFDEF SPB_KEYBOARD_LINUX}
	if AL4Form.Control_redirect_keys = Self then
	   AL4Form.Control_redirect_keys := nil;
	{$ENDIF}

//? {Paintbox}.keyboard_focus
	CR := ref_obj_from_control(Self);
    CC := C_Paintbox(CR.Obj);
    
    F := C_Form(CC.F_Form_.Obj);
    
	operation_started(24, F);
	try
    CC.M_keyboard_focus(false);
    except //on EStop: Stop_exception do;
    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
    operation_ended(24, F);    
//.
end;



procedure TScrolled_paintbox.pbox_Scrolled(
	Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
//?{Paintbox}
var R: Ref_obj;
	CF: C_Form;
//.
begin
	scrolling := true;
	try
//?{Paintbox}
	R := ref_obj_from_control(Self);
	CF := C_Form( AL4Form.AL4Object.Obj );
	
	operation_started(25, CF, R);
	try	
    C_Paintbox(R.Obj).M_scrolled;
    except //on EStop: Stop_exception do;
    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
    operation_ended(25, CF);    
    
    call_form_scrolled(Self);
    
	PBox.Invalidate;
	finally
		scrolling := false;
	end;
end;

procedure call_form_scrolled(SPB: TScrolled_paintbox);
//?{Form}.scrolled
var CF: C_Form;
	CC: C_Control;
	R: Ref_obj;
//.
begin
//?{Form}.scrolled
	CF := C_Form( SPB.AL4Form.AL4Object.Obj );
	R := ref_obj_from_control(SPB); 
	CC := C_Control(R.Obj);
    operation_started(25, cF, R);
    try
    	cF.M_scrolled;
    finally
    	operation_ended(25, cF);
    end;
//.
end;


(*
/*

    FUN Suspend_paintbox({Paintbox} P|aintbox_control), NATIVE :
        INT h|andle_paintbox = P.Handle 
    	CASE h == 0 ? ==> ;
    NATIVE @
    "var SPB: TScrolled_paintbox;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    " SPB := TScrolled_paintbox(All_controls[X_h]);"
    "{$ELSE}"
    " SPB := TScrolled_paintbox(X_h);"
    "{$ENDIF}"
    "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: TScrolled_paintbox;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    " SPB := TScrolled_paintbox(All_controls[X_h]);"
    "{$ELSE}"
    " SPB := TScrolled_paintbox(X_h);"
    "{$ENDIF}"
    "Dec(SPB.suspend_count);"
    //"writeln('--: ' + IntToStr(SPB.suspend_count));"     
    "if (SPB.suspend_count <= 0) then"
    "	 SPB.Adjust_components;" .
    


	
 	FUN Get_control_bitmap_bpp ==> INT, NATIVE :
	"{$IFDEF FPC}"
	"	RESULT := 24;"
	"{$ELSE}"
	"	RESULT := 32;"
	"{$ENDIF}" .
	
    FUNCTION Call_form_scrolled(
    INT P|aintbox_control_handle), NATIVE : @
    "var SPB: TScrolled_paintbox;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    " SPB := TScrolled_paintbox(All_controls[X_P]);"
    "{$ELSE}"
    " SPB := TScrolled_paintbox(X_P);"
    "{$ENDIF}"
    "call_form_scrolled(SPB);" .
		

	
	FUN Adjust_paintbox_components({Paintbox} P|aintbox_object): .

	FUN Paint_lines_activated(INT H|andle_control), NATIVE : @
	"var SPB: TScrolled_paintbox;"
    "{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    " SPB := TScrolled_paintbox(All_controls[X_H]);"
    "{$ELSE}"                     
    " SPB := TScrolled_paintbox(X_H);"
    "{$ENDIF}"
    "{$IFDEF FPC}"
    //"	writeln('setting ActiveControl to PBox');"
    //"	SPB.AL4Form.ActiveControl := SPB.PBox;"
    //"	writeln('ActiveControl= ' + SPB.AL4Form.ActiveControl.ClassName);"
    "{$ELSE}"     
	//"	SPB.PBox.SetFocus();"
	"	SPB.AL4Form.Set_Active_Control(SPB.PBox);"
	"{$ENDIF}"     
	.    
	
	
*/
*)


procedure TScrolled_paintbox.Adjust_components;
var VBar_W, HBar_H: Integer;
	p_s, m_v: Integer;
	w_a, h_a: Double;
	CF: C_Form;
	SI: TScrollInfo;
begin
	if suspend_count > 0 then
	begin
		/////////////////////
		//writeln('suspended! ' + IntToStr(suspend_count));
		Exit;
	end;
	CF := C_Form( AL4Form.AL4Object.Obj );
	inc(CF.F_suspended_count);
	try
	    VBar_W := 0;
	    HBar_H := 0;
	    if VBar <> nil then
	    begin
	        VBar_W := VBar.Width;
	        VBar.Left := Width - VBar_W;
	        if HBar = nil then
	           VBar.Height := Height;
	    end;
	    if HBar <> nil then
	    begin
	        HBar_H := HBar.Height;
	        HBar.Top := Height - HBar_H;
	    end;
	    PBox.Width := Width - VBar_W;
	    PBox.Height := Height - HBar_H;
	       
	    if VBar <> nil then
	    begin
	    	if HBar_H > 0 then
	    		VBar.Height := Height - HBar_H;
			VBar.PageSize := 0;
			
			h_a := PBox.Height;
			p_s := Trunc(h_a / coeff_vert);
			m_v := Trunc(Content_height / coeff_vert);
			if m_v < 0 then m_v := 0;
	    	if p_s > m_v then p_s := m_v; 
			VBar.Max := m_v+1;
	       	VBar.PageSize := p_s;
	       	VBar.LargeChange := p_s;
	       	VBar.SmallChange := 1;
	       	//////////////////////////////////////////////////////////////////
            //writeln('m_v=' + FloatToStr(m_v) + ' p_s=' + FloatToStr(p_s) +
            //    ' nPage=' + FloatToStr(VBar.LargeChange) + ' Content_height=' +
            //    FloatToStr(Content_height));
            VBar.Visible := m_v > p_s;
	    end;
	    
	    if HBar <> nil then
	    begin
			HBar.Width := Width - VBar_W;
			HBar.PageSize := 0;
			
			w_a := PBox.Width;
			if w_a > Content_width then w_a := Content_width;
	       	if w_a > 0 then p_s := Trunc(w_a / coeff_horz)
	       	else p_s := 1 ;
			m_v := Trunc((Content_width) / coeff_horz);
			if m_v < 0 then m_v := 0;
		       	HBar.Max := m_v+1;
		       	HBar.PageSize := p_s;
		       	HBar.LargeChange := p_s;
		       	HBar.SmallChange := 1;
	       	/////////////////////////////////////////////////////////////////////
            //writeln('HBar Max=' + IntToStr(HBar.Max) + ' PageSize=' + IntToStr(
            //    HBar.PageSize) + ' LargeChange=' + IntToStr(HBar.LargeChange) +
            //    ' coeff_horz=' + FloatToStr(coeff_horz) +
            //    ' Content_width=' + FloatToStr(Content_width) +
            //    ' m_v=' + IntToStr(m_v) +
            //    ' HBar.Width=' + IntToStr(HBar.Width));
            HBar.Visible := m_v > p_s;
	    end;
	    
	    if BRSpace <> nil then
	    begin
	    	BRSpace.Left := Width - VBar_W;
	    	BRSpace.Top := Height - HBar_H;
	    	BRSpace.Width := VBar_W;
	    	BRSpace.Height := HBar_H;
	    end;
	finally
		dec(CF.F_suspended_count);
	end;    
end;


procedure TScrolled_paintbox.Paint_box_paint(Sender: TObject);
//? {Paintbox}
{$IFnDEF DIRECT_DRAW_CANVAS}
var Bmp: TBitmap_Ex;
	C_Bmp: C_Bitmap;
{$ENDIF}
var CF: C_Form;
    R: Ref_obj;
    {$IFNDEF LINUX}
    	X: TXForm;
    {$ENDIF}
//.
begin
//? {Paintbox}
	R := ref_obj_from_control(Self);
    CF := C_Form( AL4Form.AL4Object.Obj );
 
	operation_started(21, CF, R);
	try	
    C_Paintbox(R.Obj).M_before_paint;
    except //on EStop: Stop_exception do;
    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
    operation_ended(21, CF);    
    
    if C_Paintbox(R.Obj).F_need_repaint then
    begin
		operation_started(22, CF, R);
		dec(Allow_handle_events);
		try
			try
		    CF.M_Paint;
		    except //on EStop: Stop_exception do;
		    	on Ex: Exception do
				   begin
				   		if Ex is AL4_Exception then raise;
				   end
		    end;
		finally
		inc(Allow_handle_events);
		end;
	    operation_ended(22, CF);
    end;

    operation_started(23, CF, R);
    try
    C_Paintbox(R.Obj).M_after_paint;
    except //on EStop: Stop_exception do;
    	on Ex: Exception do
			   begin
			   		if Ex is AL4_Exception then raise;
			   end
    end;
    operation_ended(23, CF);
    
    {$IFDEF DIRECT_DRAW_CANVAS}
    {$ELSE}
	    C_Bmp := C_Bitmap(C_Paintbox(ref_obj_from_control(Self).Obj).F_buffer.Obj);
		{$IFDEF USE_LISTS_OF_DESCRIPTORS}
			Bmp := TBitmap_ex(All_bitmaps[C_Bmp.F_Handle]);
		{$ELSE}
	    	Bmp := TBitmap_Ex(C_Bmp.F_Handle);
	    {$ENDIF}
	    if Bmp <> nil then
	    begin
            {$IFDEF SIMULATED_TRANSFORMS}
                Bmp.Matrix := XIdentity;
            {$ELSE}
                if  GetGraphicsMode(Bmp.Bm.Canvas.Handle) <> GM_COMPATIBLE then
                begin
                    ModifyWorldTransform(Bmp.Bm.Canvas.Handle, X, MWT_IDENTITY);
                    SetGraphicsMode(Bmp.Bm.Canvas.Handle, GM_COMPATIBLE);
                end;
            {$ENDIF}
		    {$IFnDEF BGRABITMAP}
		    {$IFDEF FPC}
		    Bmp.Bm.Transparent := FALSE;
		    Bmp.Bm.TransparentColor := clNone;
		    {$ENDIF}
		    {$ENDIF}
		    {$IFDEF BGRABITMAP_CANVAS}
		    	Bmp.Bm.Draw(PBox.Canvas, 0, 0, TRUE);
		    {$ELSE}
		    	PBox.Canvas.Draw(0, 0, Bmp.Bm);
		    {$ENDIF}
		    
		    {$IFDEF debug_draw}
			Bmp.Bm.SaveToFile('paint_' + 
	       	IntToStr(Bmp.Bm.Width) + 'x' + IntToStr(Bmp.Bm.Height) + '.bmp');
	       	{$ENDIF}	   
	    end;
    {$ENDIF}
//.
end;

procedure TPaintPanel.Paint;
begin
    if  Assigned(OnPaint_Scrolled_paintbox) then
        OnPaint_Scrolled_paintbox(Self)
    else inherited;
end;

{$IFNDEF LINUX}
procedure TPaintPanel.WMErase(
	var M: TMessage);
begin
    M.Result := 1;
end;

procedure TPaintPanel.WMLButtonDown(
	var Message: TWMLButtonDown);
begin
    if Can_focus then
        SetFocus;
    inherited;
end;
        
procedure TPaintPanel.WMRButtonDown(
	var Message: TWMRButtonDown);
begin
    if Can_focus then
        SetFocus;
    inherited;
end;

//procedure TPaintPanel.WndProc(var Message: TMessage);
//var parent_f: TAL4Form;
//begin
//    parent_f := AL4form;
//    case Message.Msg of
//        WM_NCHITTEST:
//            begin
//                if (parent_f <> nil) and (parent_f.Is_httransparent) then
//                begin
//                    write(' * ');
//                    DefWindowProc(Handle,
//                        Message.Msg, Message.wParam, Message.lParam);
//                    //Message.Result := HTTRANSPARENT;
//                    Message.Result := HTNOWHERE;
//                    Exit;
//                end;
//            end;
//    end;
//    inherited;
//end;

{$ENDIF}

procedure TScrolled_paintbox.SPB_Resize(Sender: TObject);
begin
  inherited;
  Adjust_components;
	  if (VBar <> nil) and (ParentForm.ActiveControl = VBar) then
	     ParentForm.ActiveControl := nil
	  else if (HBar <> nil) and (ParentForm.ActiveControl = HBar) then
	     ParentForm.ActiveControl := nil;
  AL4Form.Control_resized(Sender);
end;


function TScrolled_paintbox.ParentForm
	: TForm;
begin
    Result := TForm(Parent.Parent);
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_canvas({Canvas} C|anvas_object,
//    INT Bitmap|_handle) ==> INT, NATIVE :
//    "    RESULT := Do_Create_canvas(X_C, X_Bitmap);" .
    
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, NATIVE :
	"RESULT := Is_Direct_draw_canvas;" .
	
*/
*)

function Is_Direct_draw_canvas: Boolean;
begin
	 {$IFDEF DIRECT_DRAW_CANVAS}
	 	RESULT := true;
	 {$ELSE}
	 	Result := false;
	 {$ENDIF}
end;
	
(*
/*

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 := 0; // Do_create_printer_canvas(X_C, X_Printer_handle);" .
	"	RESULT := Do_create_printer_canvas(X_C, X_Printer_handle);"
	.     
*/
*)

function Do_Create_bitmap_canvas(
	X_C: Ref_obj; X_B: Ref_obj): Integer;
var Bmp: TBitmap_Ex;
	C_B: C_Bitmap;
begin
	C_B := C_Bitmap(X_B.Obj); 
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Bmp := TBitmap_ex(All_bitmaps[C_B.F_Handle]);
	{$ELSE}
    	Bmp := TBitmap_Ex(C_B.F_Handle);
    {$ENDIF}
    Object_assign_weak(Bmp.CanvasObject_, X_C.Obj);
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Result := C_B.F_Handle;
	{$ELSE}
    	Result := Integer(Bmp);
	{$ENDIF}
end;

function Do_Create_printer_canvas(
    X_C: Ref_obj; X_Printer_handle: Integer): Integer;
var Bmp: TBitmap_Ex;
    P: TPrinter;
//    w, h: Integer;
begin
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
	P := TPrinter(All_printers[X_Printer_handle]);
	{$ELSE}
    P := TPrinter(X_Printer_handle);
    {$ENDIF}
    //w := P.PageWidth;
    //h := P.PageHeight;
    //writeln('page w=' + IntToStr(w) + ' page h=' + IntToStr(h));
    Bmp := TBitmap_Ex.Create(1,1);
    {$IFDEF SUPPORT_PRINTER}
    Bmp.Printer := P;
    //{$IFDEF FPC}
    //    P.RawMode := true;
    //{$ENDIF}
    {$ENDIF}
    Object_assign_weak(Bmp.CanvasObject_, X_C.Obj);
    {$IFDEF USE_LISTS_OF_DESCRIPTORS}
        Result := Allocate_bitmap(Bmp);
    {$ELSE}
        Result := Integer(Bmp);
    {$ENDIF}
end;

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

FUN Destroy_canvas(INT C|anvas_handle), NATIVE :
    "    Do_Destroy_canvas(X_C);" .
*/
*)

procedure Do_Destroy_canvas(
	X_C: Integer);
//var C: TCanvas;
//	Obj: TObject;
begin
	//C := TCanvas(Pointer(X_C));
	//if C = nil then Exit;
	//C.Free;
end;

(*
/*
// 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_rect, REAL H|eight_rect), NATIVE : @
    "     Do_Erase_rect(X_C, X_X, X_Y, X_W, X_H);" .
    
*/
*)

procedure Do_Erase_rect(
	X_C: Ref_obj; X, Y, W, H: Double);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    R_erase: TRect;
//.
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    R_erase.Left := UnitsToCoords(C, C_Units, X);
    R_erase.Top := UnitsToCoords(C, C_Units, Y);
    R_erase.Right := UnitsToCoords(C, C_Units, X+W);
    R_erase.Bottom := UnitsToCoords(C, C_Units, Y+H);
    C.FillRect(R_erase);
	{$IFnDEF BGRABITMAP}
	    if A <> nil then
	        A.FillRect(R_erase);
	{$ENDIF}
//.
end;

(*
/*
// Paint rect
//-----------

FUN Paint_rect(
	{Canvas} C|anvas_object, {rect} R|ectangle)
	:
	{rect} rr|_plus_1pixel = {rect}(
		Loc = R.Loc.Clone, Width=R.Width+1, Height=R.Height+1)
		
	do_Paint_rect(C, rr.Loc.X, rr.Loc.Y, rr.Width, rr.Height) .
	
FUN do_Paint_rect({Canvas} C|anvas_object, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_rect, REAL H|eight_of_rect), NATIVE : @
    "     Do_Paint_rect(X_C, X_X, X_Y, X_W, X_H);" .
    
*/
*)

function Transform_pt(C: TCanvas; C_Units: Integer; x, y: Double; 
	const A: TMatrixRec): TPoint;
begin
	Result.X := UnitsToCoords(C, C_Units, 
		x * A.M11 + y * A.M21 + A.mtx);
	Result.Y := UnitsToCoords(C, C_Units,
		x * A.M12 + y * A.M22 + A.mty);
end;

function bitmap_from_canvas(
X_C: Ref_obj): TBitmap_Ex;
begin
	{$IFDEF DIRECT_DRAW_CANVAS}
	Result := nil;
	if C_Canvas(X_C.Obj).F_Handle = 0 then Exit;
	{$ENDIF}
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
		Result := TBitmap_ex(All_bitmaps[C_Canvas(X_C.Obj).F_Handle]);
	{$ELSE}
    	Result := TBitmap_Ex(C_Canvas(X_C.Obj).F_Handle);
    {$ENDIF}
end;

procedure Do_Paint_rect(
	X_C: Ref_obj; _X, _Y, _W, _H: Double);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF} : TCanvas;
    C_Units: Integer;
    R_fill: TRect;
    D: TBitmap_Ex;
    {$IFDEF SIMULATED_TRANSFORMS}
    pts: array[0..3] of TPoint;
    {$ENDIF}
    C_C: C_Canvas;
//.    
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    D := bitmap_from_canvas(X_C);
    {$IFDEF SIMULATED_TRANSFORMS}
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	pts[0] := Transform_pt(
	    		C, C_Units, _X, _Y, D.Matrix);
	    	pts[1] := Transform_pt(
	    		C, C_Units, _X+_W, _Y, D.Matrix);
	    	pts[2] := Transform_pt(
	    		C, C_Units, _X+_W, 
	    		_Y+_H, D.Matrix);
	    	pts[3] := Transform_pt(
	    		C, C_Units, _X, _Y+_H, D.Matrix);
	    	C.Polygon(pts);
	    	{$IFnDEF BGRABITMAP_CANVAS}
	    	if A <> nil then
	    		A.Polygon(pts);
	    	{$ENDIF}
	    	Exit;
	    end;
    {$ENDIF}
    R_fill.Left := UnitsToCoords(C, C_Units, _X);
    R_fill.Top := UnitsToCoords(C, C_Units, _Y);
    R_fill.Right := UnitsToCoords(C, C_Units, _X +_W);
    R_fill.Bottom := UnitsToCoords(C, C_Units, _Y +_H);
    C.FillRect(R_fill);
    
    C_C := C_Canvas(X_C.Obj);

    if C_C.F_Pen_style = 0 then
    	C.Rectangle(R_fill);
    {$IFnDEF BGRABITMAP_CANVAS}
	    if A <> nil then
	    begin
	        A.FillRect(R_fill);
	    	if C_C.F_Pen_style = 0 then
	     	   A.Rectangle(R_fill);
	    end;
    {$ENDIF}
//.    
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 X1|_point, REAL Y1|_point,
REAL X2|_point, REAL Y2|_point), NATIVE :
    "     Do_Paint_line(X_C, X_X1, X_Y1, X_X2, X_Y2);" .
*/
*)

procedure Do_Paint_line(
	X_C: Ref_obj; X1, Y1, X2, Y2: Double);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    {$IFDEF SIMULATED_TRANSFORMS}
    D: TBitmap_Ex;
    pts: array[0..1] of TPoint;
    {$ENDIF}
//.    
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	pts[0] := Transform_pt(C, C_Units, X1, Y1, D.Matrix);
	    	pts[1] := Transform_pt(C, C_Units, X2, Y2, D.Matrix);
	    	C.MoveTo(pts[0].X, pts[0].Y);
	    	C.LineTo(pts[1].X, pts[1].Y);
	    	{$IFnDEF BGRABITMAP_CANVAS}
	    	if A <> nil then
		    begin
		        A.MoveTo(pts[0].X, pts[0].Y);
		        A.LineTo(pts[1].X, pts[1].Y);
		    end;
		    {$ENDIF}
	    	Exit;
	    end;
	{$ELSE}
    {$ENDIF}
    
    C.MoveTo(UnitsToCoords(C, C_Units, X1), UnitsToCoords(C, C_Units, Y1));
    C.LineTo(UnitsToCoords(C, C_Units, X2), UnitsToCoords(C, C_Units, Y2));
    {$IFnDEF BGRABITMAP_CANVAS}
	    if A <> nil then
	    begin
	        A.MoveTo(UnitsToCoords(C, C_Units, X1), UnitsToCoords(C, C_Units, Y1));
	        A.LineTo(UnitsToCoords(C, C_Units, X2), UnitsToCoords(C, C_Units, Y2));
	    end;
    {$ENDIF}
//.    
end;

(*
/*
// Paint ellipse
//--------------

FUN Paint_ellipse(
	{Canvas} C|anvas_object, {Geometry}.{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_rect, REAL H|eight_rect), NATIVE :
    "     Do_Paint_ellipse(X_C, X_X, X_Y, X_W, X_H);" .
*/
*)

procedure Do_Paint_ellipse(
	X_C: Ref_obj; _X, _Y, _W, _H: Double);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    R_ell: TRect;
    {$IFDEF SIMULATED_TRANSFORMS}
    D: TBitmap_Ex;
    pts: array of TPoint;
    cx, cy, xx, yy: Double;
    i: Integer;
    {$ENDIF}
//.    
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	SetLength(pts, Max(20, Round(_W + _H) div 2));
	    	cx := _X + _W/2;
	    	cy := _Y + _H/2;
	    	for i := 0 to High(pts) do
	    	begin
	    		xx := cx + 0.5 * _W * cos(i * 2 * PI / Length(pts));
	    		yy := cy + 0.5 * _H * sin(i * 2 * PI / Length(pts));
	    		pts[i] := Transform_pt(C, C_Units, xx, yy, D.Matrix);
	    	end;
	    	C.Polygon(pts);
	    	{$IFnDEF BGRABITMAP_CANVAS}
	    	if A <> nil then
		        A.Polygon(pts);
	    	{$ENDIF}
	    	Exit;
	    end;
	{$ELSE}
    {$ENDIF}
    R_ell.Left := UnitsToCoords(C, C_Units, _X);
    R_ell.Top := UnitsToCoords(C, C_Units, _Y);
    R_ell.Right := UnitsToCoords(C, C_Units, _X + _W) + 1;
    R_ell.Bottom := UnitsToCoords(C, C_Units, _Y + _H) + 1;
    C.Ellipse(R_ell);
    {$IFnDEF BGRABITMAP_CANVAS}
	    if A <> nil then
	        A.Ellipse(R_ell);
    {$ENDIF}
//.        
end;

(*
/*
// 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_handle, REAL X|_of_rect, REAL Y|_of_rect,
REAL W|idth_rect, REAL H|eight_rect, REAL Fr|om_angle, REAL To|_angle,
BOOL Sided|_arc), NATIVE :
    "     Do_Paint_arc(X_C, X_X, X_Y, X_W, X_H, X_Fr, X_To, X_Sided);" .
*/
*)

procedure Do_Paint_arc(
	X_C: Ref_obj; _X, _Y, _W, _H, _Fr, _To: Double; Sided: Boolean);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    R: TRect;
    P1, P2: TPoint;
    {$IFDEF SIMULATED_TRANSFORMS}
    D: TBitmap_Ex;
    pts: array of TPoint;
    cx, cy, x, y, a1, a2: Double;
    n: Integer;
    {$ENDIF}
    angle: Double;
    i: Integer;
//.    
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	a1 := _Fr;
	    	a2 := _To;
	    	if IsNAN(a1) or IsNAN(a2) then Exit;
	    	while a2 < a1 do a2 := a2 + 360;
	    	n := Max(10, Round((_W + _H) * (_Y - _X + 20) / 360 ) div 2);
	    	if Sided then SetLength(pts, n+1)
	    	else SetLength(pts, n);
	    	cx := _X + _W/2;
	    	cy := _Y + _H/2;
	    	for i := 0 to n-1 do
	    	begin
	    		angle := (a1 + (a2 - a1) * i / n) * PI / 180;
	    		x := cx + 0.5 * _W * cos(angle);
	    		y := cy + 0.5 * _H * sin(angle);
	    		pts[i] := Transform_pt(C, C_Units, x, y, D.Matrix);
	    	end;
	    	if Sided then
	    	begin
	    		pts[High(pts)] := Transform_pt(C, C_Units, cx, cy, D.Matrix);
	    		C.Polygon(pts);
	    	end
	    	else C.Polyline(pts);
	    	{$IFnDEF BGRABITMAP_CANVAS}
	    	if A <> nil then
	    		if Sided then
	    			A.Polygon(pts)
	    		else A.Polygon(pts);
	    	{$ENDIF}
	    	Exit;
	    end;
	{$ELSE}
    {$ENDIF}
    R.Left := UnitsToCoords(C, C_Units, _X);
    R.Top := UnitsToCoords(C, C_Units, _Y);
    R.Right := UnitsToCoords(C, C_Units, _X + _W);
    R.Bottom := UnitsToCoords(C, C_Units, _Y + _H);
	    P1.X := (R.Left + R.Right) div 2 
	    	 + Trunc(100 * Cos(_Fr * PI / 180.0));
	    P1.Y := (R.Top + R.Bottom) div 2 
	    	 + Trunc(100 * Sin(_Fr * PI / 180.0));
	    P2.X := (R.Left + R.Right) div 2
	    	 + Trunc(100 * Cos(_To * PI / 180.0));
	    P2.Y := (R.Top + R.Bottom) div 2
	    	 + Trunc(100 * Sin(_To * PI / 180.0));
	    if  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);
	    {$IFnDEF BGRABITMAP_CANVAS}
		    if A <> nil then
		    begin
		        if 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;
	    {$ENDIF}
//.    
end;

(*
/*
// Paint text
//--------------

FUN Paint_text(
{Canvas} C|anvas_object, {point} P|oint_top_left, STR Text|_draw)
	:
	//CASE "linux" IN platform_info ?
	     STR lines|_NL_separted[].Split(Text, #NL)
	     CASE lines[].Count <= 1 ?
	          do_Paint_text(C, P.X, P.Y, Text) ==> ;
	     REAL y|_position_offset = 0
	     FOR s IN lines[] :
	         do_Paint_text(C, P.X, P.Y + y, s) 
	     	 y += C.Measure(s).H ;
    //ELSE
    //     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|_draw), NATIVE :
    "     Do_Paint_text(X_C, X_X, X_Y, X_Text);" .
*/
*)

function Get_font_style(C_F: C_Font): TFontStyles;
begin
	Result := [];
    if C_F.F_Bold then
    	Result := Result + [fsBold];
    if C_F.F_Italic then
    	Result := Result + [fsItalic];
    if C_F.F_Underline then
    	Result := Result + [fsUnderline];
    if C_F.F_Strikeout then
    	Result := Result + [fsStrikeOut];
end;

procedure Do_Paint_text(
	X_C: Ref_obj; X, Y: Double; const Text: String);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    C_F: C_Font;
    C_C: C_Canvas;
    PP: TPoint;
    
    D: TBitmap_Ex;
    {$IFDEF SIMULATED_TRANSFORMS}
    angle: Double;
    iAngle: Integer;
    {$IFDEF FPC}
    {$ELSE}
    LF: TLogFont;
    NewFont, OldFont: HFont;
    {$ENDIF}
    {$ENDIF}
    rgn: HRgn;
    xx, yy: Integer;
    clip_w, clip_h, clip_x, clip_y: Double;
//.
begin
//? {Canvas}
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
	C_C := C_Canvas(X_C.Obj);
	C_F := C_C.F_Font.Obj as C_Font;
    
	C.Font.Name := C_F.F_Face;
    C.Font.Height := -AL4_form.Points(Round(C_F.F_Size));
    C.Font.Size := Trunc(C_F.F_Size);
    C.Font.Color := C.Pen.Color;
    C.Brush.Style := bsClear;
    C.Font.Style := Get_font_style(C_F);
	
    
    D := bitmap_from_canvas(X_C);
    {$IFDEF SIMULATED_TRANSFORMS}
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	PP := Transform_pt(C, C_Units, X, Y, D.Matrix);
	    	angle := Arctan2(D.Matrix.m12, D.Matrix.m11);
	    	iAngle := Round(1800 * angle / PI);
	    	//writeln('angle = ' + FloatToStr(angle) + ' = ' + IntToStr(iAngle)); 
	    	{$IFDEF FPC}
	    	C.Font.Orientation := -iAngle;
	    	{$ELSE}
	    	GetObject(C.Font.Handle, Sizeof(LF), @LF);
	    	LF.lfEscapement := -iAngle;
	    	NewFont := CreateFontIndirect(LF);
	    	OldFont := SelectObject(C.Handle, NewFont);
	    	{$ENDIF}
	    	C.Brush.Style := bsClear;
	    	
	    	//writeln('text=[' + Text + '], len=' + IntToStr(Length(Text)));
	    	//////////////////////////////////////////////////////////////
	    	C.TextOut(PP.X, PP.Y, Text);
	    	C.Brush.Style := bsSolid;
	    	
	    	{$IFDEF FPC}
	    	C.Font.Orientation := 0;
	    	{$ELSE}
	    	NewFont := SelectObject(C.Handle, OldFont);
	    	DeleteObject(NewFont);
	    	{$ENDIF}
	    	
	    	{$IFnDEF BGRABITMAP_CANVAS}
	    	if A <> nil then
	    	begin
	    		{$IFDEF FPC}
	    		A.Font.Orientation := -iAngle;
	    		A.Brush.Style := bsClear;
	    		A.TextOut(PP.X, PP.Y, Text);
	    		A.Brush.Style := bsSolid;
	    		A.Font.Orientation := 0;
	    		{$ELSE}
	    		//--
	    		{$ENDIF} 
	    	end;
	    	{$ENDIF}
	    	Exit;
	    end;
	{$ELSE}
    {$ENDIF}
    PP.X := UnitsToCoords(C, C_Units, X);
    PP.Y := UnitsToCoords(C, C_Units, Y);
    
    clip_w := {$IFDEF STRUCTUREASCLASS}
	  		  St_rect__C_Geometry(C_C.F_Clip.Obj).f_Width
			  {$ELSE} 
		      C_C.F_Clip.f_Width
		   	  {$ENDIF};
    clip_h := {$IFDEF STRUCTUREASCLASS}
	  		  St_rect__C_Geometry(C_C.F_Clip.Obj).f_Height
			  {$ELSE} 
		      C_C.F_Clip.f_Height
		   	  {$ENDIF};
		   	  
    clip_x := {$IFDEF STRUCTUREASCLASS}
			  St_point__C_Geometry(
				  St_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}
			  St_point__C_Geometry(
				  St_rect__C_Geometry(C_C.F_Clip.Obj).f_Loc.Obj
			  ).f_Y
			  {$ELSE}
			  C_C.F_Clip.f_Loc.f_Y
			  {$ENDIF};
    
    if {$IFDEF SUPPORT_PRINTER}
		{$IFDEF DIRECT_DRAW_CANVAS}
			(D <> nil) and
		{$ENDIF} 
		(D.Printer <> nil) 
	   {$ELSE} FALSE 
	   {$ENDIF} 
		or 
		(clip_w = 0) and 
		(clip_h = 0) then
		C.TextOut(PP.X, PP.Y, Text)
	else
	begin
		xx := UnitsToCoords(C, C_Units, clip_x);
		yy := UnitsToCoords(C, C_Units, clip_y);
		rgn := CreateRectRgn(xx, yy,
			xx + UnitsToCoords(C, C_Units, clip_w),
			yy + UnitsToCoords(C, C_Units, clip_h));
		SelectClipRgn(C.Handle, rgn);
		DeleteObject(rgn);
		
		//writeln('+++++++++ clip: ' + FloatToStr(clip_x) + ' to ' + FloatToStr(
		//clip_w));
		////////////////////////////////////
		
		C.TextOut(PP.X, PP.Y, Text);
		SelectClipRgn(C.Handle, 0);
	end;
    C.Brush.Style := bsSolid;
    {$IFnDEF BGRABITMAP_CANVAS}
	    if A <> nil then
	    begin
	        A.Font.Name := C_F.F_Face;
	        A.Font.Size := Trunc(C_F.F_Size);
	        A.Font.Style := 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.Style := bsClear;
	        A.TextOut(PP.X, PP.Y, Text);
	        A.Brush.Style := bsSolid;
	    end;
    {$ENDIF}
//.    
end;

(*
/*
// Paint polygon/polyline
//-----------------------

FUN Paint_poly({Canvas} C|anvas_object,
    {point} P|oints_array[*], BOOL Closed|_polygon)
    :
    REAL x|_coordinates[]
    REAL y|_coordinates[]
    FOR i IN [0 TO P[].Count-1] :
        x[] << P[i].X
        y[] << P[i].Y ;
	do_Paint_poly(C, x[], y[], Closed) .
FUN do_Paint_poly({Canvas} C|anvas_object, 
REAL X|_coordinates[], REAL Y|_coordinates[], BOOL Closed|_polygon), NATIVE :
    "     Do_Paint_poly(X_C, X_X, X_Y, X_Closed);" .
*/
*)

procedure Do_Paint_poly(
	X_C: Ref_obj; X_X: DynAReal; X_Y: DynAReal; X_Closed: Boolean);
//? {Canvas}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    Pts: array of TPoint;
    i: Integer;
    {$IFDEF SIMULATED_TRANSFORMS}
    D: TBitmap_Ex;
    {$ENDIF}
//.
begin
//? {Canvas}
    if  X_X.Count() = 0 then Exit;
    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
    if C = nil then Exit;
    SetLength(Pts, X_X.Count());
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if {$IFDEF DIRECT_DRAW_CANVAS} (D <> nil) and {$ENDIF}
	    	D.Transformed then
	    begin
	    	for i := 0 to X_X.Count()-1 do
		    begin
		        Pts[i] := Transform_pt(C, C_Units, 
		        	X_X.GetReals(i),
		        	X_Y.GetReals(i),
		        	D.Matrix);
		    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);
		    
		    {$IFnDEF BGRABITMAP_CANVAS}
		    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;
		    {$ENDIF}
	    	Exit;
	    end;
	{$ELSE}
    {$ENDIF}
    for i := 0 to X_X.Count()-1 do
    begin
        Pts[i].X := UnitsToCoords(C, C_Units, X_X.GetReals(i));
        Pts[i].Y := UnitsToCoords(C, C_Units, X_Y.GetReals(i));
        //if true then writeln('pts[' + IntToStr(i) + ']=' +
        //             FloatToStr(Pts[i].X) + ',' + FloatToStr(Pts[i].Y));
    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);
    {$IFnDEF BGRABITMAP_CANVAS}
	    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;
    {$ENDIF}
//.    
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);
//? {Canvas}
    {$IFDEF SIMULATED_TRANSFORMS}
var D: TBitmap_Ex;
    {$ELSE}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    X: TXForm;
    C_C: C_Canvas;
    {$ENDIF}
//.
begin
//? {Canvas}
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    {$IFDEF DIRECT_DRAW_CANVAS} if D <> nil then {$ENDIF}
	    begin
	    	D.Transformed := FALSE;
	    end;
    {$ELSE}
	    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
	    if C = nil then Exit;
	        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);
		    {$IFnDEF BGRABITMAP_CANVAS}
			    if A <> nil then
			    begin
			        ModifyWorldTransform(A.Handle, X, MWT_IDENTITY);
			        SetGraphicsMode(A.Handle, GM_COMPATIBLE);
			    end;
		    {$ENDIF}
		    GetWorldTransform(C.Handle, bitmap_from_canvas(X_C).Matrix);
    {$ENDIF}
//.
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);" .
*/
*)

procedure show_world_transform(
	D: TBitmap_Ex; C: TCanvas; const s: String);
{$IFDEF SIMULATED_TRANSFORMS}
var A: TMatrixRec;
{$ELSE}
var X: TXForm;
{$ENDIF}
begin
	AL4.Writeln(s);
	{$IFDEF SIMULATED_TRANSFORMS}
		if not D.Transformed then Exit;
		A := D.Matrix;
        AL4.writeln('m11=' + FloatToStr(A.M11) + ' m12=' + FloatToStr(A.M12) +
            ' m21=' + FloatToStr(A.M21) + ' m22=' + FloatToStr(A.M22) +
            ' eDx=' + FloatToStr(A.Mtx) + ' eDy=' + FloatToStr(A.Mty));
	{$ELSE}
		if C = nil then Exit;
		if not GetWorldTransform(C.Handle, X) then Exit;
            AL4.writeln('m11=' + FloatToStr(X.eM11) + ' m12=' + FloatToStr(X.eM12) +
                ' m21=' + FloatToStr(X.eM21) + ' m22=' + FloatToStr(X.eM22) +
                ' eDx=' + FloatToStr(X.eDx) + ' eDy=' + FloatToStr(X.eDy));
	{$ENDIF}
end;

procedure Do_transform_offset(
	X_C: Ref_obj; Dx, Dy: Double);
//? {Canvas}
    {$IFDEF SIMULATED_TRANSFORMS}
var D: TBitmap_Ex;
	i: Integer;
    {$ELSE}
var C {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    X: TXForm;
    {$ENDIF}
//.    
begin
//? {Canvas}
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if not D.Transformed then
	    	D.Matrix := XIdentity;
	    D.Transformed := TRUE;
	    D.Matrix.mtx := D.Matrix.mtx + D.Matrix.m11 * Dx + D.Matrix.m21 * Dy;
	    D.Matrix.mty := D.Matrix.mty + D.Matrix.m12 * Dx + D.Matrix.m22 * Dy;
    {$ELSE}
	    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
	    if C = nil then Exit;
		    X.eM11 := 1;    X.eM12 := 0;
		    X.eM21 := 0;    X.eM22 := 1;
		    X.eDx := UnitsToCoords(C, C_Units, Dx);
		    X.eDy := UnitsToCoords(C, C_Units, Dy);
		    if  GetGraphicsMode(C.Handle) <> GM_ADVANCED then
		        SetGraphicsMode(C.Handle, GM_ADVANCED);
		    ModifyWorldTransform(C.Handle, X, MULT_DIRECTION);
		    {$IFnDEF BGRABITMAP_CANVAS}
			    if A <> nil then
			    begin
			        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
			            SetGraphicsMode(A.Handle, GM_ADVANCED);
			        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
			    end;
		    {$ENDIF}
		    GetWorldTransform(C.Handle, bitmap_from_canvas(X_C).Matrix);
	    ///////////////////////////////////////
	    {$IFDEF debug_draw}
	    show_world_transform(TBitmap_Ex(X_C), C,
	    'after OFFSET BY ' + FloatToStr(X.eDx) +
	        ',' + FloatToStr(X.eDy) + ':');
	    {$ENDIF}
	    ///////////////////////////////////////
    {$ENDIF}
//.    
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);
//? {Canvas}
var 
	C: TCanvas;
	{$IFDEF SIMULATED_TRANSFORMS}
	D: TBitmap_Ex;
	e11, e12: Double;
    {$ELSE}
var {$IFnDEF BGRABITMAP_CANVAS} A: TCanvas; {$ENDIF}
    C_Units: Integer;
    X: TXForm;
    {$ENDIF}
    cos_, sin_: Single;
//.
begin
//? {Canvas}
	    cos_ := Cos(Angle * PI / 180.0);
	    sin_ := Sin(Angle * PI / 180.0);
    
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if not D.Transformed then
	    	D.Matrix := XIdentity;
	    D.Transformed := TRUE;
	    e11 := cos_ * D.Matrix.m11 + sin_ * D.Matrix.m21;
	    e12 := cos_ * D.Matrix.m12 + sin_ * D.Matrix.m22;
	    D.Matrix.m21 := cos_ * D.Matrix.m21 - sin_ * D.Matrix.m11;
	    D.Matrix.m22 := cos_ * D.Matrix.m22 - sin_ * D.Matrix.m12;
	    D.Matrix.m11 := e11;
	    D.Matrix.m12 := e12;
    {$ELSE}
	    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
	    if C = nil then Exit;
	    	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);
		    {$IFnDEF BGRABITMAP_CANVAS}
			    if A <> nil then
			    begin
			        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
			            SetGraphicsMode(A.Handle, GM_ADVANCED);
			        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
			    end;
		    {$ENDIF}
		    GetWorldTransform(C.Handle, bitmap_from_canvas(X_C).Matrix);
	{$ENDIF}
    //show_world_transform(D, C, 'after ROTATE BY ' + FloatToStr(Angle) + ':');
//.    
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);
//? {Canvas}
    {$IFDEF SIMULATED_TRANSFORMS}
var D: TBitmap_Ex;
	Y: TMatrixRec;
    {$ELSE}
var C  {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    C_Units: Integer;
    X: TXForm;
    {$ENDIF}
//.    
begin
//? {Canvas}   
    {$IFDEF SIMULATED_TRANSFORMS}
    	D := bitmap_from_canvas(X_C);
	    if not D.Transformed then
	    	D.Matrix := XIdentity;
	    D.Transformed := TRUE;
	    D.Matrix.m11 := D.Matrix.m11 * Sx;
	    D.Matrix.m12 := D.Matrix.m12 * Sx;
	    D.Matrix.m21 := D.Matrix.m21 * Sy;
	    D.Matrix.m22 := D.Matrix.m22 * Sy;
    {$ELSE}
	    C := Get_canvas(X_C, C_Units {$IFnDEF BGRABITMAP_CANVAS}, A {$ENDIF});
	    if C = nil then Exit;
		    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);
		    {$IFnDEF BGRABITMAP_CANVAS}
			    if A <> nil then
			    begin
			        if  GetGraphicsMode(A.Handle) <> GM_ADVANCED then
			            SetGraphicsMode(A.Handle, GM_ADVANCED);
			        ModifyWorldTransform(A.Handle, X, MULT_DIRECTION);
			    end;
		    {$ENDIF}
		    GetWorldTransform(C.Handle, bitmap_from_canvas(X_C).Matrix);
	{$ENDIF}
//.
end;


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

FUN String_measure(
	{Canvas} C|anvas_object, STR S|tring_to_measure) ==> {rect}
	:
	REAL v|alues_width_height[] << 0 << 0
	do_String_measure(C, S, v[])
	RESULT = {rect}(Width = v[0], Height = v[1]) .
FUN do_String_measure({Canvas} C|anvas_object, STR S|tring_to_measure,
REAL V|alues_width_height[]), NATIVE :
    "Do_String_measure(X_C, X_S, X_V);" .
    
*/
*)

procedure Do_String_measure(
	X_C: Ref_obj; const X_S: String; X_V: DynAReal);
//?{Canvas}
    var C  {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} : TCanvas;
    var C_Units: Integer;
    var C_F: C_Font;
    var C_C: C_Canvas;
    var Sz: TSize;
//.
begin
//?{Canvas}
    C := Get_canvas(X_C, C_Units  {$IFnDEF BGRABITMAP_CANVAS} , A {$ENDIF} );
    if C = nil then Exit;
    
    C_C := C_Canvas(X_C.Obj);
    C_F := C_C.F_Font.Obj as C_Font;
	    C.Font.Name := C_F.F_Face;
		C.Font.Size := Trunc(C_F.F_Size);
    C.Font.Style := Get_font_style(C_F);
    	Sz := C.TextExtent(X_S);
	    X_V.SetReals(0, UnitsFromCoords(C, C_Units, Sz.cx));
	    X_V.SetReals(1, UnitsFromCoords(C, C_Units, Sz.cy));
//.
end;


(*
/*

FUNCTION Set_control_cursor_shape(
    INT H|andle_control,
    {Paintbox}.{cursor} C|ursor_shape ), NATIVE :
@   "var C: TWinControl;"
	"	{$IFDEF USE_LISTS_OF_DESCRIPTORS}"
    "    C := TWinControl(All_controls[X_H]);"
    "	{$ELSE}"
    "    C := TWinControl(X_H);"
    "	{$ENDIF}"
    "    Do_set_wincontrol_cursor(C, X_C);"
    .
    
*/
*)

procedure Do_set_wincontrol_cursor(
	C: TWinControl; Cursor: Integer);
begin
	//{$IFDEF FPC}
	if C is TScrolled_paintbox then
		C := TScrolled_paintbox(C).PBox;
	//{$ENDIF}
    C.HandleNeeded;
    //writeln('-------------set cursor to ' + IntToStr(Cursor) + ' for control ' +
    //    IntToStr(C.Handle)); //////////////////////////////////////
    case Cursor of 
    0: {$IFDEF LINUX}
    	C.Cursor := 0;
       {$ELSE}
		C.Cursor := crArrow;
       {$ENDIF}
    1: C.Cursor := crIBeam;
    2: C.Cursor := crNo;
    3: C.Cursor := crCross;
    4: C.Cursor := crHandPoint;
    5: C.Cursor := crHourGlass;
    6: C.Cursor := crAppStart;
    7: C.Cursor := crUpArrow;
    8: C.Cursor := crSizeAll;
    9: C.Cursor := crSizeWE;
    10: C.Cursor := crSizeNS;
    11: C.Cursor := crSizeNESW;
    12: C.Cursor := crSizeNWSE;
    13: C.Cursor := crHelp;
    end;
end;

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

FUNCTION Provide_window_caret(
    INT W|indow_handle,
    REAL X|_pos_points,
    REAL Y|_pos_points,
    REAL Caret_w|idth_points,
    REAL Caret_h|eight_points), NATIVE
    :
    INT off_x|_in_pixels = {AL4_form}.Points(X)
    INT off_y|_in_points = {AL4_form}.Points(Y)
    INT w_caret|_pixels = {AL4_form}.Points(Caret_w)
    INT h_caret|_pixels = {AL4_form}.Points(Caret_h)
    //DEBUG:
    //      << "Provide window caret X=" X " Y=" Y " off_x=" off_x 
    //      " off_Y=" off_y #NL; 
    NATIVE @
    "Do_provide_window_caret(X_W, X_off_x, X_off_y, X_w_caret, X_h_caret);" .
*/
*)

procedure Do_provide_window_caret(
	X_W, off_x, off_y, w_caret, h_caret: Integer);
var SPB: TScrolled_paintbox;
    W: THandle;
begin
	if X_W = 0 then Exit;
	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
    	SPB := TScrolled_paintbox(All_controls[X_W]);
	{$ELSE}
    	SPB := TScrolled_paintbox(X_W);
	{$ENDIF}
    W := SPB.PBox.Handle;
    if w_caret < 1 then w_caret := 1;
    {$IFDEF SIMULATED_CARET}
	    if SPB.CaretBox = nil then
	    begin
	    	SPB.CaretBox := TPaintPanel.Create(SPB);
	    	SPB.CaretBox.Parent := SPB;
	    	SPB.CaretBox.OnPaint_Scrolled_paintbox 
	    		:= {$IFDEF OBJFPC}@{$ENDIF} SPB.CaretPaint;
	    	SPB.CaretTimer := TTimer.Create(SPB);
	    	SPB.CaretTimer.Interval := 300;
	    	SPB.CaretTimer.OnTimer := {$IFDEF OBJFPC}@{$ENDIF} SPB.CaretTick;
	    end;
		SPB.CaretBox.Width := w_caret;
		SPB.CaretBox.Height := AL4_form.Points(SPB.line_height);
		SetPos(SPB.CaretBox, off_x, off_y);
	    
	    SPB.CaretBox.Visible := TRUE;
	    //{$IFnDEF FPC}
	    SPB.AL4Form.Set_Active_Control(SPB.PBox);
	    //{$ENDIF}
    {$ELSE}
		    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;
    {$ENDIF}
end;

{$IFDEF SIMULATED_CARET}

procedure TScrolled_paintbox.CaretTick(Sender: TObject);
begin
	//writeln('caret tick ' + IntToStr(CaretColor));
	if CaretBox = nil then
	begin
		CaretTimer.Enabled := FALSE;
		FreeAndNil(CaretTimer); 
		Exit;
	end;
	if not CaretBox.Visible then
	begin
		CaretBox.Visible := TRUE;
		CaretBox.BringToFront;
		Exit;
	end;
	inc(CaretColor);
	if CaretColor mod 3 = 0 then
		CaretBox.Visible := not CaretBox.Visible;
	CaretBox.Invalidate;
end;

procedure TScrolled_paintbox.CaretPaint(Sender: TObject);
var C: TCanvas;
begin
	if CaretBox = nil then
	begin
		CaretTimer.Enabled := FALSE;
		FreeAndNil(CaretTimer); 
		Exit;
	end;
	C := CaretBox.Canvas;
	if CaretColor mod 3 = 1 then
		C.Brush.Color := clBlack
	else
		C.Brush.Color := clWhite;
	C.FillRect(Rect(0, 0, CaretBox.Width, CaretBox.Height));
end;
{$ENDIF} 

(*
/*

FUNCTION Destroy_window_caret(INT W|indow_handle), NATIVE :
@   "Do_destroy_window_caret(X_W);" .
*/
*)

procedure Do_destroy_window_caret(
	X_W: Integer);
var SPB: TScrolled_paintbox;
begin
 	{$IFDEF USE_LISTS_OF_DESCRIPTORS}
 	 SPB := TScrolled_paintbox(All_controls[X_W]);
 	{$ELSE}
     SPB := TScrolled_paintbox(X_W);
 	{$ENDIF}
    {$IFDEF SIMULATED_CARET}
	    if SPB.CaretBox = nil then Exit;
	    SPB.CaretTimer.Enabled := FALSE;
	    FreeAndNil(SPB.CaretTimer);
	    FreeAndNil(SPB.CaretBox);
    {$ELSE}
    	HideCaret(SPB.PBox.Handle);
    {$ENDIF}
end;

(*
/*

FUNCTION Set_canvas_quality(
	{Canvas} C|anvas_object, {Canvas}.{quality} Q|uality_set) : .
	
FUN End_paint_of_canvas(
	{Canvas} C|anvas_object_dummy), NATIVE: @
	"" .
*/
*)

(*
/*
END
*/
*)

end.

