Page 1 of 2

FreeBasic

Posted: Mon Jan 28, 2013 3:34 am
by 0CodErr
Попробовал написать на FreeBasic приложение для KolibriOS.
Программа "Test_Window.bas" просто выводит окно по центру экрана.

Исходный код для FreeBasic:
Spoiler:

Code: Select all


	' Event Constants
	Const REDRAW_EVENT  =  1
	Const KEY_EVENT     =  2
	Const BUTTON_EVENT  =  3
	
	
	' Window Style Constants
	Const WS_SKINNED_FIXED      = &H4000000
	Const WS_SKINNED_SIZABLE    = &H3000000
	Const WS_FIXED              = &H0000000
	Const WS_SIZABLE            = &H2000000
	Const WS_FILL_TRANSPARENT   = &B1000000000000000000000000000000
	Const WS_FILL_GRADIENT      = &B10000000000000000000000000000000
	Const WS_COORD_CLIENT       = &B100000000000000000000000000000
	Const WS_CAPTION            = &B10000000000000000000000000000
  
  
	' Color Constants
	Const COLOR_BLUE  =  &H000000FF
	Const COLOR_RED   =  &H00FF0000
	Const COLOR_GREEN =  &H0000FF00
	Const COLOR_WHITE =  &H00FFFFFF
	Const COLOR_BLACK =  &H00000000
  
  
	Dim Shared Window_width       As Long = 200
	Dim Shared Window_height      As Long = 300
	Dim Shared Window_left        As Long
	Dim Shared Window_top         As Long


	Type Size
		height As UShort
		width  As UShort
	End Type

	Dim Shared Scr     As Size

	Dim Shared Caption As ZString Ptr = @"Hello, FreeBasic!"

	Declare Sub On_Redraw()
	Declare Sub Event_Processor()
	Declare Sub On_KeyPress() 
	Declare Sub On_ButtonPress() 
	Declare Function WAIT_EVENT() As Long
	Declare Function GET_KEY_CODE() As Long
	Declare Function GET_BUTTON_NUMBER() As Long
	Declare Function GET_SCREEN_SIZE() As size 
	Declare Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)


	#Macro PROGRAM_TERMINATE()
		Asm
			or eax, -1
			int 64
		End Asm
	#EndMacro
	
	#Macro REDRAW_START()
		Asm
			mov eax, 12
			mov ebx, 1
			int 64		
		End Asm
	#EndMacro
	
	#Macro REDRAW_FINISH()
		Asm
			mov eax, 12
			mov ebx, 2
			int 64		
		End Asm
	#EndMacro





                  Sub Main()

                    Scr = GET_SCREEN_SIZE()
                    Window_width  = Scr.width Shr 1
                    Window_height = Scr.height Shr 1
                    Window_left   = (Scr.width  - Window_width) Shr 1
                    Window_top    = (Scr.height - Window_height) Shr 1

                    On_Redraw
                    Do
                      Event_Processor
                    Loop
                  End Sub

'========================================================='  
'                  Обработка Событий
'========================================================='  
                  Sub Event_Processor()
                    Select Case WAIT_EVENT()
                    Case REDRAW_EVENT
                      On_Redraw
                    Case KEY_EVENT
                      On_KeyPress
                    Case BUTTON_EVENT
                      On_ButtonPress
                    End Select
                  End Sub

'========================================================='  
'                  Нажатие Клавиатуры
'========================================================='  
                  Sub On_KeyPress()
                    GET_KEY_CODE
                  End Sub

'========================================================='  
'                    Нажатие Кнопки
'========================================================='  
                  Sub On_ButtonPress()
                    Select Case GET_BUTTON_NUMBER()
                    Case 1
                      PROGRAM_TERMINATE()
                    End Select
                  End Sub
 
 
'========================================================='  
'                   Перерисовка
'========================================================='  
                  Sub On_Redraw()
                    REDRAW_START()
                    DRAW_WINDOW   Window_left, Window_top, Window_width, Window_height, *Caption, COLOR_WHITE,  WS_SKINNED_SIZABLE + WS_COORD_CLIENT + WS_CAPTION
                    REDRAW_FINISH()
                  End Sub






Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
	Asm
		xor eax, eax
		mov ebx, [Window_left]
		shl ebx, 16
		add ebx, [Window_width]
		mov ecx, [Window_top]
		shl ecx, 16
		add ecx, [Window_height]
		mov edx, [Style]
		or	edx, [BackColor]
		mov	edi, [Caption]
		int 64
	End Asm
End Sub


Function WAIT_EVENT() As Long
	Asm
		mov eax, 10
		int 64
		mov [Function], eax
	End Asm
End Function


Function GET_KEY_CODE() As Long
	Asm
	  mov eax, 2
	  int 64
		mov [Function], eax
	End Asm
End Function


Function GET_BUTTON_NUMBER() As Long
	Asm
		mov eax, 17
		int 64
		shr eax, 8
		mov [Function], eax
	End Asm
End Function


Function GET_SCREEN_SIZE() As size
	Asm
		mov eax, 61
		mov ebx, 1
		int 64
	  mov [Function], eax
	End Asm
End Function

Теперь делаем:

Code: Select all

 
fbc -R -c "Test_Window.bas"

В папке с проектом появляются файлы "Test_Window.asm" и "Test_Window.o"

Для удобства создадим "make.bat":

Code: Select all

Set Name=Test_Window

"..\..\FreeBASIC\bin\win32\ld" -T"LScript.x" "%Name%.o" -o "%Name%.bin" 
"..\..\FreeBASIC\bin\win32\objcopy" -O binary  -j .text -j .data -j .bss "%Name%.bin" "%Name%.kex"

pause
Изначально objcopy в той папке нет, но я его туда закинул.

Так выглядит "LScript.x":
Spoiler:

Code: Select all

PATH_SIZE    =  1024;
PARAMS_SIZE  =   256;
STACK_SIZE   =   256;

SECTIONS
{

  .text  : AT(0) {
    code = .;

        LONG(0x554e454D);
        LONG(0x31305445);
        LONG(1);
        LONG(start);
        LONG(end);
        LONG(end + PATH_SIZE + PARAMS_SIZE + STACK_SIZE);
        LONG(end + PATH_SIZE + PARAMS_SIZE + STACK_SIZE);
        LONG(end + PATH_SIZE);
        LONG(end);

		start = .;
		
    *(.text)

  }
	
  .data : AT(data - code) {data = .; *(.data)}
	
  .bss  : AT(bss - code)  {bss = .;  *(.bss)}
	
  end = .;
}
Теперь запускаем "make.bat". Создаются файлы "Test_Window.bin" и "Test_Window.kex".

Вот так выглядит окно полученной программы:
Spoiler:Image

Re: FreeBasic

Posted: Mon Jan 28, 2013 2:55 pm
by SoUrcerer
Здорово. Теперь предлагаю собрать FreeBasic под Колибри.

Re: FreeBasic

Posted: Mon Jan 28, 2013 5:03 pm
by Albom
SoUrcerer wrote:Здорово. Теперь предлагаю собрать FreeBasic под Колибри.
FreeBasic использую постоянно - как средство быстрой разработки. И как-то интересовался его сборкой. Из FAQ:
I'm developing an OS, can FreeBASIC be ported to my OS ?

Depends. If your OS at least egalizes the functionality of DOS with DPMI32 (console I/O (seeking, multiple files open, ...), file I/O, memory management) and has a port of GCC, then the answer is YES. If you have at least an other somewhat compliant C compiler with libraries, it might be possible. You can't reasonably port FB for example to an OS allowing to load or save a file in one block only, or a 16-bit OS.

Re: FreeBasic

Posted: Mon Jan 28, 2013 5:27 pm
by SoUrcerer
Да, я тоже смотрел на FB - его порт абсолютно реален, но мне не очень интересен из-за высокой трудоемкости и не очень высокой отдачи. Все же FreeBasic "тяжеловат".

Re: FreeBasic

Posted: Mon Jan 28, 2013 5:51 pm
by Albom
Ну, может, в отдалённом будущем... :)

Re: FreeBasic

Posted: Thu Mar 28, 2013 6:57 pm
by 0CodErr
Пример с ColorDialog.
По нажатию на кнопку вызывается диалог, в котором можно выбрать цвет этой кнопки.

Исходный код:
Spoiler:

Code: Select all


  ' Event Constants
  Const REDRAW_EVENT  =  1
  Const KEY_EVENT     =  2
  Const BUTTON_EVENT  =  3
  
  
  ' Window Style Constants
  Const WS_SKINNED_FIXED    = &H4000000
  Const WS_SKINNED_SIZABLE  = &H3000000
  Const WS_FIXED            = &H0000000
  Const WS_SIZABLE          = &H2000000
  Const WS_FILL_TRANSPARENT = &B1000000000000000000000000000000
  Const WS_FILL_GRADIENT    = &B10000000000000000000000000000000
  Const WS_COORD_CLIENT     = &B100000000000000000000000000000
  Const WS_CAPTION          = &B10000000000000000000000000000
  
  
  ' Button Style Constants
  Const BS_FILL_TRANSPARENT = &B1000000000000000000000000000000
  Const BS_NO_FRAME         = &B100000000000000000000000000000
   
  ' Color Constants
  Const COLOR_BLUE  = &H000000FF
  Const COLOR_RED   = &H00FF0000
  Const COLOR_GREEN = &H0000FF00
  Const COLOR_WHITE = &H00FFFFFF
  Const COLOR_BLACK = &H00000000
  
  Const BORDER_SIZE = 5
  
  ' Button Identifiers
  Const BUTTON_OPEN = 10
  

  Type Size
    height As UShort
    width  As UShort
  End Type

  Type ColorDialog
    mode          As ULong 
    procinfo      As ULong 
    com_area_name As ULong 
    com_area      As ZString Ptr 
    start_path    As ZString Ptr 
    draw_window   As Sub 
    status        As ULong
    x_size        As UShort
    x_start       As UShort
    y_size        As UShort
    y_start       As UShort
    color_type    As ULong
    Color         As ULong
  End Type   

  
  Dim Shared Scr  As Size  
  
  Dim Shared Window_width  As Long 
  Dim Shared Window_height As Long 
  Dim Shared Window_left   As Long
  Dim Shared Window_top    As Long

  Dim Shared Button_width  As Long = 45
  Dim Shared Button_height As Long = 25
  Dim Shared Button_left   As Long
  Dim Shared Button_top    As Long

  Dim Shared Caption As ZString Ptr = @"Test_ColorDialog"

  DIM Shared sz_proc_lib          As ZString Ptr = @"/rd/1/lib/proc_lib.obj"
  DIM Shared sz_ColorDialog_init  As ZString Ptr = @"ColorDialog_init"
  DIM Shared sz_ColorDialog_start As ZString Ptr = @"ColorDialog_start"
  DIM Shared sz_com_area_name     As ZString Ptr = @"FFFFFFFF_color_dialog"
  DIM Shared sz_start_path        As ZString Ptr = @"/rd/1/colrdial"
  
  Dim Shared proc_lib As Long
  
  Dim Shared CD As ColorDialog
    

  Declare Function WAIT_EVENT() As Long
  Declare Function GET_KEY_CODE() As Long
  Declare Function GET_BUTTON_NUMBER() As Long
  Declare Function GET_SCREEN_SIZE() As size 	
  Declare Function LOAD_LIBRARY(filename As ZString) As Long
  Declare Function MEMORY_ALLOCATE(bytes As ULong) As ULong
  Declare Function SKIN_HEIGHT() As Long
	
  Declare Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  Declare Sub DRAW_BUTTON(identifier As Long, Button_left As Long, Button_top As Long, Button_width As Long, Button_height As Long, Button_Color As Long, Style As Long)
  
  Declare Function GetProcAddress(hLib As Long, procname As ZString) As Long
	  
  Declare Sub On_Redraw()
  Declare Sub Event_Processor()
  Declare Sub On_KeyPress() 
  Declare Sub On_ButtonPress() 
  Declare Sub On_ButtonOpenPress()

  Dim Shared ColorDialog_init  As Sub(ColorDialog As ColorDialog) 
  Dim Shared ColorDialog_start As Sub(ColorDialog As ColorDialog) 

  
  #Macro PROGRAM_TERMINATE()
    Asm
      or eax, -1
      int 64
    End Asm
  #EndMacro
  
  #Macro REDRAW_START()
    Asm
      mov eax, 12
      mov ebx, 1
      int 64    
    End Asm
  #EndMacro
  
  #Macro REDRAW_FINISH()
    Asm
      mov eax, 12
      mov ebx, 2
      int 64    
    End Asm
  #EndMacro




                  Sub Main()
                    Scr = GET_SCREEN_SIZE()
                    
                    Window_width  = Scr.width  Shr 2
                    Window_height = Scr.height Shr 2
                    Window_left   = (Scr.width  - Window_width)  Shr 1
                    Window_top    = (Scr.height - Window_height) Shr 1
                    
                    Button_left = (Window_width  - Button_width) Shr 1  - BORDER_SIZE
                    Button_top  = (Window_height - Button_height - SKIN_HEIGHT() - BORDER_SIZE) Shr 1

                    proc_lib          = LOAD_LIBRARY(*sz_proc_lib)
                    ColorDialog_init  = GetProcAddress(proc_lib, *sz_ColorDialog_init)
                    ColorDialog_start = GetProcAddress(proc_lib, *sz_ColorDialog_start)

                    CD.procinfo      = MEMORY_ALLOCATE(4096) 
                    CD.com_area_name = sz_com_area_name 
                    CD.start_path    = sz_start_path  
                    CD.draw_window   = @On_Redraw

                    ColorDialog_init(CD)

                    On_Redraw
                    Do
                      Event_Processor
                    Loop
                  End Sub

'========================================================='  
'                  Обработка Событий
'========================================================='  
                  Sub Event_Processor()
                    Select Case WAIT_EVENT()
                    Case REDRAW_EVENT
                      On_Redraw
                    Case KEY_EVENT
                      On_KeyPress
                    Case BUTTON_EVENT
                      On_ButtonPress
                    End Select
                  End Sub

'========================================================='  
'                  Нажатие Клавиатуры
'========================================================='  
                  Sub On_KeyPress()
                    GET_KEY_CODE
                  End Sub

'========================================================='  
'                    Нажатие Кнопки
'========================================================='  
                  Sub On_ButtonPress()
                    Select Case GET_BUTTON_NUMBER()
                      Case 1
                        PROGRAM_TERMINATE()
                      Case BUTTON_OPEN
                        On_ButtonOpenPress
                    End Select
                  End Sub

                  Sub On_ButtonOpenPress()
                    ColorDialog_start(CD)
                  End Sub
 
'========================================================='  
'                   Перерисовка
'========================================================='  
                  Sub On_Redraw()
                    REDRAW_START()
                    DRAW_WINDOW   Window_left, Window_top, Window_width, Window_height, *Caption, COLOR_WHITE,  WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION
                    DRAW_BUTTON BUTTON_OPEN, Button_left, Button_top, Button_width, Button_height, CD.Color, BS_NO_FRAME
                    REDRAW_FINISH()
                  End Sub





Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  Asm
    xor eax, eax
    mov ebx, [Window_left]
    shl ebx, 16
    add ebx, [Window_width]
    mov ecx, [Window_top]
    shl ecx, 16
    add ecx, [Window_height]
    mov edx, [Style]
    or  edx, [BackColor]
    mov edi, [Caption]
    int 64
  End Asm
End Sub

Function WAIT_EVENT() As Long
  Asm
    mov eax, 10
    int 64
    mov [Function], eax
  End Asm
End Function

Function GET_KEY_CODE() As Long
  Asm
    mov eax, 2
    int 64
    mov [Function], eax
  End Asm
End Function

Function GET_BUTTON_NUMBER() As Long
  Asm
    mov eax, 17
    int 64
    shr eax, 8
    mov [Function], eax
  End Asm
End Function

Function GET_SCREEN_SIZE() As size
  Asm
    mov eax, 61
    mov ebx, 1
    int 64
    mov [Function], eax
  End Asm
End Function

Function MEMORY_ALLOCATE(bytes As ULong) As ULong
  Asm
    mov eax, 68
    mov ebx, 12
    mov ecx, [bytes]
    Int 64
    mov [Function], eax
  End Asm
End Function

Sub DRAW_BUTTON(identifier As Long, Button_left As Long, Button_top As Long, Button_width As Long, Button_height As Long, Button_Color As Long, Style As Long)
  Asm
    mov eax, 8
    mov ebx, [Button_left]
    shl ebx, 16
    add ebx, [Button_width]
    mov ecx, [Button_top]
    shl ecx, 16
    add ecx, [Button_height]
    mov edx, [identifier]
    Or  edx, [style]
    mov esi, [Button_Color]
    int 64
  End Asm
End Sub

Function SKIN_HEIGHT() As Long
  Asm
    mov eax, 48
    mov ebx, 4
    int 64    
    mov [Function], eax
  End Asm
End Function

Function GetProcAddress(hLib As Long, procname As ZString) As Long
  Asm
      mov  edx, [hLib]
      xor  eax, eax
      test edx, edx          ' If hlib = 0 then goto .done
      jz  .L_done
    ' -----------------------
    .L_next:      
      cmp dword Ptr [edx], 0 ' If end of export table then goto .done
      jz  .L_done
      
      xor eax, eax
      mov esi, [edx]
      mov edi, [procname]
    ' -----------------------
    .L_next_: 
      lodsb
      scasb
      jne .L_fail
      or  al, al
      jnz .L_next_
      jmp .L_ok
    ' -----------------------
    .L_fail:  
      add edx, 8
      jmp .L_next
    ' -----------------------
    .L_ok:                   
      mov eax, [edx + 4]     ' return address
    ' -----------------------
    .L_done:   
      mov [Function], eax
  End Asm
End Function

Function LOAD_LIBRARY(filename As ZString) As Long
  Asm
    mov eax, 68
    mov ebx, 19
    mov ecx, [filename]
    int 64
    mov [Function], eax
  End Asm
End Function


Результат:
Spoiler:Image

Re: FreeBasic

Posted: Tue Apr 02, 2013 2:13 am
by 0CodErr
Пример с Box_lib.
Используются два скроллбара, и выводятся значения их позиций.

Исходный код:
Spoiler:

Code: Select all


  'Event Mask Constants
  Const EM_REDRAW = &B1
  Const EM_KEY    = &B10
  Const EM_BUTTON = &B100
  Const EM_MOUSE  = &B100000


 ' Event Constants
  Const REDRAW_EVENT = 1
  Const KEY_EVENT    = 2
  Const BUTTON_EVENT = 3
  Const MOUSE_EVENT  = 6


 ' Color Constants
  Const COLOR_BLUE  = &H000000FF
  Const COLOR_RED   = &H00FF0000
  Const COLOR_GREEN = &H0000FF00
  Const COLOR_WHITE = &H00FFFFFF
  Const COLOR_BLACK = &H00000000
 
 
  ' Window Style Constants
  Const WS_SKINNED_FIXED    = &H4000000
  Const WS_SKINNED_SIZABLE  = &H3000000
  Const WS_FIXED            = &H0000000
  Const WS_SIZABLE          = &H2000000
  Const WS_FILL_TRANSPARENT = &B1000000000000000000000000000000
  Const WS_FILL_GRADIENT    = &B10000000000000000000000000000000
  Const WS_COORD_CLIENT     = &B100000000000000000000000000000
  Const WS_CAPTION          = &B10000000000000000000000000000


  ' Draw Number Constants
 Const DN_NO_LEADING_ZEROS = &B10000000000000000000000000000000
 Const DN_DECIMAL          = &B000000000
 Const DN_HEXADECIMAL      = &B100000000
 Const DN_BINARY           = &B1000000000


  Type Size
    height As UShort
    width  As UShort
  End Type


  Type scrollbar
    size_x     As UShort
    start_x    As UShort
    size_y     As UShort
    start_y    As UShort
    btn_high   As ULong
    mode       As ULong
    max_area   As ULong
    cur_area   As ULong
    position   As ULong
    bckg_col   As ULong
    frnt_col   As ULong
    line_col   As ULong
    redraw     As ULong
    delta      As UShort
    delta2     As UShort
    r_size_x   As UShort
    r_start_x  As UShort
    r_size_y   As UShort
    r_start_y  As UShort
    m_pos      As ULong
    m_pos_2    As ULong
    m_keys     As ULong
    run_size   As ULong
    position2  As ULong
    work_size  As ULong
    all_redraw As ULong
    ar_offset  As ULong
  End Type


  Dim Shared Scr As Size
  
  Dim Shared Window_width  As Long = 227
  Dim Shared Window_height As Long = 271
  Dim Shared Window_left   As Long
  Dim Shared Window_top    As Long
  
  DIM Shared Caption As ZString Ptr = @"Test_ScrollBar"
  
  DIM Shared sz_box_lib           As ZString Ptr = @"/rd/1/lib/box_lib.obj"
  DIM Shared sz_scrollbar_v_draw  As ZString Ptr = @"scrollbar_v_draw"
  DIM Shared sz_scrollbar_v_mouse As ZString Ptr = @"scrollbar_v_mouse"
  DIM Shared sz_scrollbar_h_draw  As ZString Ptr = @"scrollbar_h_draw"
  DIM Shared sz_scrollbar_h_mouse As ZString Ptr = @"scrollbar_h_mouse"
  
  DIM Shared box_lib As Long
  
  Dim Shared scrollbar1 As scrollbar
  Dim Shared scrollbar2 As scrollbar


  Declare Function WAIT_EVENT() As Long
  Declare Function GET_KEY_CODE() As Long
  Declare Function GET_BUTTON_NUMBER() As Long
  Declare Function GET_SCREEN_SIZE() As size 
  Declare Function LOAD_LIBRARY(filename As ZString) As Long
  
  Declare Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  Declare Sub DRAW_NUMBER(x As Long, y As Long, number As Long, ForeColor As Long, BackColor As Long, Count As Long, Flags As Long)
  
  Declare Function GetProcAddress(hLib As Long, procname As ZString) As Long
  
  Declare Sub On_Redraw()
  Declare Sub Event_Processor()
  Declare Sub On_KeyPress() 
  Declare Sub On_ButtonPress() 
  Declare Sub On_MouseEvent()
  Declare Sub DrawScrollbarPositions()
  
  DIM Shared scrollbar_v_draw  As Sub(scrollbar As scrollbar) 
  DIM Shared scrollbar_v_mouse As Sub(scrollbar As scrollbar) 
  DIM Shared scrollbar_h_draw  As Sub(scrollbar As scrollbar) 
  DIM Shared scrollbar_h_mouse As Sub(scrollbar As scrollbar) 

#Undef RGB
#Define RGB(r,g,b) ((cuint(r) shl 16) or (cuint(g) shl 8) or cuint(b))

#Macro PROGRAM_TERMINATE()
  Asm
    or eax, -1
    int 64
  End Asm
#EndMacro

#Macro REDRAW_START()
  Asm
    mov eax, 12
    mov ebx, 1
    int 64    
  End Asm
#EndMacro

#Macro REDRAW_FINISH()
  Asm
    mov eax, 12
    mov ebx, 2
    int 64    
  End Asm
#EndMacro

#Macro SET_EVENT(mask)
  Asm
    mov eax, 40
    mov ebx, mask
    int 64
  End Asm
#EndMacro





                  Sub Main()

                    SET_EVENT(EM_REDRAW + EM_KEY + EM_BUTTON + EM_MOUSE)
                    
                    Scr = GET_SCREEN_SIZE()

                    Window_left = (Scr.width  - Window_width)  Shr 1
                    Window_top  = (Scr.height - Window_height) Shr 1
                    
                    box_lib           = LOAD_LIBRARY(*sz_box_lib)
                    scrollbar_v_draw  = GetProcAddress(box_lib, *sz_scrollbar_v_draw)
                    scrollbar_v_mouse = GetProcAddress(box_lib, *sz_scrollbar_v_mouse)
                    scrollbar_h_draw  = GetProcAddress(box_lib, *sz_scrollbar_h_draw)
                    scrollbar_h_mouse = GetProcAddress(box_lib, *sz_scrollbar_h_mouse)
            
                    With Scrollbar1
                      .ar_offset  = 1
                      .all_redraw = 1
                      .size_x     = 16
                      .btn_high   = 16
                      .bckg_col   = RGB(161, 196, 235) 
                      .frnt_col   = RGB(102, 133, 185)
                      .line_col   = COLOR_WHITE
                      .start_y    = 40
                      .size_y     = 200
                      .start_x    = 30
                      .max_area   = 160 
                      .cur_area   = 40              
                    End With
                    
                    With Scrollbar2
                      .ar_offset  = 1
                      .all_redraw = 1
                      .size_x     = 160
                      .btn_high   = 16
                      .bckg_col   = RGB(102, 133, 185)
                      .frnt_col   = RGB(161, 196, 235)
                      .line_col   = COLOR_BLACK
                      .start_y    = 60
                      .size_y     = 16
                      .start_x    = 50
                      .max_area   = 160 
                      .cur_area   = 40              
                    End With
                    
                    On_Redraw
                    Do
                      Event_Processor
                    Loop
                  End Sub

'========================================================='  
'                  Обработка Событий
'========================================================='  
                  Sub Event_Processor()
                    Select Case WAIT_EVENT()
                    Case REDRAW_EVENT
                      On_Redraw
                    Case KEY_EVENT
                      On_KeyPress
                    Case BUTTON_EVENT
                      On_ButtonPress
                    Case MOUSE_EVENT
                      On_MouseEvent
                    End Select
                  End Sub

'========================================================='  
'                  Нажатие Клавиатуры
'========================================================='  
                  Sub On_KeyPress()
                    GET_KEY_CODE
                  End Sub

'========================================================='  
'                    Нажатие Кнопки
'========================================================='  
                  Sub On_ButtonPress()
                    Select Case GET_BUTTON_NUMBER()
                    Case 1
                      PROGRAM_TERMINATE()
                    End Select
                  End Sub
  
'========================================================='  
'                  Событие Мыши
'========================================================='  
                  Sub On_MouseEvent()
                    scrollbar_v_mouse(scrollbar1)
                    scrollbar_h_mouse(scrollbar2)
                    DrawScrollbarPositions
                  End Sub  
  
'========================================================='  
'                   Перерисовка
'========================================================='  
                  Sub On_Redraw()
                    REDRAW_START()
                    DRAW_WINDOW Window_left, Window_top, Window_width, Window_height, *Caption, COLOR_WHITE, WS_SKINNED_SIZABLE + WS_COORD_CLIENT + WS_CAPTION
                    Scrollbar1.all_redraw = 1
                    scrollbar_v_draw(scrollbar1)
                    Scrollbar2.all_redraw = 1
                    scrollbar_h_draw(scrollbar2)
                    DrawScrollbarPositions
                    REDRAW_FINISH()
                  End Sub

                  Sub DrawScrollbarPositions()
                    DRAW_NUMBER  50, 40, scrollbar1.position, COLOR_BLUE, COLOR_WHITE, 3, DN_DECIMAL
                    DRAW_NUMBER 190, 80, scrollbar2.position,  COLOR_RED, COLOR_WHITE, 3, DN_DECIMAL
                  End Sub  





Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  Asm
    xor eax, eax
    mov ebx, [Window_left]
    shl ebx, 16
    add ebx, [Window_width]
    mov ecx, [Window_top]
    shl ecx, 16
    add ecx, [Window_height]
    mov edx, [Style]
    or  edx, [BackColor]
    mov edi, [Caption]
    int 64
  End Asm
End Sub

Function WAIT_EVENT() As Long
  Asm
    mov eax, 10
    int 64
    mov [Function], eax
  End Asm
End Function

Function GET_KEY_CODE() As Long
  Asm
    mov eax, 2
    int 64
    mov [Function], eax
  End Asm
End Function

Function GET_BUTTON_NUMBER() As Long
  Asm
    mov eax, 17
    int 64
    shr eax, 8
    mov [Function], eax
  End Asm
End Function

Function GET_SCREEN_SIZE() As size
  Asm
    mov eax, 61
    mov ebx, 1
    int 64
    mov [Function], eax
  End Asm
End Function

Sub DRAW_NUMBER(x As Long, y As Long, number As Long, ForeColor As Long, BackColor As Long, Count As Long, Flags As Long)
  Asm
    mov eax, 47
    mov ebx, [count]
    Shl ebx, 16
    Or  ebx, [Flags]
    mov ecx, [number]
    mov edx, [x]
    shl edx, 16
    add edx, [y]
    mov esi, [ForeColor]
    or  esi, &H40000000
    mov edi, [BackColor]  
    int 64
  End Asm
End Sub

Function GetProcAddress(hLib As Long, procname As ZString) As Long
  Asm
      mov  edx, [hLib]
      xor  eax, eax
      test edx, edx          ' If hlib = 0 then goto .done
      jz  .L_done
    ' -----------------------
    .L_next:      
      cmp dword Ptr [edx], 0 ' If end of export table then goto .done
      jz  .L_done
      
      xor eax, eax
      mov esi, [edx]
      mov edi, [procname]
    ' -----------------------
    .L_next_: 
      lodsb
      scasb
      jne .L_fail
      or  al, al
      jnz .L_next_
      jmp .L_ok
    ' -----------------------
    .L_fail:  
      add edx, 8
      jmp .L_next
    ' -----------------------
    .L_ok:                   
      mov eax, [edx + 4]     ' return address
    ' -----------------------
    .L_done:   
      mov [Function], eax
  End Asm
End Function

Function LOAD_LIBRARY(filename As ZString) As Long
  Asm
    mov eax, 68
    mov ebx, 19
    mov ecx, [filename]
    int 64
    mov [Function], eax
  End Asm
End Function

Результат:
Spoiler:Image

Re: FreeBasic

Posted: Wed Apr 03, 2013 6:59 am
by 0CodErr
Пример с Buf2d и Libimg.
Читаем png-файл с иконками. Выводим несколько буферов в окно, перед выводом буфера рисуем в него иконку.

Исходный код:
Spoiler:

Code: Select all

  ' Event Constants
  Const REDRAW_EVENT = 1
  Const KEY_EVENT    = 2
  Const BUTTON_EVENT = 3
  Const MOUSE_EVENT  = 6
  
  ' Window Style Constants
  Const WS_SKINNED_FIXED    = &H4000000
  Const WS_SKINNED_SIZABLE  = &H3000000
  Const WS_FIXED            = &H0000000
  Const WS_SIZABLE          = &H2000000
  Const WS_FILL_TRANSPARENT = &B1000000000000000000000000000000
  Const WS_FILL_GRADIENT    = &B10000000000000000000000000000000
  Const WS_COORD_CLIENT     = &B100000000000000000000000000000
  Const WS_CAPTION          = &B10000000000000000000000000000
  
  ' Color Constants
  Const COLOR_BLUE  =  &H000000FF
  Const COLOR_RED   =  &H00FF0000
  Const COLOR_GREEN =  &H0000FF00
  Const COLOR_WHITE =  &H00FFFFFF
  Const COLOR_BLACK =  &H00000000
  

  Type Size
    height As UShort
    width  As UShort
  End Type

  type buf2d_buffer
    img    As ULong 
    left   As UShort 
    top    As UShort 
    width  As ULong  
    height As ULong 
    color  As ULong 
    bpp    As byte 
  End Type
  

  Dim Shared Scr As Size
  
  Dim Shared Window_width  As Long
  Dim Shared Window_height As Long
  Dim Shared Window_left   As Long
  Dim Shared Window_top    As Long
  
  DIM Shared sz_lib_init As ZString Ptr = @"lib_init"
  
  DIM Shared sz_buf2d              As ZString Ptr = @"/rd/1/lib/buf2d.obj"
  DIM Shared sz_buf2d_create       As ZString Ptr = @"buf2d_create"
  DIM Shared sz_buf2d_draw         As ZString Ptr = @"buf2d_draw"
  DIM Shared sz_buf2d_delete       As ZString Ptr = @"buf2d_delete"
  DIM Shared sz_buf2d_create_f_img As ZString Ptr = @"buf2d_create_f_img"
  DIM Shared sz_buf2d_bit_blt      As ZString Ptr = @"buf2d_bit_blt"
  
  DIM Shared sz_libimg      As ZString Ptr = @"/rd/1/lib/libimg.obj"
  DIM Shared sz_img_decode  As ZString Ptr = @"img_decode"
  DIM Shared sz_img_to_rgb2 As ZString Ptr = @"img_to_rgb2"
  DIM Shared sz_img_destroy As ZString Ptr = @"img_destroy"
  
  
  Dim Shared buf2d As Long
  DIM Shared libimg As Long
  
  Dim Shared buf2d_ItemBuffer  as buf2d_buffer 
  Dim Shared buf2d_ImageBuffer as buf2d_buffer 
  
  DIM Shared sz_filepath As ZString Ptr  = @"/rd/1/file managers/z_icons.png"
  'DIM Shared sz_filepath As ZString Ptr  = @"/rd/1/ICONSTRP.png"
  'DIM Shared sz_filepath As ZString Ptr  = @"/rd/1/DEVELOP/TE_ICON.PNG"
  
  DIM Shared imgFileSize As ULong
  DIM Shared imgFile     As ULong
  DIM Shared imgData     As ULong
  DIM Shared imgBuffer   As ULong
  DIM Shared ImgWidth    As ULong
  DIM Shared ImgHeight   As ULong
  DIM Shared icons       As ULong
  
  Dim Shared PaddingX As Long
  Dim Shared PaddingY As Long
  Dim Shared MarginX  As Long
  Dim Shared MarginY  As Long
  
  
  Declare Function WAIT_EVENT() As Long
  Declare Function GET_KEY_CODE() As Long
  Declare Function GET_BUTTON_NUMBER() As Long
  Declare Function GET_SCREEN_SIZE() As size 
  Declare Function LOAD_LIBRARY(filename As ZString) As Long
  Declare Function MEMORY_ALLOCATE(bytes As ULong) As ULong
  Declare Function MEMORY_REALLOCATE(memPtr As ULong, bytes As ULong) As ULong
  Declare Function MEMORY_FREE(memPtr As ULong) As ULong
  Declare Function GET_FILE_SIZE(filename As ZString)As ULong
  Declare Function FILE_READ(filename As ZString, buffer As ULong, position As ULong, count As ULong) As ULong
  
  Declare Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  
  Declare Function GetProcAddress(hLib As Long, procname As ZString) As Long
  Declare Sub DllInit(lib_init As Sub)
  
  Declare Sub On_Redraw()
  Declare Sub Event_Processor()
  Declare Sub On_KeyPress() 
  Declare Sub On_ButtonPress() 
  Declare Sub DrawItem(x As Long, y As Long, index As Long, BackColor As Long)
  
  
  DIM Shared buf2d_lib_init     As Sub()
  DIM Shared buf2d_create       As Sub( buf2d_buffer As buf2d_buffer) 
  DIM Shared buf2d_draw         As Sub( buf2d_buffer As buf2d_buffer) 
  DIM Shared buf2d_delete       As Sub( buf2d_buffer As buf2d_buffer) 
  DIM Shared buf2d_create_f_img As Sub( buf2d_buffer As buf2d_buffer, ImgBuffer As ULong) 
  DIM Shared buf2d_bit_blt      As Sub( dst_buf2d_buffer As buf2d_buffer, x As Long, y As Long, src_buf2d_buffer As buf2d_buffer) 
  
  DIM Shared libimg_lib_init As Sub()
  DIM Shared img_decode      As Function(Data As ULong, length As ULong, options As ULong)As ULong
  DIM Shared img_to_rgb2     As Sub(imgData As ULong, dst As ULong)
  DIM Shared img_destroy     As Sub(imgData As ULong)
  
  
  #Undef RGB
  #Define RGB(r,g,b) ((cuint(r) shl 16) or (cuint(g) shl 8) or cuint(b))
  
  
  #Macro PROGRAM_TERMINATE()
    Asm
      or eax, -1
      int 64
    End Asm
  #EndMacro
  
  #Macro REDRAW_START()
    Asm
      mov eax, 12
      mov ebx, 1
      int 64    
    End Asm
  #EndMacro
  
  #Macro REDRAW_FINISH()
    Asm
      mov eax, 12
      mov ebx, 2
      int 64    
    End Asm
  #EndMacro
  
  #Macro SET_EVENT(mask)
    Asm
      mov eax, 40
      mov ebx, mask
      int 64
    End Asm
  #EndMacro





                  Sub Main()
                    Scr = GET_SCREEN_SIZE()
                    
                    Window_width  = Scr.width  Shr 1
                    Window_height = Scr.height Shr 2
                    Window_left   = (Scr.width  - Window_width)  Shr 1
                    Window_top    = (Scr.height - Window_height) Shr 1
                    
                    buf2d              = LOAD_LIBRARY(*sz_buf2d)
                    buf2d_lib_init     = GetProcAddress(buf2d, *sz_lib_init)
                    buf2d_create       = GetProcAddress(buf2d, *sz_buf2d_create)
                    buf2d_draw         = GetProcAddress(buf2d, *sz_buf2d_draw)
                    buf2d_delete       = GetProcAddress(buf2d, *sz_buf2d_delete)
                    buf2d_create_f_img = GetProcAddress(buf2d, *sz_buf2d_create_f_img)
                    buf2d_bit_blt      = GetProcAddress(buf2d, *sz_buf2d_bit_blt)
                    
                    libimg          = LOAD_LIBRARY(*sz_libimg)
                    libimg_lib_init = GetProcAddress(libimg, *sz_lib_init)
                    img_decode      = GetProcAddress(libimg, *sz_img_decode)
                    img_to_rgb2     = GetProcAddress(libimg, *sz_img_to_rgb2)
                    img_destroy     = GetProcAddress(libimg, *sz_img_destroy)    

                    DllInit libimg_lib_init
                    
                    DllInit buf2d_lib_init
                    
                    
                    imgFileSize = GET_FILE_SIZE(*sz_filepath)
                    imgFile     = MEMORY_ALLOCATE(imgFileSize)
                    FILE_READ *sz_filepath, imgFile, 0, imgFileSize
                    
                    imgData = img_decode(imgFile, imgFileSize, 0)
                    MEMORY_FREE imgFile
                    
                    ImgWidth  = Peek(ULong, (imgData + 4))
                    ImgHeight = Peek(ULong, (imgData + 8))
                    
                    imgBuffer = MEMORY_ALLOCATE(ImgWidth*ImgHeight*3)
                    img_to_rgb2(imgData, imgBuffer)

                    img_destroy(imgData)                    
          
                    buf2d_ImageBuffer.width  = ImgWidth
                    buf2d_ImageBuffer.height = ImgHeight
                    buf2d_ImageBuffer.bpp    = 24
          
                    buf2d_create_f_img(buf2d_ImageBuffer, imgBuffer)
            
                    buf2d_ImageBuffer.height = ImgWidth
                    icons = buf2d_ImageBuffer.img
          
                    MEMORY_FREE imgBuffer

                    On_Redraw
                    Do
                      Event_Processor
                    Loop
                  End Sub

'========================================================='  
'                  Обработка Событий
'========================================================='  
                  Sub Event_Processor()
                    Select Case WAIT_EVENT()
                    Case REDRAW_EVENT
                      On_Redraw
                    Case KEY_EVENT
                      On_KeyPress
                    Case BUTTON_EVENT
                      On_ButtonPress
                    End Select
                  End Sub

'========================================================='  
'                  Нажатие Клавиатуры
'========================================================='  
                  Sub On_KeyPress()
                    GET_KEY_CODE
                  End Sub

'========================================================='  
'                    Нажатие Кнопки
'========================================================='  
                  Sub On_ButtonPress()
                    Select Case GET_BUTTON_NUMBER()
                    Case 1
                      PROGRAM_TERMINATE()
                    End Select
                  End Sub

'========================================================='  
'                   Перерисовка
'========================================================='  
                  Sub On_Redraw()
                    REDRAW_START()
                    DRAW_WINDOW   Window_left, Window_top, Window_width, Window_height, *sz_filepath, COLOR_WHITE,  WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION
                    
                    Dim index As Long = 0
                    
                    Dim x As Long = 10
                    While x <= 330
                      Dim y As Long = 20
                      While y <= 100
                        DrawItem x, y, index, RGB(-index*16 + 255, y + 120, x Shr 1 + 20)
                        index = index + 1
                        y = y + buf2d_ItemBuffer.height + MarginY
                      Wend
                      x = x + buf2d_ItemBuffer.width + MarginX
                    Wend
                    
                    REDRAW_FINISH()
                  End Sub

                  Sub DrawItem(x As Long, y As Long, index As Long, BackColor As Long)
                    PaddingY = 4
                    MarginX  = 6
                    MarginY  = 8
                  
                    buf2d_ItemBuffer.width = 100
                    buf2d_ItemBuffer.height = PaddingY Shl 1 + ImgWidth
                    buf2d_ItemBuffer.left = x
                    buf2d_ItemBuffer.top = y      
                    buf2d_ItemBuffer.color = BackColor
                    buf2d_ItemBuffer.bpp = 24
                      
                    PaddingX = (buf2d_ItemBuffer.width - ImgWidth) Shr 1
                  
                    buf2d_ImageBuffer.img = ImgWidth * ImgWidth * 3 * index  + icons 
                  
                    buf2d_create(buf2d_ItemBuffer)
                    buf2d_bit_blt(buf2d_ItemBuffer, PaddingX, PaddingY, buf2d_ImageBuffer) 
                    buf2d_draw(buf2d_ItemBuffer)
                    buf2d_delete(buf2d_ItemBuffer)
                  End Sub


									
									
									
  Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
    Asm
      xor eax, eax
      mov ebx, [Window_left]
      shl ebx, 16
      add ebx, [Window_width]
      mov ecx, [Window_top]
      shl ecx, 16
      add ecx, [Window_height]
      mov edx, [Style]
      or  edx, [BackColor]
      mov edi, [Caption]
      int 64
    End Asm
  End Sub
  
  Function WAIT_EVENT() As Long
    Asm
      mov eax, 10
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  
  Function GET_KEY_CODE() As Long
    Asm
      mov eax, 2
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  
  Function GET_BUTTON_NUMBER() As Long
    Asm
      mov eax, 17
      int 64
      shr eax, 8
      mov [Function], eax
    End Asm
  End Function
  
  
  Function GET_SCREEN_SIZE() As size
    Asm
      mov eax, 61
      mov ebx, 1
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  Function MEMORY_ALLOCATE(bytes As ULong) As ULong
    Asm
      push ecx
      mov eax, 68
      mov ebx, 12
      mov ecx, [bytes]
      Int 64
      pop ecx
      mov [Function], eax
    End Asm
  End Function
  
  Function MEMORY_REALLOCATE(memPtr As ULong, bytes As ULong) As ULong
    Asm
      push ecx
      push edx
      mov eax, 68
      mov ebx, 20
      mov ecx, [bytes]
      mov edx, [memPtr]
      Int 64
      pop edx
      pop ecx
      mov [Function], eax
    End Asm
  End Function
  
  Function MEMORY_FREE(memPtr As ULong) As ULong
    Asm
      push ecx
      mov eax, 68
      mov ebx, 13
      mov ecx, [memPtr]
      Int 64
      pop ecx
      mov [Function], eax
    End Asm
  End Function

  Function GET_FILE_SIZE(filename As ZString)As ULong
    Asm
     mov ecx, esp
     sub ecx, 28 + 40
     mov dword Ptr [ecx +  0], 5
     mov dword Ptr [ecx +  8], 0
     mov byte  Ptr [ecx + 20], 0  
     mov [ecx + 16], ecx
     add dword Ptr [ecx + 16], 28
     mov eax, [filename]
     mov [ecx + 21], eax
     mov eax, 70
     lea ebx, [ecx]
     int 64
     mov eax, [ecx + 28 + 32]
     mov [Function], eax
    End Asm
  End Function
 
  Function FILE_READ(filename As ZString, buffer As ULong, position As ULong, count As ULong) As ULong
    Asm
     mov ecx, esp
     sub ecx, 28
     mov dword Ptr [ecx +  0], 0
     mov dword Ptr [ecx +  8], 0
     mov Byte  Ptr [ecx + 20], 0  
     mov eax, [position]
     mov [ecx + 4], eax
     mov eax, [buffer]
     mov [ecx + 16], eax
     mov eax, [count]
     mov [ecx + 12], eax
     mov eax, [filename]
     mov [ecx + 21], eax
     mov eax, 70
     lea ebx, [ecx]
     int 64
     mov [Function], eax
    End Asm
  End Function

  Function GetProcAddress(hLib As Long, procname As ZString) As Long
    Asm
        mov  edx, [hLib]
        xor  eax, eax
        test edx, edx
        jz  2f
      ' -----------------------
      1:      
        cmp dword Ptr [edx], 0
        jz  2f
        
        xor eax, eax
        mov esi, [edx]
        mov edi, [procname]
      ' -----------------------
      0: 
        lodsb
        scasb
        jne 0f
        or  al, al
        jnz 0b
        jmp 1f
      ' -----------------------
      0:  
        add edx, 8
        jmp 1b
      ' -----------------------
      1:                   
        mov eax, [edx + 4]
      ' -----------------------
      2:   
        mov [Function], eax
    End Asm
  End Function

  Function LOAD_LIBRARY(filename As ZString) As Long
    Asm
      mov eax, 68
      mov ebx, 19
      mov ecx, [filename]
      int 64
      mov [Function], eax
    End Asm
  End Function

  Sub DllInit(lib_init As Sub)
   Asm
       pushad 
       mov  eax, offset MEMORY_ALLOCATE
       mov  ebx, offset MEMORY_FREE
       mov  ecx, offset MEMORY_REALLOCATE
       mov  edx, offset 0f
       call [lib_init]
       popad 
       jmp 4f
     '--------------------------------------     
     0:
       push ebp
       mov  ebp, esp
       mov  esi, [ebp + 8]
     '--------------------------------------      
     2:  
       mov edx, [esi]
       or  edx, edx
       jz  3f
  
       push esi
       mov  esi, [esi + 4]
       mov  edi, offset 6f
     '--------------------------------------      
     0: 
       lodsb
       stosb
       or al, al
       jnz  0b
  
       push offset 5f
       Call LOAD_LIBRARY
       or   eax, eax
       jz  2f
       
       mov  ecx,  [eax]
       cmp  dword Ptr [ecx + 4], 0x74696E69
       jne  0f
       push dword Ptr [eax + 4]
       call DllInit
     '--------------------------------------      
     0:
       mov  ecx, eax
       mov  ebx, edx
       test edx, edx
       jz  1f
     '--------------------------------------        
     0:  
       mov  eax, [ebx]
       test eax, eax
       jz   1f
       push eax
       push ecx
       Call GetProcAddress
       or   eax, eax
       jz   0f
       mov  [ebx], eax
       Add  ebx, 4
       jmp  0b
     '--------------------------------------        
     0:
       mov dword Ptr [esp], eax
     '--------------------------------------        
     1:  
       pop esi
       add esi, 8
       jmp 2b
     '--------------------------------------      
     3:  
       xor eax, eax
       jmp 0f
     '--------------------------------------     
     2:  
       pop esi
       inc eax
     '--------------------------------------     
     0:    
       pop ebp    
       ret 4
     '--------------------------------------
     5: .ascii "/sys/lib/"
     6: .skip 32
     '--------------------------------------     
     4:
   End Asm
  End Sub

Результаты:
Spoiler:Image
Image
Image

Re: FreeBasic

Posted: Fri Apr 05, 2013 8:02 am
by GMac
Is there a port of fbc to kolibri? if so where's the download link to it?

Re: FreeBasic

Posted: Fri Apr 05, 2013 12:04 pm
by 0CodErr
No, this is not a port fbc. But it is possible to use fbc in other OS to make programs for KolibriOS.

Re: FreeBasic

Posted: Sun Apr 07, 2013 9:36 am
by Aeol
Жаль, что fbc не собирает сам себя (без GCC никак). Кабы не это, был бы смысл портировать его.

Re: FreeBasic

Posted: Tue Apr 09, 2013 8:56 pm
by IgorA
0CodErr wrote:Пример с Buf2d и Libimg.
Читаем png-файл с иконками. Выводим несколько буферов в окно, перед выводом буфера рисуем в него иконку.
Интересные примеры. Если функции buf2d_create и buf2d_delete перенести из перерисовки в начало и конец программы, то рисовать должно быстрее.
Находил недавно проэкт http://www.qb64.net/ , в котором сделана версия QBasic для 64 битного виндовса и других ОС. Может даже есть исходные коды, но я пока не искал.

Re: FreeBasic

Posted: Wed Apr 17, 2013 3:28 pm
by 0CodErr
Пример с Box_lib.
Используются 4 компонента Frame.

Исходный код:
Spoiler:

Code: Select all

 ' Event Constants
  Const REDRAW_EVENT = 1
  Const KEY_EVENT    = 2
  Const BUTTON_EVENT = 3
  Const MOUSE_EVENT  = 6


 ' Color Constants
  Const COLOR_BLUE  = &H000000FF
  Const COLOR_RED   = &H00FF0000
  Const COLOR_GREEN = &H0000FF00
  Const COLOR_WHITE = &H00FFFFFF
  Const COLOR_BLACK = &H00000000
 
 
  ' Window Style Constants
  Const WS_SKINNED_FIXED    = &H4000000
  Const WS_SKINNED_SIZABLE  = &H3000000
  Const WS_FIXED            = &H0000000
  Const WS_SIZABLE          = &H2000000
  Const WS_FILL_TRANSPARENT = &B1000000000000000000000000000000
  Const WS_FILL_GRADIENT    = &B10000000000000000000000000000000
  Const WS_COORD_CLIENT     = &B100000000000000000000000000000
  Const WS_CAPTION          = &B10000000000000000000000000000

  Const BORDER_SIZE = 5

  Const FRAMES_MARGIN = 8
  Const FRAMES_WIDTH = 120
  Const FRAMES_HEIGHT = 80

	
  Type Size
    height As UShort
    width  As UShort
  End Type

  Type frame
    type              As ULong
    x_size            As UShort
    x_start           As UShort
    y_size            As UShort
    y_start           As UShort
    ext_fr_col        As ULong
    int_fr_col        As ULong
    draw_text_flag    As ULong
    text_pointer      As ZString Ptr
    text_position     As ULong
    font_number       As ULong
    font_size_y       As ULong
    font_color        As ULong
    font_backgr_color As ULong
  End Type


  Dim Shared Scr As Size
  
  Dim Shared Window_width  As Long
  Dim Shared Window_height As Long 
  Dim Shared Window_left   As Long
  Dim Shared Window_top    As Long
  
  DIM Shared Caption As ZString Ptr = @"Frames"
  
  DIM Shared sz_box_lib    As ZString Ptr = @"/rd/1/lib/box_lib.obj"
  DIM Shared sz_frame_draw As ZString Ptr = @"frame_draw"
  
  DIM Shared sz_Frame1 As ZString Ptr = @"Frame1" 
  DIM Shared sz_Frame2 As ZString Ptr = @" Frame2 " 
  DIM Shared sz_Frame3 As ZString Ptr = @"F_r_a_m_e_3" 
  DIM Shared sz_Frame4 As ZString Ptr = @"| Frame4 |" 
    
  DIM Shared box_lib As Long
  
  Dim Shared frame1 As frame
  Dim Shared frame2 As frame
  Dim Shared frame3 As frame
  Dim Shared frame4 As frame

  Declare Function WAIT_EVENT() As Long
  Declare Function GET_KEY_CODE() As Long
  Declare Function GET_BUTTON_NUMBER() As Long
  Declare Function GET_SCREEN_SIZE() As size 
  Declare Function SKIN_HEIGHT() As ULong
  Declare Function LOAD_LIBRARY(filename As ZString) As Long
  
  Declare Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
  
  Declare Function GetProcAddress(hLib As Long, procname As ZString) As Long
  
  Declare Sub On_Redraw()
  Declare Sub Event_Processor()
  Declare Sub On_KeyPress() 
  Declare Sub On_ButtonPress() 
  
  DIM Shared frame_draw  As Sub(frame As frame) 


  #Undef RGB
  #Define RGB(r,g,b) ((cuint(r) shl 16) or (cuint(g) shl 8) or cuint(b))
  
  #Macro PROGRAM_TERMINATE()
    Asm
      or eax, -1
      int 64
    End Asm
  #EndMacro
  
  #Macro REDRAW_START()
    Asm
      mov eax, 12
      mov ebx, 1
      int 64    
    End Asm
  #EndMacro
  
  #Macro REDRAW_FINISH()
    Asm
      mov eax, 12
      mov ebx, 2
      int 64    
    End Asm
  #EndMacro







                  Sub Main()
                    Scr = GET_SCREEN_SIZE()
										
                    Window_width  = BORDER_SIZE Shl 1 + FRAMES_WIDTH Shl 1 + FRAMES_MARGIN * 3
                    Window_height = BORDER_SIZE + SKIN_HEIGHT() + FRAMES_HEIGHT Shl 1 + FRAMES_MARGIN * 3
                    Window_left   = (Scr.width  - Window_width)  Shr 1
                    Window_top    = (Scr.height - Window_height) Shr 1
                    
                    box_lib    = LOAD_LIBRARY(*sz_box_lib)
                    frame_draw = GetProcAddress(box_lib, *sz_frame_draw)

                    With  Frame1 
                      .type              = 0
                      .x_size            = FRAMES_WIDTH
                      .x_start           = FRAMES_MARGIN
                      .y_size            = FRAMES_HEIGHT
                      .y_start           = FRAMES_MARGIN
                      .ext_fr_col        = RGB(64, 64, 64)
                      .int_fr_col        = RGB(224, 224, 224)
                      .draw_text_flag    = 1
                      .text_pointer      = sz_Frame1
                      .text_position     = 0
                      .font_number       = 0
                      .font_size_y       = 9
                      .font_color        = COLOR_BLUE
                      .font_backgr_color = COLOR_WHITE
                    End With 
                
                    With  Frame2  
                      .type              = 0
                      .x_size            = FRAMES_WIDTH
                      .x_start           = Frame1.x_start + Frame1.x_size + FRAMES_MARGIN
                      .y_size            = FRAMES_HEIGHT
                      .y_start           = FRAMES_MARGIN
                      .ext_fr_col        = RGB(224, 224, 224)
                      .int_fr_col        = RGB(64, 64, 64)
                      .draw_text_flag    = 1
                      .text_pointer      = sz_Frame2
                      .text_position     = 0
                      .font_number       = 0
                      .font_size_y       = 9
                      .font_color        = COLOR_BLACK
                      .font_backgr_color = RGB(192, 192, 192)
                    End With 
                
                    With  Frame3 
                      .type              = 0
                      .x_size            = FRAMES_WIDTH
                      .x_start           = FRAMES_MARGIN
                      .y_size            = FRAMES_HEIGHT
                      .y_start           = Frame1.y_start + Frame1.y_size + FRAMES_MARGIN
                      .ext_fr_col        = RGB(64, 64, 64)
                      .int_fr_col        = RGB(224, 224, 224)
                      .draw_text_flag    = 1
                      .text_pointer      = sz_Frame3 
                      .text_position     = 1
                      .font_number       = 1
                      .font_size_y       = 9
                      .font_color        = COLOR_BLUE
                      .font_backgr_color = RGB(192, 192, 0)
                    End With 
                
                    With  Frame4 
                      .type              = 0
                      .x_size            = FRAMES_WIDTH
                      .x_start           = Frame3.x_start + Frame3.x_size + FRAMES_MARGIN
                      .y_size            = FRAMES_HEIGHT
                      .y_start           = Frame1.y_start + Frame1.y_size + FRAMES_MARGIN
                      .ext_fr_col        = RGB(224, 224, 224)
                      .int_fr_col        = RGB(64, 64, 64)
                      .draw_text_flag    = 1
                      .text_pointer      = sz_Frame4 
                      .text_position     = 1
                      .font_number       = 0
                      .font_size_y       = 9
                      .font_color        = COLOR_RED
                      .font_backgr_color = RGB(0, 192, 192)
                    End With 
                    
                    On_Redraw
                    Do
                      Event_Processor
                    Loop
                  End Sub

'========================================================='  
'                  Обработка Событий
'========================================================='  
                  Sub Event_Processor()
                    Select Case WAIT_EVENT()
                    Case REDRAW_EVENT
                      On_Redraw
                    Case KEY_EVENT
                      On_KeyPress
                    Case BUTTON_EVENT
                      On_ButtonPress
                    End Select
                  End Sub

'========================================================='  
'                  Нажатие Клавиатуры
'========================================================='  
                  Sub On_KeyPress()
                    GET_KEY_CODE
                  End Sub

'========================================================='  
'                    Нажатие Кнопки
'========================================================='  
                  Sub On_ButtonPress()
                    Select Case GET_BUTTON_NUMBER()
                    Case 1
                      PROGRAM_TERMINATE()
                    End Select
                  End Sub
  
'========================================================='  
'                   Перерисовка
'========================================================='  
                  Sub On_Redraw()
                    REDRAW_START()
                    DRAW_WINDOW Window_left, Window_top, Window_width, Window_height, *Caption, RGB(192, 192, 192), WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION
                    frame_draw(Frame1)
                    frame_draw(Frame2)
                    frame_draw(Frame3)
                    frame_draw(Frame4)
                    REDRAW_FINISH()
                  End Sub





  Sub DRAW_WINDOW(Window_left As Long, Window_top As Long, Window_width As Long, Window_height As Long, Caption As ZString, BackColor As Long, Style As Long)
    Asm
      xor eax, eax
      mov ebx, [Window_left]
      shl ebx, 16
      add ebx, [Window_width]
      mov ecx, [Window_top]
      shl ecx, 16
      add ecx, [Window_height]
      mov edx, [Style]
      or  edx, [BackColor]
      mov edi, [Caption]
      int 64
    End Asm
  End Sub
  
  Function WAIT_EVENT() As Long
    Asm
      mov eax, 10
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  Function GET_KEY_CODE() As Long
    Asm
      mov eax, 2
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  Function GET_BUTTON_NUMBER() As Long
    Asm
      mov eax, 17
      int 64
      shr eax, 8
      mov [Function], eax
    End Asm
  End Function
  
  Function GET_SCREEN_SIZE() As size
    Asm
      mov eax, 61
      mov ebx, 1
      int 64
      mov [Function], eax
    End Asm
  End Function
  
  Function SKIN_HEIGHT() As ULong
    Asm
      mov eax, 48
      mov ebx, 4
      int 64
      mov [Function], eax
    End Asm 
  End Function

  Function LOAD_LIBRARY(filename As ZString) As Long
    Asm
      mov eax, 68
      mov ebx, 19
      mov ecx, [filename]
      int 64
      mov [Function], eax
    End Asm
  End Function	
	
  Function GetProcAddress(hLib As Long, procname As ZString) As Long
    Asm
        mov  edx, [hLib]
        xor  eax, eax
        test edx, edx
        jz  2f
      ' -----------------------
      1:      
        cmp dword Ptr [edx], 0
        jz  2f
        
        xor eax, eax
        mov esi, [edx]
        mov edi, [procname]
      ' -----------------------
      0: 
        lodsb
        scasb
        jne 0f
        or  al, al
        jnz 0b
        jmp 1f
      ' -----------------------
      0:  
        add edx, 8
        jmp 1b
      ' -----------------------
      1:                   
        mov eax, [edx + 4]
      ' -----------------------
      2:   
        mov [Function], eax
    End Asm
  End Function
Результат:
Spoiler:Image

Re: FreeBasic

Posted: Wed Apr 17, 2013 3:54 pm
by Mario_r4
0CodErr
Мог бы для двух нижних указать расположения текста в нижней части.

Re: FreeBasic

Posted: Wed Apr 17, 2013 4:20 pm
by 0CodErr
Mario_r4 wrote:0CodErr
Мог бы для двух нижних указать расположения текста в нижней части.
Сделал на двух нижних ".text_position = 1" и поменял скриншот.