#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
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)
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
'[ 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) --------------------------------------------- ссылка на скачивания архива
Если есть желание , любой пользователь может залить файлы на сторонний сервис , а сюда закреплять ссылку. Почти тоже самое я написал здесь Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
Архив закрепил в первом посте. Запустил и проверил , тестовый пример работает. Неплохо бы посмотреть в сторону юникода , чтобы были не только латинские символы. Есть библиотека как раз для этого: xfont или другие вроде freetype. Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
Так, переписал, вроде лучше стало, хотя можно и нужно код улучшить. добавил составные элементы при инициации элемента.
... 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
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) --------------------------------------------- Совсем мозг сломал с получением ARG ... (переменных аргументов) , но ...
Вот что получилось
Код
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 ? "--------------------------------------------------"