Board.KolibriOS.org

Официальный форум KolibriOS
Текущее время: Сб дек 16, 2017 6:38 am

Часовой пояс: UTC+03:00




Начать новую тему  Ответить на тему  [ 23 сообщения ]  На страницу 1 2 След.
Автор Сообщение
 Заголовок сообщения: FreeBasic
СообщениеДобавлено: Пн янв 28, 2013 3:34 am 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Попробовал написать на FreeBasic приложение для KolibriOS.
Программа "Test_Window.bas" просто выводит окно по центру экрана.

Исходный код для FreeBasic:
Спойлер: Показать
Код:

   ' 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



Теперь делаем:
Код:
 
fbc -R -c "Test_Window.bas"

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

Для удобства создадим "make.bat":
Код:
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":
Спойлер: Показать
Код:
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".

Вот так выглядит окно полученной программы:
Спойлер: Показать
Изображение


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Пн янв 28, 2013 2:55 pm 
Не в сети

Зарегистрирован: Пн сен 24, 2007 11:11 am
Сообщения: 2814
Здорово. Теперь предлагаю собрать FreeBasic под Колибри.


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Пн янв 28, 2013 5:03 pm 
Не в сети
Mentor
Аватара пользователя

Зарегистрирован: Вт янв 15, 2008 11:27 am
Сообщения: 750
SoUrcerer писал(а):
Здорово. Теперь предлагаю собрать 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
СообщениеДобавлено: Пн янв 28, 2013 5:27 pm 
Не в сети

Зарегистрирован: Пн сен 24, 2007 11:11 am
Сообщения: 2814
Да, я тоже смотрел на FB - его порт абсолютно реален, но мне не очень интересен из-за высокой трудоемкости и не очень высокой отдачи. Все же FreeBasic "тяжеловат".


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Пн янв 28, 2013 5:51 pm 
Не в сети
Mentor
Аватара пользователя

Зарегистрирован: Вт янв 15, 2008 11:27 am
Сообщения: 750
Ну, может, в отдалённом будущем... :)


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Чт мар 28, 2013 6:57 pm 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Пример с ColorDialog.
По нажатию на кнопку вызывается диалог, в котором можно выбрать цвет этой кнопки.

Исходный код:
Спойлер: Показать
Код:

  ' 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




Результат:
Спойлер: Показать
Изображение


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Вт апр 02, 2013 2:13 am 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Пример с Box_lib.
Используются два скроллбара, и выводятся значения их позиций.

Исходный код:
Спойлер: Показать
Код:

  '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



Результат:
Спойлер: Показать
Изображение


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Ср апр 03, 2013 6:59 am 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Пример с Buf2d и Libimg.
Читаем png-файл с иконками. Выводим несколько буферов в окно, перед выводом буфера рисуем в него иконку.

Исходный код:
Спойлер: Показать
Код:
  ' 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



Результаты:
Спойлер: Показать
Изображение
Изображение
Изображение


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Пт апр 05, 2013 8:02 am 
Не в сети

Зарегистрирован: Вт апр 02, 2013 5:27 am
Сообщения: 23
Is there a port of fbc to kolibri? if so where's the download link to it?


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Пт апр 05, 2013 12:04 pm 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
No, this is not a port fbc. But it is possible to use fbc in other OS to make programs for KolibriOS.


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Вс апр 07, 2013 9:36 am 
Не в сети

Зарегистрирован: Вт фев 26, 2013 1:00 pm
Сообщения: 19
Жаль, что fbc не собирает сам себя (без GCC никак). Кабы не это, был бы смысл портировать его.


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Вт апр 09, 2013 8:56 pm 
Не в сети
Аватара пользователя

Зарегистрирован: Пн окт 27, 2008 10:10 pm
Сообщения: 751
0CodErr писал(а):
Пример с Buf2d и Libimg.
Читаем png-файл с иконками. Выводим несколько буферов в окно, перед выводом буфера рисуем в него иконку.

Интересные примеры. Если функции buf2d_create и buf2d_delete перенести из перерисовки в начало и конец программы, то рисовать должно быстрее.
Находил недавно проэкт http://www.qb64.net/ , в котором сделана версия QBasic для 64 битного виндовса и других ОС. Может даже есть исходные коды, но я пока не искал.


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Ср апр 17, 2013 3:28 pm 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Пример с Box_lib.
Используются 4 компонента Frame.

Исходный код:
Спойлер: Показать
Код:
 ' 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


Результат:
Спойлер: Показать
Изображение


Последний раз редактировалось 0CodErr Ср апр 17, 2013 4:20 pm, всего редактировалось 1 раз.

Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Ср апр 17, 2013 3:54 pm 
Не в сети
Kernel Developer

Зарегистрирован: Вс фев 10, 2013 12:37 pm
Сообщения: 2329
0CodErr
Мог бы для двух нижних указать расположения текста в нижней части.

_________________
Всем чмоки в этом проекте! Засуньте эти 11 лет себе в жопу!


Вернуться к началу
 Заголовок сообщения: Re: FreeBasic
СообщениеДобавлено: Ср апр 17, 2013 4:20 pm 
Не в сети

Зарегистрирован: Вс окт 30, 2011 6:43 pm
Сообщения: 1082
Mario_r4 писал(а):
0CodErr
Мог бы для двух нижних указать расположения текста в нижней части.
Сделал на двух нижних ".text_position = 1" и поменял скриншот.


Вернуться к началу
Показать сообщения за:  Поле сортировки  
Начать новую тему  Ответить на тему  [ 23 сообщения ]  На страницу 1 2 След.

Часовой пояс: UTC+03:00


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 1 гость


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Limited
Русская поддержка phpBB