(*
/*

CLASS {Delphi_to_al4|_convert_legacy_code_using_SyNTAX_PASCAL},
UNTESTED, STOPPING, RECURSIVE, BITWISE, BYTES:

IMPORT: {Bitmap}, {Bitmap_direct}, {Canvas}, {Timer}, {File_path}, {Geometry},
		{Control}, {Paintbox}, {String_functions}, {Bmp} .
		
FUN AsInt|_from_both_real_and_int(
REAL V|alue_from) ==> INT
	:= V.Int .
	
FUN PChar|_dummy(STR S|tring_to_pchar) ==> STR := S .

FUN Integer|_from_any(INT X|_parameter) ==> INT := X .

FUN Length|_of_string(
STR S|tring_to_measure) ==> INT := S.Len .
                                             
CONST INT:
	ssShift|_shift_key_pressed = 1
	ssCtrl|_control_key_pressed = 2
	ssAlt|_alt_key_pressed = 4 .
	
FUN Rect|angle(REAL X|_coordinate, REAL Y|_coordinate,
	REAL Right|_side, REAL Bottom|_side) ==> {rect}
	:
	RESULT = {rect}(Loc = Pt(X, Y), Width= Right - X, Height= Bottom - Y) .
	
FUN ClientBounds|_of_control_in_pixels(
{Control} C|ontrol_passed) ==> {rect}
	:= {rect}(Width = C.Width.Points_to_pixels,
			  Height = C.Height.Points_to_pixels) .
	
FUN PtInRect||PointInRect(
{rect} R|ectangle, {point} P|oint_checking) ==> BOOL
	:= R.Contains_pt(P) .

FUN Point|_of_2_coords(
REAL X|_coordinate, REAL Y|_coordinate) ==> {Geometry}.{point}
	:= Pt(X, Y) .
	
FUN Form_X_Points_to_Control_Pixels(
{Control} C|ontrol_where_mouse_event_occur, REAL X|_mouse_coordinate) ==> INT
	:= (X - C.Bounds.Loc.X).Points_to_pixels . 

FUN Form_Y_Points_to_Control_Pixels(
{Control} C|ontrol_where_mouse_event_occur, REAL Y|_mouse_coordinate) ==> INT
	:= (Y - C.Bounds.Loc.Y).Points_to_pixels . 

FUN NewBitmap(
INT Width|_bmp, INT Height|_bmp, INT Bits|_per_pixel) ==> {Bitmap}
	:= New_bitmap(Width, Height, Bits) .
	
FUN NewBitmapDirect(
INT Width|_bmp, INT Height|_bmp, INT Bits|_per_pixel) ==> {Bitmap_direct}
	:= New_bitmap_direct(Width, Height, Bits) .
	
FUN Get_bitmap_pixel(
{Bitmap_direct} B|itmap_source, INT X|_coordinate, INT Y|_coordinate) ==> INT
	:
	--------------------- 'locking Y row', REUSED
	CASE B.Locked && B.Locked_height > 0 && (B.Locked_h != 1 || B.Locked_Y != Y)
		 ?
	     B.Unlock(TRUE) ;
	CASE !B.Locked ?
		 B.Lock_rows(Y, 1, TRUE)
	; 
	INT bpp||bytes_per_pixel = B.Bpp / 8
	CASE bpp < 3 ? ==> ;
	-------------------- 'locked'
	RESULT = B.Pixels[X * bpp] | B.Pixels[X * bpp + 1].ShiftL(8)
		| B.Pixels[X * bpp + 2].ShiftL(16) .
	
FUN Set_bitmap_pixel(
{Bitmap_direct} B|itmap_source, INT X|_coordinate, INT Y|_coordinate,
INT Color|_value_to_set_R_G_B)
	:
	LIKE Get_bitmap_pixel .......... 'locking Y row'
	B.Pixels[X * bpp] = Color
	B.Pixels[X * bpp + 1] = Color.ShiftR(8)
	B.Pixels[X * bpp + 2] = Color.ShiftR(16) .
	
FUN LoadBitmap(STR Path|_file) ==> {Bitmap}, NEW :
	//RESULT = {Bitmap}.Load(Path) .
	RESULT = {Bmp}.From_file(Path) .
	
FUN SaveBitmap(
{Bitmap} B|itmap_source, STR Path|_destination)
	:
	NONE = B.Save(Path) .
	
FUN DrawBitmap(
{Canvas} Dest|ination, REAL X|_coordinate, REAL Y|_coordinate,
{Bitmap} Bitmap|_object)
	:
	Bitmap.Draw(Dest, Pt(X, Y)) .
	
FUN CopyRect(
{Canvas} Dest|ination, {rect} R_dest|ination,
{Canvas} Source|_canvas, {rect} R_source)
	:
	Dest.Copy_rect(R_dest, Source, R_source) .
	
FUN FillRect(
{Canvas} Dest|ination, {Geometry}.{rect} Filling_r|ectangle)
	:
	PUSH Dest.Pen_style = 'CLEAR_PEN' :
		 Dest.Rect(Filling_r) ; .
	
FUN SetBrush(
{Canvas} Canv|as_destination, BOOL Solid|_ifTrue_or_clear_ifFalse,
INT Color|_for_solid_color)
	:
	CASE Solid ? Canv.Brush = 'SOLID_BRUSH'
	ELSE Canv.Brush = 'CLEAR_BRUSH' ;
	Canv.Background = Color .
	
FUN SetPen|_width_and_color(
{Canvas} Canv|as_destination, INT Pen_w|idth, INT Color|_for_pen)
	:
	Canv.Pen_width = Pen_w
	Canv.Foreground = Color .
	
FUN SetUnitsPixels(
{Canvas} C|anvas_of_bitmap)
	: C.Units = 'PIXELS' .
	
FUN DrawRect({Canvas} Dest|ination, {rect} R|ectangle) :
	Dest.Rect(R) .
	
FUN Invalidate({Paintbox} PBox|_control) :
	PBox.Invalidate_all .
	
CONST INT:
	CLBLACK|_0 = 0xFF000000
	CLWHITE|_FFFFFF = 0xFFFFFFFF
	CLRED|_red = 0xFF0000FF
	CLGREEN|_green = 0xFF00FF00
	CLYELLOW = 0xFF00FFFF .
	
CONST INT {system_colors} :
	CLACTIVECAPTION = 0xFF0000_02
	CLGRADIENTACTIVECAPTION = 0xFF0000_1B
	CLACTIVEBORDER = 0xFF000000_0A
	CLCAPTIONTEXT = 0xFF000000_09
	CLBTNFACE = 0xFF000000_0F
	CLBTNTEXT = 0xFF000000_12
	CLBTNHIGHLIGHT = 0xFF000000_14
	CLBTNSHADOW = 0xFF0000_0A
	CLAPPWORKSPACE = 0xFF0000_0C
	CLGRAYTEXT = 0xFF0000_11
	CLINFOBK = 0xFF0000_18
	CLINFOTEXT = 0xFF0000_17
	CLINACTIVECAPTION = 0xFF0000_03
	CLGRADIENTINACTIVECAPTION = 0xFF0000_1C
	CLINACTIVEBORDER = 0xFF0000_0B
	CLINACTIVECAPTIONTEXT = 0xFF0000_13
	CLMENU|_BACKGROUND = 0xFF0000_04
	CLMENUTEXT = 0xFF0000_07
	CLMENUHIGHLIGHT = 0xFF0000_1D
	CLSCROLLBAR = 0xFF0000_05
	CLWINDOW = 0xFF0000_05
	CLWINDOWTEXT = 0xFF0000_08
	CLWINDOWFRAME = 0xFF0000_06 .
	
FUN SystemColor(INT Color_index) ==> INT,
IF Color_index IS CONST, THEN Color_index IN {system_colors}
	:
	CASE Color_index ?
	[CLACTIVECAPTION]: RESULT = System_color('ACTIVE_CAPTION')
	[CLGRADIENTACTIVECAPTION]: RESULT = System_color('ACTIVE_GRADIENT')
	[CLACTIVEBORDER]: RESULT = System_color('ACTIVE_BORDER')
	[CLCAPTIONTEXT]: RESULT = System_color('ACTIVE_TEXT')
	[CLBTNFACE]: RESULT = System_color('BUTTON')
	[CLBTNTEXT]: RESULT = System_color('BUTTON_TEXT')
	[CLBTNHIGHLIGHT]: RESULT = System_color('BUTTON_HIGHLIGHT')
	[CLBTNSHADOW]: RESULT = System_color('BUTTON_SHADOW')
	[CLAPPWORKSPACE]: RESULT = System_color('DESKTOP')
	[CLGRAYTEXT]: RESULT = System_color('GRAY_TEXT')
	[CLINFOBK]: RESULT = System_color('HELP')
	[CLINFOTEXT]: RESULT = System_color('HELP_TEXT')
	[CLINACTIVECAPTION]: RESULT = System_color('INACTIVE_CAPTION')
	[CLGRADIENTINACTIVECAPTION]: RESULT = System_color('INACTIVE_GRADIENT')
	[CLINACTIVEBORDER]: RESULT = System_color('INACTIVE_BORDER')
	[CLINACTIVECAPTIONTEXT]: RESULT = System_color('INACTIVE_TEXT')
	[CLMENU]: RESULT = System_color('MENU')
	[CLMENUTEXT]: RESULT = System_color('MENU_TEXT')
	[CLMENUHIGHLIGHT]: RESULT = System_color('MENU_HIGHLIGHT')
	//[CLSCROLLBAR]: RESULT = System_color('SCROLLBAR')
	[CLWINDOW]: RESULT = System_color('WINDOW')
	[CLWINDOWTEXT]: RESULT = System_color('WINDOW_TEXT')
	[CLWINDOWFRAME]: RESULT = System_color('WINDOW_FRAME') ; .
	 
FUN BoundsRect({Control} C|ontrol_delphi) ==> {rect} :
	RESULT = C.Bounds .
	
FUN ActivateTimer(
{Timer} T|imer_to_activate_or_deactrivate, BOOL A|ctivate_if_true)
	:
	T.Set_active(A) .
	
FUN TimerIsActive({Timer} T|imer_to_inspect) ==> BOOL
	:= T.Active .
	
FUN ExtractFilePath(STR Path|_full) ==> STR
	:= Extract_path(Path) .
	
FUN ExtractFileExt(STR Path|_full) ==> STR
	:= Path.Ext.Lower .
	
FUN IntToStr|ing(REAL V|alue_to_convert) ==> STR 
	:= V.Int.S .

FUN Int2Str|ing(REAL V|alue_to_convert) ==> STR := V.Int.S .

FUN RemoveTrailingSlash(
STR Path|_to_remove_ending_slash) ==> STR
	:= Path.Remove_ending(Path_sep) .
	
FUN FileExists(STR Path|_file) ==> BOOL := Path.Exists .

FUN DeleteFile(STR Path|_file) : Path.Delete_file . 

FUN Halt|_program :
	STOP "Program halted" .

END

*/
*)

unit Delphi_to_AL4;

interface

uses Types, Windows, Classes, Forms, Controls, Graphics, ExtCtrls, SysUtils;

function AsInt(X: Integer): Integer; overload;
function AsInt(X: Double): Integer; overload;
function Inflate(R: TRect; dX, dY: Double): TRect;
function ClientBounds(C: TControl): TRect;
function Form_X_Points_to_Control_Pixels(C: TControl; X: Double): Integer;
function Form_Y_Points_to_Control_Pixels(C: TControl; Y: Double): Integer;

function NewBitmap(Width, Height: Integer; BitsPerPixel: Integer): TBitmap;
function NewBitmapDirect(
	Width, Height: Integer; BitsPerPixel: Integer): TBitmap;
function Get_bitmap_pixel(Bmp: TBitmap; x, y: Integer): Integer;
procedure Set_bitmap_pixel(Bmp: TBitmap; x, y: Integer; Color: Integer);
function LoadBitmap(const Path: String): TBitmap;
procedure SaveBitmap(B: TBitmap; Path: String);

procedure DrawBitmap(Dest: TCanvas; X, Y: Integer; Bmp: TBitmap);
procedure SetBrush(Dest: TCanvas; Solid: Boolean; Color: Integer);
procedure SetPen(Dest: TCanvas; Pen_w: Double; Color: Integer);
procedure SetUnitsPixels(Dest: TCanvas);
procedure DrawRect(Dest: TCanvas; R: TRect);
function SystemColor(c: Integer): Integer;

type Trgb = (rgbR, rgbG, rgbB, rgbA);
function Mask_RGB(Component: Trgb): Integer;
function Shift_RGB(Component: Trgb): Integer;

procedure ActivateTimer(Timer: TTimer; Activate: Boolean);
function TimerIsActive(Timer: TTimer): Boolean;
procedure Catalog(const Path: String; cat: TStringList);

procedure SetControlVisible(C: TControl; Show: Boolean);

function RemoveTrailingSlash(const s: String): String;
function Replace_all(const S, From, To_: String): String;

implementation

function AsInt(X: Integer): Integer;
begin
	Result := X;
end;

function AsInt(X: Double): Integer;
begin
	Result := Trunc(X);
end;


function Inflate(R: TRect; dX, dY: Double): TRect;
begin
	Result := R;
	InflateRect(Result, Trunc(dX), Trunc(dY));
end;

function ClientBounds(C: TControl): TRect;
begin
	Result := C.ClientRect;
end;

function Form_X_Points_to_Control_Pixels(C: TControl; X: Double): Integer;
begin
	Result := Trunc(X);
end;

function Form_Y_Points_to_Control_Pixels(C: TControl; Y: Double): Integer;
begin
	Result := Trunc(Y);
end;


function NewBitmap(Width, Height: Integer; BitsPerPixel: Integer): TBitmap;
begin
    Result := TBitmap.Create;
    Result.Width := Width;
    Result.Height := Height;
    Result.HandleType := bmDIB;
    case BitsPerPixel of
    1: Result.PixelFormat := pf1bit;
    4: Result.PixelFormat := pf4bit;
    8: Result.PixelFormat := pf8bit;
    15: Result.PixelFormat := pf15bit;
    16: Result.PixelFormat := pf16bit;
    24: Result.PixelFormat := pf24bit;
    else Result.PixelFormat := pf32bit;
    end;
end;

function NewBitmapDirect(
	Width, Height: Integer; BitsPerPixel: Integer): TBitmap;
begin
	Result := NewBitmap(Width, Height, BitsPerPixel);
end;

function Get_bitmap_pixel(Bmp: TBitmap; x, y: Integer): Integer;
begin
	Result := Bmp.Canvas.Pixels[x, y];
end;

procedure Set_bitmap_pixel(Bmp: TBitmap; x, y: Integer; Color: Integer);
begin
	Bmp.Canvas.Pixels[x, y] := Color; 
end;

function LoadBitmap(const Path: String): TBitmap;
begin
	Result := TBitmap.Create;
	Result.LoadFromFile(Path);
end;

procedure SaveBitmap(B: TBitmap; Path: String);
begin
	B.SaveToFile(Path);
end;

procedure DrawBitmap(Dest: TCanvas; X, Y: Integer; Bmp: TBitmap);
begin
	Dest.Draw(X, Y, Bmp);
end;

procedure SetBrush(Dest: TCanvas; Solid: Boolean; Color: Integer);
begin
	Dest.Brush.Color := Color;
	if Solid then Dest.Brush.Style := bsSolid
	else Dest.Brush.Style := bsClear;
end;

procedure SetPen(Dest: TCanvas; Pen_w: Double; Color: Integer);
begin
	Dest.Pen.Width := Trunc(Pen_w);
	Dest.Pen.Color := Color;
end;

procedure SetUnitsPixels(Dest: TCanvas);
begin
	// in usual Delphi, just do nothing
end;

procedure DrawRect(Dest: TCanvas; R: TRect);
var c: TColor;
	bs: TBrushStyle;
begin
	Dest.FillRect(R);
	c := Dest.Brush.Color;
	bs := Dest.Brush.Style;
	//----- pen --> brush
	Dest.Brush.Color := Dest.Pen.Color;
	Dest.Brush.Style := bsSolid;
	Dest.FrameRect(R);
	//----- restore brush
	Dest.Brush.Color := c;
	Dest.Brush.Style := bs;
end;

function SystemColor(c: Integer): Integer;
begin
	Result := c;
end;

function Mask_RGB(Component: Trgb): Integer;
begin
	Result := $FF shl Shift_RGB(Component);
end;

function Shift_RGB(Component: Trgb): Integer;
begin
	Result := 0;
	case Component of
	rgbR: Result := 0;
	rgbG: Result := 8;
	rgbB: Result := 16;
	rgbA: Result := 24;
	end;
end;

procedure ActivateTimer(Timer: TTimer; Activate: Boolean);
begin
	Timer.Enabled := Activate;
end;

function TimerIsActive(Timer: TTimer): Boolean;
begin
	Result := Timer.Enabled;
end;

procedure Catalog(const Path: String; cat: TStringList);
var FindFile: TSearchRec;
begin
	cat.Clear;
	if FindFirst(Path + '\*.*', 0, FindFile) = 0 then
	begin
		REPEAT
			cat.Add( FindFile.Name );
		UNTIL FindNext( FindFile ) <> 0;
      	FindClose( FindFile );
	end;
end;

procedure SetControlVisible(C: TControl; Show: Boolean);
begin
	C.Visible := Show;
end;

function RemoveTrailingSlash(const s: String): String;
begin
	Result := s;
	if (Result <> '') and (Result[Length(Result)] = '\') then
		Result := Copy(Result, 1, Length(Result)-1);
end;

function Replace_all(const S, From, To_: String): String;
begin
	Result := StringReplace(S, From, To_, [rfReplaceAll]);
end;

end.

