PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PB 4.00. My little examples for the new version.

https://www.purebasic.fr/english/viewtopic.php?t=19106

Page 1 of 1

PB 4.00. My little examples for the new version.

Posted: Sat Feb 04, 2006 4:44 am
by Hroudtwolf
Code updated For 5.20+

Code: Select all

; 2006 Hroudwolf
; Gadgetcolor example for PB 4.00

wID.l=OpenWindow (#PB_Any,0,0,500,370,"PB 4.00. ListIconGadget",#PB_Window_ScreenCentered|#WS_SYSMENU)
If wID.l ;And CreateGadgetList (WindowID(wID.l))

   ListID.l=ListIconGadget(#PB_Any,10,10,480,300,"",0,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
   AddGadgetColumn (ListID.l,0,"Name",235)
   AddGadgetColumn (ListID.l,1,"Telefon",120)
   AddGadgetColumn (ListID.l,2,"Fax",120)
   SetGadgetColor(ListID.l,#PB_Gadget_BackColor,$D7FFF6)
   SetGadgetColor(ListID.l,#PB_Gadget_LineColor,$000000)
   SetGadgetColor(ListID.l,#PB_Gadget_FrontColor,$8E0000)
   
   AddGadgetItem (ListID.l,-1,"Fred"+Chr(10)+"00213/889 3030"+Chr(10)+"00213/889 3031")
   AddGadgetItem (ListID.l,-1,"Beriko"+Chr(10)+"06331/646100"+Chr(10)+"006331/646101")
   AddGadgetItem (ListID.l,-1,"Freak"+Chr(10)+"01234/331331"+Chr(10)+"01234/331332")
   AddGadgetItem (ListID.l,-1,"Andre"+Chr(10)+"03431/181950"+Chr(10)+"k.A.")
   
   For x=1 To CountGadgetItems (ListID.l)
      CStep.l+1
      Select CStep.l
        Case 1
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$D7FFF6,0)
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$FFF0DF,1)
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$D7FFF6,2)
        Case 2
          CStep.l=0
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$FFF0DF,0)
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$D7FFF6,1)
          SetGadgetItemColor(ListID.l,x-1,#PB_Gadget_BackColor,$FFF0DF,2)
      EndSelect
   Next x
   
     
   
 
Repeat
   Event.l=WaitWindowEvent ()
   
Until Event.l=#WM_CLOSE
EndIf
End

Code: Select all

; 2006 Hroudtwolf
; Directory example for PB 4.00

#MeinDir=1
ExamineDirectory (#MeinDir,"g:\","*.*")
While NextDirectoryEntry (#MeinDir)
  DType.l=DirectoryEntryType(#Meindir)
  DEntry.s=DirectoryEntryName(#MeinDir)
  If DType.l=2
    tmp.s="<"+DEntry.s+">":DEntry.s=tmp.s 
  EndIf
  DLines.s+DEntry.s+Chr(10)
Wend
MessageBox_(0,DLines.s,"Directory",#MB_OK)

Code: Select all

; 2006 Hroudtwolf
; Enviromentvariables example for PB 4.00

ExamineEnvironmentVariables()         
While NextEnvironmentVariable()
  Debug EnvironmentVariableName() + ": "+EnvironmentVariableValue()
Wend

Code: Select all

; 2006 Hroudtwolf
; Menuexample for PB 4.00

Declare ChangeLanguage (Flag.l)

Enumeration
  #Window
  #Menu_ID
  #Menu_Item_New
  #Menu_Item_Load
  #Menu_Item_Save
  #Menu_Item_Exit
  #Menu_Item_German 
  #Menu_Item_English
EndEnumeration

#WindowFlag=#PB_Window_ScreenCentered|#WS_SYSMENU
#German=0
#English=1

If OpenWindow (#Window,0,0,500,300,"PB 4.00. Menü",#WindowFlag)

  If CreateMenu (#Menu_ID,WindowID(#Window))
    MenuTitle ("")
    MenuItem (#Menu_Item_New,"")
    MenuItem (#Menu_Item_Load,"")
    MenuItem (#Menu_Item_Save,"")
    MenuBar()
    MenuItem (#Menu_Item_Exit,"")
    MenuTitle ("")
    MenuItem (#Menu_Item_German, ""):SetMenuItemState (#Menu_ID,#Menu_Item_German,#True)
    MenuItem (#Menu_Item_English, "")
  EndIf


  ChangeLanguage (#German)
  Repeat
    Event.l=WaitWindowEvent ()
    Select Event.l
      Case #PB_Event_Menu
        Select EventMenu()
          Case #Menu_Item_German
            ChangeLanguage (#German)
            SetMenuItemState (#Menu_ID,#Menu_Item_German,#True)
            SetMenuItemState (#Menu_ID,#Menu_Item_English,#False)
          Case #Menu_Item_English
            ChangeLanguage (#English)
            SetMenuItemState (#Menu_ID,#Menu_Item_German,#False)
            SetMenuItemState (#Menu_ID,#Menu_Item_English,#True)
        EndSelect
    EndSelect
 
 
  Until Event.l=#WM_CLOSE
EndIf
End


Procedure ChangeLanguage (Flag.l) 
   ShowWindow_(WindowID(#Window),#SW_HIDE)
   If Flag.l=0
      Restore deutsch
   Else
      Restore english
   EndIf
   Read.s tmp.s:SetMenuTitleText(#Menu_ID, 0,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_New,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_Load,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_Save,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_Exit,tmp.s)
   Read.s tmp.s:SetMenuTitleText(#Menu_ID, 1,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_German,tmp.s)
   Read.s tmp.s:SetMenuItemText(#Menu_ID, #Menu_Item_English,tmp.s)
   ShowWindow_(WindowID(#Window),#SW_NORMAL)
EndProcedure


DataSection
  deutsch:
  Data.s "Datei","Neu","Laden","Speichern","Ende","Einstellungen","Deutsch","Englisch"
  english:
  Data.s "File","New","Load","Save","Exit","Settings","German","English"
EndDataSection

PB 4.00. My little examples for the new version.

Posted: Sat Feb 04, 2006 9:02 pm
by Hroudtwolf
Code updated For 5.20+

Code: Select all

    ; 2006 Hroudtwolf
    ; LinkedList2Procedure example

    Structure _TestStruct
      name.s
      postbox.s
    EndStructure



    Procedure ShowPersonalData (List AliasListe._TestStruct(),Index.l)
      SelectElement(AliasListe(),Index.l)
      MessageBox_(0,AliasListe()\name+" haves "+AliasListe()\postbox+" postbox.","Postbox",#MB_OK)
    EndProcedure
     

    NewList Person._TestStruct()

    AddElement (Person())
    Person()\name="Jim Hampton"
    Person()\postbox="64319"
    AddElement (Person())
    Person()\name="Bill Littlefox"
    Person()\postbox="64252"

    ShowPersonalData (Person._TestStruct(),0)
    ShowPersonalData (Person._TestStruct(),1)

Posted: Sat Feb 04, 2006 9:38 pm
by Berikco
WTF! hey where did you get my phnone number ? :shock:

Posted: Sat Feb 04, 2006 9:42 pm
by SFSxOI
You have to do a 'AddElement (Person())' for each entry or person?
Hroudtwolf wrote:

Code: Select all

; 2006 Hroudtwolf
; LinkedList2Procedure example

Structure _TestStruct
  name.s
  postbox.s
EndStructure



Procedure ShowPersonalData (AliasListe._TestStruct(),Index.l)
  SelectElement(AliasListe(),Index.l)
  MessageBox_(0,AliasListe()\name+" haves "+AliasListe()\postbox+" postbox.","Postbox",#MB_OK)
EndProcedure 
 

NewList Person._TestStruct()

AddElement (Person())
Person()\name="Jim Hampton"
Person()\postbox="64319"
AddElement (Person())
Person()\name="Bill Littlefox"
Person()\postbox="64252"

ShowPersonalData (Person._TestStruct(),0)
ShowPersonalData (Person._TestStruct(),1)

Re: PB 4.00. My little examples for the new version.

Posted: Sat Feb 04, 2006 9:56 pm
by Berikco
Hroudtwolf wrote:

Code: Select all

...
 
Repeat
   Event.l=WaitWindowEvent ()
   
Until Event.l=#WM_CLOSE
EndIf
End
Beter use official PB constants like #PB_Event_CloseWindow and your source will work also on Linux and Mac.

Posted: Sat Feb 04, 2006 10:11 pm
by dmoc
WTF! hey where did you get my phnone number ?
We posted it all over sex sites - it'll be removed once you update VD and tailbite :P

Oops: bit of a pun slipped in there

Re: PB 4.00. My little examples for the new version.

Posted: Sat Feb 04, 2006 10:45 pm
by Hroudtwolf
Berikco wrote:
Hroudtwolf wrote:

Code: Select all

...
 
Repeat
   Event.l=WaitWindowEvent ()
   
Until Event.l=#WM_CLOSE
EndIf
End
Beter use official PB constants like #PB_Event_CloseWindow and your source will work also on Linux and Mac.
Yes, it's true of course.
So far I didn't think.
WTF! hey where did you get my phnone number ? Shocked
Ok, in the next example follows your homeadress :D

Re: PB 4.00. My little examples for the new version.

Posted: Sun Feb 05, 2006 2:18 am
by Intrigued
Hroudtwolf wrote:
Berikco wrote:
Hroudtwolf wrote:

Code: Select all

...
 
Repeat
   Event.l=WaitWindowEvent ()
   
Until Event.l=#WM_CLOSE
EndIf
End
Beter use official PB constants like #PB_Event_CloseWindow and your source will work also on Linux and Mac.
Yes, it's true of course.
So far I didn't think.
WTF! hey where did you get my phnone number ? Shocked
Ok, in the next example follows your homeadress :D
Don't forget DNA! (we have to clone Fred so we can get to PB 5 twice as fast!)

:wink:

Posted: Tue Feb 07, 2006 3:33 am
by NoahPhense
Very nice..

- np
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited