Изучение основ FreeBasic в сравнении с PowerBasic

TYPE Persons
    Name AS STRING
    Surname AS STRING
    Age AS BYTE = 35
END TYPE
 
DIM Vpersons AS Persons
 
Vpersons.Name="Richard"
Vpersons.Surname="Black"
 
? Vpersons.Name
? Vpersons.Surname
? Vpersons.Age
Sleep

#COMPILE EXE
#DIM ALL
 
TYPE Persons
  Name AS STRING*10       'если здесь написать "Name AS STRING", компилятор бастует
  Surname AS STRING*10   'если здесь написать "Surname AS STRING", компилятор бастует
  Age AS BYTE           'значение по умолчанию здесь присвоить не получится
END TYPE
 
FUNCTION PBMAIN () AS LONG
DIM Vpersons AS Persons
 
  Vpersons.Name="Richard"
  Vpersons.Surname="Black"
  Vpersons.Age = 35
 
  ? Vpersons.Name
  ? Vpersons.Surname
  ? Vpersons.Age
 
  SLEEP 5000    'если SLEEP без указания продолжительности, компилятор бастует
END FUNCTION

Import "User32.lib"
  MessageBoxW(Window, Body.p-unicode, Title.p-unicode, Flags.l = 0)
EndImport
 
MessageBoxW(0, "Hello", "World")

If OpenLibrary(0, "User32.dll")
  CallFunction(0, "MessageBoxW", 0, @"Hello", @"World", 0)
  CloseLibrary(0)
EndIf

Prototype MessageBox(Window, Body.p-unicode, Title.p-unicode, Flags.l = 0)
 
If OpenLibrary(0, "User32.dll")
  MessageBox.MessageBox = GetFunction(0, "MessageBoxW")
  If MessageBox
    MessageBox(0, "Hello", "World")
  EndIf
  CloseLibrary(0)
EndIf

If OpenLibrary(0, "ADDONE.dll")
  MessageRequester("Результат", ""+CallFunction(0, "AddOne", 20))
  CloseLibrary(0)
Else
  MessageRequester("Ошибка", "Нет dll")
EndIf

#include once "crt.bi"
#include once "crt\stdlib.bi"
 
' Функция сравнения
Function CompareLongs(ByVal p As Const Any Ptr, ByVal q As Const Any Ptr) As Long
    Dim x As Long = *CPtr(Long Ptr, p)
    Dim y As Long = *CPtr(Long Ptr, q)
    
    Select Case x
        Case Is < y
            ' Вернуть -1: в порядке возрастания
            ' Вернуть 1: в порядке убывания
            Return -1  
        Case Is > y
            ' Вернуть 1: в порядке возрастания
            ' Вернуть -1: в порядке убывания
            Return 1
        Case Else   
            Return 0
    End Select
    
End Function
 
' Сортировать массив чисел типа Long
Sub SortLongs(a() As Long)
    qsort(@a(LBound(a)), UBound(a) - LBound(a) + 1, SizeOf(Long), @CompareLongs)
End Sub
 
' Массив
Dim Vector(4) As Long
Vector(0) = 5
Vector(1) = 3
Vector(2) = 2
Vector(3) = 1
Vector(4) = 4
 
' Сортируем
SortLongs(Vector())
 
' Вывести на консоль
For i As Integer = 0 To 4
    Print Vector(i)
Next

#include once "windows.bi"
#include once "crt.bi"
#include once "crt\stdlib.bi"
 
Type Person
    Name As WString * 64
    Surname As WString * 64
    Age As Integer
End Type
 
' Функция сравнения
Function ComparePersons(ByVal p As Const Any Ptr, ByVal q As Const Any Ptr) As Long
    Dim x As Person Ptr = CPtr(Person Ptr, p)
    Dim y As Person Ptr = CPtr(Person Ptr, q)
    
    ' Сравнить фамилии
    Dim resCompareSurname As Long = lstrcmpW(x->Surname, y->Surname)
    
    Select Case resCompareSurname
        Case Is < 0
            Return -1  
        Case Is > 0
            Return 1
        Case Else
            ' Фамилии одинаковые
            ' Сравниваем имена
            Dim resCompareName As Long = lstrcmpW(x->Name, y->Name)
            Select Case resCompareName
                Case Is < 0
                    Return -1  
                Case Is > 0
                    Return 1
                Case Else
                    ' Фамилия и имя одинаковые
                    ' Сортируем по возрасту
                    ' Но это будет ваше домашнее задание
                    Return 0
            End Select
    End Select
    
End Function
 
' Сортировать массив чисел типа Long
Sub SorPersons(a() As Person)
    qsort(@a(LBound(a)), UBound(a) - LBound(a) + 1, SizeOf(Person), @ComparePersons)
End Sub
 
' Массив людей
' Небольшая оптимизация:
' Устанавливая переменной значение Any при объявлении
' Мы убираем инициализацию
Dim Persons(4) As Person = Any ' Небольшая оптимизация
Persons(0).Name = WStr("Анна")
Persons(0).Surname = WStr("Петрова")
Persons(0).Age = 51
 
Persons(1).Name = WStr("Иван")
Persons(1).Surname = WStr("Дергунов")
Persons(1).Age = 20
 
Persons(2).Name = WStr("Сергей")
Persons(2).Surname = WStr("Грачёв")
Persons(2).Age = 43
 
Persons(3).Name = WStr("Елена")
Persons(3).Surname = WStr("Смирнова")
Persons(3).Age = 11
 
Persons(4).Name = WStr("Екатерина")
Persons(4).Surname = WStr("Смирнова")
Persons(4).Age = 45
 
' Сортируем
SorPersons(Persons())
 
' Вывести на консоль
For i As Integer = 0 To 4
    Print Persons(i).Name
    Print Persons(i).Surname
    Print Persons(i).Age
Next

#COMPILE EXE
#DIM ALL
 
FUNCTION PBMAIN () AS LONG
  Dim arr_str_Name (2) as string   
  Dim arr_lng_Age_of_death (2) as long 
  
  arr_str_Name (0) = "Пушкин"
  arr_str_Name (1) = "Лермонтов" 
  arr_str_Name (2) = "Некрасов"
  
  arr_lng_Age_of_death (0) = 37
  arr_lng_Age_of_death (1) = 26
  arr_lng_Age_of_death (2) = 56 
   
  'сортировка по алфавиту
  array sort arr_str_Name (), TAGARRAY arr_lng_Age_of_death () 
 
 msgbox arr_str_Name (0) & " скончался в возрасте" & str$ (arr_lng_Age_of_death (0)) & " лет" & $crlf & _
        arr_str_Name (1) & " скончался в возрасте" & str$ (arr_lng_Age_of_death (1)) & " лет" & $crlf & _
        arr_str_Name (2) & " скончался в возрасте" & str$ (arr_lng_Age_of_death (2)) & " лет"   
END FUNCTION

Dim x(10)
 
x(2) = 1234
x(4) = 100
 
SortArray(x(), #PB_Sort_Ascending)
 
For i=0 To ArraySize(x())
  Debug x(i)
Next

ImportC ""
  qsort(*arr, CountElement, SizeElement, *SortFunct)
EndImport
 
Procedure Sort(*x.Integer, *y.Integer)
  If *x\i < *y\i
    ProcedureReturn -1
  ElseIf *x\i > *y\i
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
Dim x(10)
 
x(2) = 1234
x(4) = 100
 
qsort(@x(), ArraySize(x())+1, SizeOf(Integer), @Sort())
 
For i=0 To ArraySize(x())
  Debug x(i)
Next