PureBasic Forums - English

Code: Select all

; PureBasic 4 - Hey Ma, look what I can do!
; Showing:

Enumeration    ; WINDOWS
  #_winMain
EndEnumeration
Enumeration    ; GADGETS
  #_gTxtLookAtMe
  #_gBtnToggleWindow
  #_gBtnToggleText
EndEnumeration

; Macro to set all PureBasic colour properties for gadget
Macro colorGadget(gadgetNum, backColor=$FFFFFF, foreColor=0, lineColor=0)
  If IsGadget(gadgetNum)
    SetGadgetColor(gadgetNum,#PB_Gadget_BackColor,backColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_FrontColor,foreColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_LineColor,lineColor)
  EndIf
EndMacro
; Procedure to do same as Macro.
Procedure gadgetColoring(gadgetNum, backColor=$FFFFFF, foreColor=0, lineColor=0)
  If IsGadget(gadgetNum)
    SetGadgetColor(gadgetNum,#PB_Gadget_BackColor,backColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_FrontColor,foreColor)
    SetGadgetColor(gadgetNum,#PB_Gadget_LineColor,lineColor)
  EndIf
EndProcedure

windowBG_now.l   = RGB($FF,$FF,$E0)
windowBG_later.l = RGB($E0,$F0,$FF)

textBG_now.l = RGB($FF,$00,$00)
textFG_now.l = RGB($FF,$FF,$00)
textBG_later.l = RGB($FF,$FF,$00)
textFG_later.l = RGB($FF,$00,$00)

; Let's Not and say we did!
If Not OpenWindow(#_winMain, 0,0, 200,200, #PB_Window_Invisible|#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Hey Ma!")
  MessageRequester("ERROR", "Could not open the main window. :(", #MB_ICONERROR)
  End
EndIf
If Not CreateGadgetList(WindowID(#_winmain)) 
  MessageRequester("ERROR", "Could not create gadget list. :(", #MB_ICONERROR)
  CloseWindow(#_winMain)
  End
EndIf

; Colouring in.
SetWindowColor(#_winMain,windowBG_now)

TextGadget(#_gTxtLookAtMe, 5,20, 190,18, "L O O K   A T   M E",#PB_Text_Center)
colorGadget(#_gTxtLookAtMe, textBG_now, textFG_now)    ; Macro used, 2 of 3 parameters
ButtonGadget(#_gBtnToggleText, 50,60, 100,20, "TOGGLE TEXT")
ButtonGadget(#_gBtnToggleWindow, 50,100, 100,20, "TOGGLE WINDOW")

HideWindow(#_winMain,#False) 

Repeat 
  EventID.l=WaitWindowEvent() 
  If EventID=#PB_Event_CloseWindow 
    Quit = 1 
  ElseIf EventID=#PB_Event_Gadget 
    Select EventGadget()                                      ; Whup! No longer has ID suffix
    Case #_gBtnToggleText
      Swap textBG_now, textBG_later                           ; Swap!
      Swap textFG_now, textFG_later
      GadgetColoring(#_gTxtLookAtMe, textBG_now, textFG_now)  ; Proc, no third param
    Case #_gBtnToggleWindow
      Swap windowBG_now, windowBG_later                       ; Swap!
      SetWindowColor(#_winMain,windowBG_now)
    EndSelect
  EndIf
Until Quit = 1 

CloseWindow(#_winMain)
End

Code: Select all

EnableExplicit

#AU3_INTDEFAULT = -2147483647
#AU3_MEMBuffer = 65536

Macro AU3_LL(a, b, c, d); LoadLibrary
  If d
    c = a#M(d)
  Else
    If b
      c = a#_(b)
    Else
      c = a#_("AutoItX3.dll")
    EndIf
  EndIf
EndMacro

Macro AU3_FL(a,b,c); FreeLibrary
  If c
    a#M(b)
  Else
    a#_(b)
  EndIf
EndMacro

Macro AU3_GPA(a, b, c, d, e); GetProcAddress
  If e
    d = a#M(b, c)
  Else
    d = a#_(b, c)
  EndIf 
EndMacro

;{ Prototypes
Prototype.l AU3_error()
Prototype.l AU3_AutoItSetOption(szOption.s, nValue.l)
Prototype   AU3_BlockInput(nFlag.l)
Prototype   AU3_CDTray(szDrive.s, szAction.s)
Prototype   AU3_ClipGet_(szClip.l, nBufSize.l)
;}

;{ Globale Variablen
Global AU3_error.AU3_error
Global AU3_AutoItSetOption.AU3_AutoItSetOption
Global AU3_BlockInput.AU3_BlockInput
Global AU3_CDTray.AU3_CDTray
;}

Procedure.s AU3_ClipGet()
  Protected AU3_ClipGet_.AU3_ClipGet_
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_ClipGet", AU3_ClipGet_, AU3_LoadFromMemory)
  AU3_ClipGet_(AU3_MEMBuffer, #AU3_MEMBuffer)
  ProcedureReturn PeekS(AU3_MEMBuffer)
EndProcedure

Procedure AU3_Init(DLLname.s = "", DLLMempointer.l = 0)
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  If DLLMempointer
    AU3_LoadFromMemory = #True
  EndIf
  AU3_LL(LoadLibrary, DLLname, AU3_DLLhWnd, DLLMempointer)
  If AU3_DLLhWnd
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_error", AU3_error, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_AutoItSetOption", AU3_AutoItSetOption, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_BlockInput", AU3_BlockInput, AU3_LoadFromMemory)
    AU3_GPA(GetProcAddress, AU3_DLLhWnd, "AU3_CDTray", AU3_CDTray, AU3_LoadFromMemory)
    AU3_Membuffer = AllocateMemory(#AU3_MEMBuffer)
    If Not AU3_Membuffer
      ProcedureReturn #False
    EndIf
  EndIf
  ProcedureReturn AU3_DLLhWnd
EndProcedure

Procedure AU3_End()
  Shared AU3_DLLhWnd.l, AU3_LoadFromMemory.l, AU3_Membuffer.l
  If AU3_DLLhWnd
    AU3_FL(FreeLibrary,AU3_DLLhWnd, AU3_LoadFromMemory)
    FreeMemory(AU3_Membuffer)
  EndIf  
EndProcedure

If AU3_Init()
  Debug AU3_ClipGet()
  AU3_CDTray("s:","open")
  AU3_End()
EndIf
; DataSection
;   DLL: IncludeBinary "AutoItX3.dll"
; EndDataSection

Code: Select all

; Two Macros defined

Macro uWord(valu)            ; This will be used to change any "uWord" found in code
  (valu & $FFFF)             ;   The text "value" is replaced by the parameter provided
EndMacro

Macro uByte(valu = $80)      ; This will be used to change any "uByte" found in code
  (valu & $FF)               ;   The text "value" is replaced by the parameter provided
EndMacro                     ;   If no parameter is provided, default $80 (128 or -1) is used

;Test data

myByte.b = -1
myWord.w = $8000

Debug "------- BYTE"
Debug myByte
Debug uByte(myByte)          ; Before compiling, resolved to: Debug (myByte & $FF)
Debug uByte(PeekB(@myByte))  ; Before compiling, resolved to: Debug (PeekB(@myByte) & $FF)

Debug "------- WORD"
Debug myWord
Debug uWord(myWord)
Debug uWord(PeekW(@myWord))

Debug "------- BYTE, option parameter used"
Debug uByte()                ; Before compiling, resolved to: Debug ($80 & $FF)
Debug ($80 & $FF)

Code: Select all

; In case the parent program has defined these before including this file

CompilerIf Defined(myStructure, #PB_Structure) = #False

  Structure myStructure 
    myWord.w
    myLong.l
  EndStructure

CompilerEndIf

; Note. The #_filler_group constant is used here just so that I don't
; have to do a CompilerIf Defined for every single one of a related
; group of constants. Could have as easily used the first, I guess.

CompilerIf Defined(_filler_group, #PB_Constant) = #False

  #_filler_group = 0
  
  #_filler_byte = $FF
  #_filler_word = $FFFF
  #_filler_long = $FFFFFFFF

CompilerEndIf


Procedure FillItUp(*ItIs.myStructure)
  *ItIs\myWord = #_filler_word
  *ItIs\myLong = #_filler_long
EndProcedure

Code: Select all

; In case any included file has defined these
;  And yes, there are no prior includes, but let us pretend there are. :)

CompilerIf Defined(myStructure, #PB_Structure) = #False

  Structure myStructure 
    myWord.w
    myLong.l
  EndStructure

CompilerEndIf

XIncludeFile "inc_compilerIfTest.pb"

; Just to prove it, do it this side of the include

CompilerIf Defined(_filler_group, #PB_Constant) = #False

  #_filler_group = 0
  
  #_filler_byte = $FF
  #_filler_word = $FFFF
  #_filler_long = $FFFFFFFF

CompilerEndIf

ThisIs.myStructure

FillItUp(@ThisIs)

Debug ThisIs\myWord
Debug ThisIs\myLong

Code: Select all

enableexplicit

Global Dim names.s(3)
Global NewList queue.s()
Global counter.l, mutex.l
names(0) = "peter"
names(1) = "hans"
names(2) = "franz"
names(3) = "juuli"
mutex = CreateMutex()


Procedure thread(index.l)
  Protected name.s, z.l
  name = names(index)
  
  z = 0
  Repeat
    
    LockMutex(mutex)
      counter + 1
      AddElement(queue())
      queue() = name
    UnlockMutex(mutex)
    Delay(Random(500) + 200)
    
    z + 1
  Until z = 20
EndProcedure


Define.l t
t = CreateThread(@thread(), 0)
t = CreateThread(@thread(), 1)
t = CreateThread(@thread(), 2)
t = CreateThread(@thread(), 3)


Repeat
  LockMutex(mutex)
    ForEach queue()
      Debug queue()
      DeleteElement(queue())
    Next
  UnlockMutex(mutex)
  
  Delay(50)
Until counter = 80

FreeMutex(mutex)

Code: Select all

Import "Full\Path\To\SillyStringThing.obj"

  StringToLower.l(ptrStr.l) As "_sillyString2Lower@4"   ; your alias As real name

  StringToUpper.l(ptrStr.l) As "_sillyString2Upper@4"   ; Note the @4 advising 4 bytes of params
                                                        ; In this case 1xLong (the string address) = 4 bytes
EndImport 

w.s="aBC123DEf"
Debug w
r = StringToLower(@w)   ; Note the @w, to pass the address!
Debug w
r = StringToUpper(@w)   ; Return value is junk, just the string address back.
Debug w