FreeBasic
Главная
Вход
Регистрация
Суббота, 20.04.2024, 00:56Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Форум » Freebasic » Проекты с закрытым или полузакрытым кодом » type (arg...) (Инициация значений в типе ,переменным количеством аргументов)
type (arg...)
ntvgjhfnjДата: Воскресенье, 12.06.2022, 08:17 | Сообщение # 1
Лейтенант
Группа: Проверенные
Сообщений: 59
Репутация: 1
Статус: Offline
Собственно сырой вариат GUI.

Присваивание значений переменным простым перечислением в свободном порядке.
Отлавливание ошибок и неккректного ввода не реализованно.

P.S. побольше бы примеров с разными макросами. особенно в формировании команд типа Line () или разным знакам типа != логическое отрицание

Код
/'
PUI.bi
'/

#Include Once "windows.bi"
#Ifdef __FB_MAIN__
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using fb
#EndIf

ScreenRes 800, 600, 32, 2
ScreenSet 1, 0
Color RGB(255, 128, 0), &Hcfcfcf
Cls

dim Shared e as EVENT
Dim Shared As Integer mx, my, mdx, mdy, mz, mb, mr, omb, click, pressKey
#EndIf

#Ifndef __MACROS__
#define __MACROS__
#Undef NULL
#Define NULL CPtr(Any Ptr, 0)

#Undef RndRGB
#Define RndRGB ( CULng(Rnd() * &hFFFFFF) + &hFF000000ul )
#Undef Rd
#define Rd( c ) (( c ) Shr 16 And 255 )
#Undef Gr
#define Gr( c ) (( c ) Shr 8 And 255 )
#Undef Bl
#define Bl( c ) (( c )And 255 )
#Undef clip
#Define clip(c) IIf( c > 255, 255, IIf( c < 0, 0, c))
#Undef RGBColor
#define RGBColor(r, g, b) ((((r) Shl 16) + ((g) Shl 8)) + (b))
#Undef RGBAlpha
#define RGBAlpha(r, g, b, a) (((((a) Shl 24) + ((r) Shl 16)) + ((g) Shl 8)) + (b))
#Undef clip
#Define clip(c) IIf( c > 255, 255, IIf( c < 0, 0, c))

#Undef rez
#Define rez(a,b,c,d) If LCase(a) = LCase(b) Then c = d
#EndIf
'
'[ GraphicalFunctions
#Define WindowContrast 50

Sub frect(x As UInteger,y As UInteger,w As UInteger,h As UInteger,colore As uinteger = RGB(130,130,130), border As Integer = 0, invert As boolean =False)
Dim As uinteger r,g,b, r1,g1,b1, r2,g2,b2
'If border < 0 Then border = 0

r = rd(colore) : g = gr(colore) : b = bl(colore)
line (x+1,y+1)-(x+w-2,y+h-2),colore,BF

If invert = False then
r1 = Clip(r+WindowContrast)
g1 = Clip(g+WindowContrast)
b1 = Clip(b+WindowContrast)
r2 = Clip(r-WindowContrast)
g2 = Clip(g-WindowContrast)
b2 = Clip(b-WindowContrast)
Else
r1 = Clip(r-WindowContrast)
g1 = Clip(g-WindowContrast)
b1 = Clip(b-WindowContrast)
r2 = Clip(r+WindowContrast)
g2 = Clip(g+WindowContrast)
b2 = Clip(b+WindowContrast)
EndIf

ScreenLock
For i As Integer = 0 To border
Line (x+i,y+i)-(x+w-(1*i),y+i),RGB(r1,g1,b1)
Line (x+i,y+i)-(x+i,y+h-(1*i)),RGB(r1,g1,b1)
Line (x+w-(1*i),y+i)-(x+w-(1*i),y+h-(1*i)),RGB(r2,g2,b2)
Line (x+w-(1*i),y+h-(1*i))-(x+i,y+h-(1*i)),RGB(r2,g2,b2)
Next
ScreenUnLock
End Sub
']
'[ dictionary
Type dictionary
As String operand(any), valueString(Any)
As Double valueDouble(Any)
As boolean valueBoolean(Any)
As Byte bval(Any)

Declare Constructor()
End Type
Constructor dictionary()
End Constructor

'Function setAsArray( s As String, arr() As String) As dictionary
Function setdictionary( s As String) As dictionary
Dim As dictionary aa
If Len(s) = 0 Then Return aa

Dim As String r,r1,r2
Dim As Integer i, idx
s+=","
For i = 0 To Len(s) -1
If s [i]<> 32 Then r += Chr(s)
Next
s = r
r = ""

For i = 0 To Len(s) -1
idx = InStr(s, ",")
If idx <> 0 Then
r = Left(s,idx-1)
s = Mid(s,idx+1, Len(s) -1)

idx = InStr(r,"=")
If idx <> 0 Then
r1 = Mid(r,1,idx-1)
r2 = Mid(r,idx+1,Len(r) -1)

ReDim Preserve aa.operand(UBound(aa.operand)+1)
ReDim Preserve aa.valueString(UBound(aa.valueString)+1)
ReDim Preserve aa.valueDouble(UBound(aa.valueDouble)+1)
ReDim Preserve aa.valueBoolean(UBound(aa.valueBoolean)+1)
ReDim Preserve aa.bval(UBound(aa.bval)+1)

aa.operand(UBound(aa.operand)) = r1
If r2[0] = 34 Then
aa.valueString(UBound(aa.valueString)) = r2
aa.bval(UBound(aa.bval)) = 0
Else
If LCase(r2) = "false" Then
aa.valueBoolean(UBound(aa.valueBoolean)) = false
aa.bval(UBound(aa.bval)) = 3
ElseIf LCase(r2) = "true" Then
aa.valueBoolean(UBound(aa.valueBoolean)) = true
aa.bval(UBound(aa.bval)) = 3
Else
aa.valueDouble(UBound(aa.valueDouble)) = CDbl(r2)
aa.bval(UBound(aa.bval)) = 1
EndIf

EndIf
'Print " e: ";r, r1, r2
EndIf
EndIf
Next i
Return aa
End Function
']
'[ DisplayObject {"x","y","z","w","h","width","height","Name" }
'
'Dim Shared As WString * 50 dictData(10) => {"x","y","z","w","h","width","height","Name" }

Type DisplayObject extends object
'[ Свойства:
As Double x,y,z,w,h
As String Name
As boolean visible
As UInteger id

Enum obj_state
NORMAL = 0, DISABLED
End Enum
As obj_state state
']
'[ Методы:
Declare Constructor ()
']
'[ События:
Declare Function Over()As boolean
']
End Type

Constructor DisplayObject()
End Constructor

Function DisplayObject.Over()As boolean
If e.x > x And e.x < x + w And e.y > y And e.y < y +h Then Return true Else Return false
End Function
']
'[ Tk (ãëàâíîå åäèíñòâåííîå îêíî)
']
'[ Toplevel (äî÷åðíåå îêíî)
']
'[ PanedWindow (ýëåìåíò ðàçäåëåíèÿ îêíà)
']
'[ Frame (âèäæåò äëÿ ãðóïïèðîâêè äðóãèõ âèäæåòîâ)
Type Frame_ extends DisplayObject
'[ Свойства:
As integer Ptr winName
As Integer normBg ' active_Background : Öâåò ôîíà (êîãäà ïîëîñó ïðîêðóòêè äâèãàþò).
As Integer actBg ' active_Background : Öâåò ôîíà (êîãäà ïîëîñó ïðîêðóòêè äâèãàþò).
As Integer disBg ' disabled_Background : Öâåò ôîíà (êîãäà ñâîéñòâî state == DISABLED).
']
'[ Методы:
Declare Constructor ()
Declare Constructor (s As String)
Declare Constructor (win As Integer Ptr = null, s As String)
Declare Sub Update ()
Declare Sub Drawing ( what_color As Integer = rgb(187,190,202) )
']
Private:
As String dataString
End Type

Constructor Frame_()
End Constructor

Constructor Frame_(win As Integer Ptr = null, s As String)
normBg = &Hb5b5b5
actBg = &Hcfcfcf
disBg = &He8e8e8

dataString = s
Var dict = setdictionary ( s )

For j As Integer = 0 To UBound(dict.operand )
'? j:
rez(dict.operand(j),"x", base.x, dict.valueDouble(j))
rez(dict.operand(j),"y", base.y, dict.valueDouble(j))
rez(dict.operand(j),"z", base.z, dict.valueDouble(j))
rez(dict.operand(j),"w", base.w, dict.valueDouble(j))
rez(dict.operand(j),"width", base.w, dict.valueDouble(j))
rez(dict.operand(j),"h", base.h, dict.valueDouble(j))
rez(dict.operand(j),"height", base.h, dict.valueDouble(j))
rez(dict.operand(j),"name", base.Name, dict.valueString(j))
rez(dict.operand(j),"visible", base.visible, dict.valueBoolean(j))
Next
End Constructor

Sub Frame_.Update ()
? x, y,w,h, e.x, e.y
If over Then Drawing(actbg) Else Drawing(normbg)

End Sub

Sub Frame_.Drawing ( what_color As Integer = rgb(187,190,202) )
frect( x,y,w,h,what_color,0)
End Sub

#Define Frame(win_, arg...) Type<Frame_>(win_, #arg)

var c = Frame( ,x=13, y=145,name="Hello world!",visible = true , height=100,w=120)
? c.x, c.y, c.name, c.visible

']
'[ LabelFrame (àíàëîã Frame, òîëüêî ñ çàãîëîâêîì)
Type LabelFrame extends DisplayObject
'[ Ñâîéñòâà:

']
'[ Ìåòîäû:

']
Private:
As String dataString
End Type
']
'[ Canvas (ïîëå äëÿ ðèñîâàíèÿ)
']
'[ Canvas (ïîëå äëÿ ðèñîâàíèÿ)
']
'[ Label (ìåòêà)
']
'[ Button (êíîïêà)
']
'[ Checkbutton (ôëàæîê)
']
'[ Radiobutton (ðàäèî-êíîïêà)
']
'[ Menubutton
']
'[ Scale (ïîëçóíîê)
']
'[ Scrollbar (ïîëîñà ïðîêðóòêè)
']
'[ Menu (ãëàâíîå ìåíþ)
']
'[ Listbox (ñïèñîê)
']
'[ TreeView
']
'[ Notebook
']
'[ Message
']
'[ Progressbar
']
'[ Spinbox
']
'[ Text (ìíîãîñòðî÷íîå ïîëå äëÿ ââîäà)
']
'[ Entry (îäíîñòðî÷íîå ïîëå äëÿ ââîäà)
']
'[ Separator
']
'[ Sizegrip
']
''' exemple '''
'[
#Ifdef __FB_MAIN__

Do

'If key = "" Then pressKey = 0
'ex = 100 : ey = 20
omb = mb : mb = 0

'GetMouse(mx, my, mz, mb)
'If mb = 0 Then click = 0
'WindowTitle ( "Mouse x,y [ " & mx & ", " & my &" ]" )'& " Num: " & num)

'[ ScreenEvent( E )
If (ScreenEvent(@e)) Then
Select Case e.type
Case EVENT_KEY_PRESS
'kp = 1
If (e.scancode = SC_ESCAPE) Then
Exit Do ' End
End If
If (e.ascii > 0) Then
'Print "'" & e.ascii & "'";
Else
'Print "unknown key";
End If
'Print " was pressed (scancode " & e.scancode & ")"
Case EVENT_KEY_RELEASE
If (e.ascii > 0) Then
'Print "'" & e.ascii & "'";
Else
'Print "unknown key";
End If
'Print " was released (scancode " & e.scancode & ")"
Case EVENT_KEY_REPEAT
If (e.ascii > 0) Then
'Print "'" & e.ascii & "'";
Else
'Print "unknown key";
End If
'Print " is being repeated (scancode " & e.scancode & ")"
Case EVENT_MOUSE_MOVE
mx = e.x
my = e.y
mdx = e.dx
mdy = e.dy
Case EVENT_MOUSE_BUTTON_PRESS
If (e.button = BUTTON_LEFT) Then
mb = 1
ElseIf (e.button = BUTTON_RIGHT) Then
mb = 2
Else
mb = 4
End If
Case EVENT_MOUSE_BUTTON_RELEASE
If (e.button = BUTTON_LEFT) Then
mr = 1
ElseIf (e.button = BUTTON_RIGHT) Then
mr = 2
Else
mr = 4
End If
Case EVENT_WINDOW_CLOSE
Exit Do 'End
End Select
EndIf
']

ScreenLock
Cls

c.update()
'c.drawing()
ScreenUnlock
'? key
'Locate 2,2 : ? l.getItembyid(2)->dn
Sleep 5
Flip
Loop Until MultiKey(&H01) Or Inkey = Chr(255)+"k" 'loop until ESC key pressed
'ImageDestroy( plus11 )
'ImageDestroy( minus11 )
'While Inkey <> "": Wend
End
#endif
']

[b]Добавлено[/b][/i]
(16.06.2022, 12:51)
---------------------------------------------
ссылка на скачивания архива

https://transfiles.ru/0i69d

запускать Test TUI

P.S. так и не понял как тут прикреплять архивы, пишет не тот формат изображения. Админы сами хоть прикрепите, а? cry
Прикрепления: TUI.rar (9.5 Kb)


Сообщение отредактировал ntvgjhfnj - Четверг, 16.06.2022, 19:35
 
haavДата: Четверг, 16.06.2022, 13:12 | Сообщение # 2
Генералиссимус
Группа: Администраторы
Сообщений: 1361
Репутация: 49
Статус: Offline
Нечего приклеплять , по ссылке ничего нет.

Если есть желание , любой пользователь может залить файлы на сторонний сервис , а сюда закреплять ссылку. Почти тоже самое я написал здесь


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
ntvgjhfnjДата: Четверг, 16.06.2022, 19:37 | Сообщение # 3
Лейтенант
Группа: Проверенные
Сообщений: 59
Репутация: 1
Статус: Offline
ссылку исправил

polopok
 
haavДата: Четверг, 16.06.2022, 21:43 | Сообщение # 4
Генералиссимус
Группа: Администраторы
Сообщений: 1361
Репутация: 49
Статус: Offline
Архив закрепил в первом посте. Запустил и проверил , тестовый пример работает. Неплохо бы посмотреть в сторону юникода , чтобы были не только латинские символы. Есть библиотека как раз для этого: xfont или другие вроде freetype.

Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
ntvgjhfnjДата: Пятница, 17.06.2022, 16:44 | Сообщение # 5
Лейтенант
Группа: Проверенные
Сообщений: 59
Репутация: 1
Статус: Offline
насчет уникода , возможно в будующем.
решил переделать , а то когда составные элементы делаешь мешанина получается.

P.S. возможно стоит перенести тему в ветку Исходники , когда создавал тему поторопился.


polopok
 
zamabuvaraeuДата: Пятница, 17.06.2022, 18:30 | Сообщение # 6
Подполковник
Группа: Друзья
Сообщений: 147
Репутация: 4
Статус: Offline
А что сложного в юникоде? Для этого достаточно сделать #define UNICODE.
 
ntvgjhfnjДата: Суббота, 18.06.2022, 14:32 | Сообщение # 7
Лейтенант
Группа: Проверенные
Сообщений: 59
Репутация: 1
Статус: Offline
Так, переписал, вроде лучше стало, хотя можно и нужно код улучшить.
добавил составные элементы при инициации элемента.

... PUI.bi заархивировал

Добавлено (08.11.2022, 19:12)
---------------------------------------------
Получение значений аргументов через файл.
Код

#Ifndef NULL
#Define NULL CPtr(Any Ptr, 0)     
#EndIf

#Macro P(a ...)
If #a <> "" Then
    Dim As Integer ff = FreeFile
    Dim As String s, v = #a

    Open "Atest" For Output As #ff
    Write #ff, a : Close #ff
    
    Open "Atest" For Input As #ff
    If LOF(ff) > 0 Then Line Input #ff, s Else Print "Error." EndIf : Close #ff : Kill("Atest")
    Print s
    Print v
    Print
EndIf
#EndMacro

Const none = ""

Sub def()
    
End Sub

p("type",123,12.7, @def,none, false,null,-8)
Sleep


Добавлено (14.11.2022, 08:57)
---------------------------------------------
Ещё один способ передачи arg строкой в тип
Код

Type T
    As String s
    As String ss
    Declare Constructor()
End Type

Constructor t()
End Constructor

Dim As t p, h
p.s = "we"

'''''''''''
Declare Function r (ByRef tt As t, s As String ) As t
Declare Function rs ( s As String = "") As String

#Define er(arg ...) #arg
#Define re(arg ...) r(p, er(arg))

Function r (ByRef tt As t, s As String ) As t
    tt.s = s
    Return tt
End Function
'''''''

h = re(123,435,"vedo",@p)
? h.s

Sleep


Увы значения arg таким способом получить немогу. ( тупо не понимаю как)

Добавлено (17.11.2022, 13:11)
---------------------------------------------
Совсем мозг сломал bash с получением ARG ... (переменных аргументов) , но ...

Вот что получилось wink
Код

Const none = ""

Function my Cdecl(ByRef fs As String, ...) As String
    Dim As Any Ptr arg = va_first()
    Dim j As Integer = 0, tr As boolean, s As String, ss As String = ""

    fs &= ","
    While j < Len(fs)
  If fs[j] = 34 Then tr = Not tr    '  = "

  If fs[j] <> 32 And tr = false Then ss &= Chr(fs[j]) '  = SPACE
  If tr Then ss &= Chr(fs[j])
  j += 1
    Wend
    fs = ss ': ? fs
    j = 0 : ss = "" : tr = true
    '? "--------------------------------------------------"

    While j < Len(fs)
  If fs[j] = 34 Then tr = Not tr    '  = "
  If fs[j] = 40 Or fs[j] = 41 Then tr = Not tr    '  = ()

  s &= Chr(fs[j])

  If fs[j] = 44 And tr Then ' = ,

   s = Mid(s,1,Len(s)-1)
  '    ? s
   
   Select Case (s[0])
    Case 34    '  = "
     ss &= s & ","
     arg = va_next(arg, Any Ptr )

    Case 64    '  = @
     ss &= Str(va_arg(arg, Any Ptr)) & ","
     arg = va_next(arg, Any Ptr)

    Case 48 To 57,45    ' öèôðû
     If InStr(Str(s), ".") = 0 Then
      ss &= Str(va_arg(arg, Integer )) & ","
      arg = va_next(arg, Integer)
     Else
      ss &= Str(va_arg(arg, Double)) & ","
      arg = va_next(arg, Double)
     EndIf

    Case 78,110    '  = N/n
     If LCase(s) = "none" Then
      ss &= "[ Undefined ]" & ","
      arg = va_next(arg, Any Ptr)
     Else
      ss &= Str(va_arg(arg, Any Ptr)) & ","
      arg = va_next(arg, Any Ptr)
     EndIf

    Case 70,84,102,116    ' f/F/t/T
     If LCase(s) = "false" Or LCase(s) = "true" Then
      ss &= s & ","
      arg = va_next(arg, Any Ptr)
     Else
      ss &= "[ Undefined ]" & ","
      arg = va_next(arg, Any Ptr)
     EndIf

    Case else
     ss &= "[ Undefined ]" & ","
     arg = va_next(arg, Any Ptr)
   End Select

   s = ""
  EndIf

  j += 1
    Wend
    '/
    '? "--------------------------------------------------"
    '? ss
    ss = Mid(ss,1,Len(ss)-1)
    'Print
    Return ss
End Function

Type t : As Integer i : End Type
Dim As t tt

Dim As String s1 = "bar", s
? "@s1 = ";@s1
? "--------------------------------------------------"

#Define re(arg ...) my(#arg, arg)
s = re(4,12.2    ,"r  ty",@s1, false, none, @tt)
'
? "--------------------------------------------------"
? "Function returned 'String'"
? "s = ";s
Sleep


Добавлено (11.12.2022, 17:34)
---------------------------------------------
Предлагаю некую замену в коде:
часть подлежащая замене: #Define ___(arg ...) my(#arg, arg)

Код

? "--------------------------------------------------"

#Define ___(arg ...) my(#arg, arg)
s = ___(4,12.2    ,"r  ty",@s1, false, none, @tt)
'
? "--------------------------------------------------"

Добавлено (27.05.2023, 20:19)
---------------------------------------------
Продолжая пилить аргументы ...



странно в этом то,что значения в типах как бы поменялись ... возможно кто допилит сам.
Прикрепления: PUI.rar (12.3 Kb)


polopok

Сообщение отредактировал ntvgjhfnj - Воскресенье, 11.12.2022, 17:36
 
Форум » Freebasic » Проекты с закрытым или полузакрытым кодом » type (arg...) (Инициация значений в типе ,переменным количеством аргументов)
  • Страница 1 из 1
  • 1
Поиск: