PureBasic Forums - English

Posted: **Thu Mar 04, 2010 9:03 am**

Many of us have created 'include' files over the years, containing our little favourite routines that we (intent to

) use in future projects. I can't deny I did collect my own set of routines too. They're public, and distributed together with CodeCaddy as a single file called x_lib. (A name dating back to my GfaBasic days.)

I'm interested in what other people have build up over time (and see what I can steal

)... Why not present a little piece of code and explain why or how? (No need to include the source if that's too big, especially if it's downloadable somewhere.)

To start, I've simply list a few procedures that I wrote once and (sometimes

) still use...

So, what's your favourite subroutine that you keep using?

Posted: **Thu Mar 04, 2010 9:05 am**

x_nr()
x_freenr(n.i)

Before #PB_Any I sometimes needed unique numbers for my gadgets. Simply using an increasing counter would have done the trick, but then I might have ended up with very high numbers which PureBasic might not like, so I needed a way to recycle numbers that had been freed.

Here I just simply used a linked list and a counter. If there's anything in the linked list that's first given out. If the linked list is empty the counter is increased and then that number is given out. Stupid but it works

I'm not using this much anymore, but I still have a few programs that create and delete gadgets on the fly, where this comes in handy.

Code: Select all

Procedure.i x_nr()                                                   ; generates unique number
  ; Global x_nr.i, x_nr_n.i, x_nr_list()
  ;
  ; *** generates a new unique number
  ;
  ; in:                - none
  ; retval:  n         - unused unique number
  ; out:     x_nr      - as x_retval
  ;
  ; pure sometimes uses 'numbers' to identify elements instead of windows handles
  ; these numbers are arbitrary and fully defined by the user, this can cause trouble
  ; when using multiple libraries or code from different people as they might be reusing
  ; these unique numbers, for this purpose, i've added a x_nr procedure that returns
  ; a new unique number on every call
  ;
  ; you decide yourself if you want to free them or not :-)
  ; i would suggest doing so if you don't 'recycle' them using x_freenr() because other procedures
  ; may end up with numbers that are 'too high' for the pb functions being called
  ;
  If ListSize(x_nr_list()) > 0          ; which means there's some stuff on the list
    x_nr = x_nr_list()                  ; then use that number
    DeleteElement(x_nr_list())          ; and take it from the list
  Else
    x_nr = x_nr_n
    x_nr_n = x_nr_n+1
  EndIf
  ProcedureReturn x_nr
  ;
EndProcedure

Procedure x_freenr(n.i)                                              ; frees number generated by x_nr()
  ; Global x_nr.i, x_nr_n.i, x_nr_list()
  ;
  ; *** recycles unique numbers
  ;
  ; put this number into the 'free numbers' list so it can be reused by x_nr()
  ;
  AddElement(x_nr_list())
  x_nr_list()=n
  ;
EndProcedure

Posted: **Thu Mar 04, 2010 9:08 am**

x_min(n1.i,n2.i)
x_max(n1.i,n2.i)

I'm still baffled by the fact PureBasic (4.41) doesn't have this as a 'primitive'. In countless situations a programmer has to find the highest or lowest of two numbers. A simple Min() and Max() function would solve this...

Alas, there's no such beast. But I did not want to clutter up my code by doing this every time:

Code: Select all

;
; the ugly way
;
If a < b
  c = b
Else
  c = a
Endif

I think it is more readable to do something like this:

Code: Select all

;
; the *slightly* better way, IMHO etc. etc.
;
c = x_max(a,b)

I think I should convert this little procedure to a macro, but macros and me don't always get along well

Code: Select all

Procedure.i x_min(n1.i,n2.i)                                         ; smallest of two vars
  If n1 < n2
    ProcedureReturn n1
  Else
    ProcedureReturn n2
  EndIf
EndProcedure

Procedure.i x_max(n1.i,n2.i)                                         ; largest of two vars
  If n1 > n2
    ProcedureReturn n1
  Else
    ProcedureReturn n2
  EndIf
EndProcedure

Posted: **Thu Mar 04, 2010 11:48 am**

I have my most used code pieces in the IDE's templates window.

The regout macro is very handy in two situations: Debugging inline asm code and checking if a piece of code that fails with an ima for mysterious reasons fails due to a stack misalignment. This way you can check if you used the correct variation of Import/ImportC, as an example. Or if some native PB code crashes on EndProcedure you can use this code to find where the error actually happens.
Use regout(register) to show the value of a register in the debug window, without altering any other registers (except eflags). If you don't use inline asm, this is most useful when used with esp (regout(esp)) several places in the code. Inside a given procedure, esp should stay the same except in some special cases (like inside a select case statement (pun intented)). If not, there is a bug with your Import statements, your inline assembly or the actual PB compiler.

Code: Select all

Global _regout
Macro regout(register)
  !push register
  !pop  [v__regout]
  !pushad
  Debug _regout
  !popad
EndMacro

; use
regout(esp)

Posted: **Thu Mar 04, 2010 12:19 pm**

Code faster with less typing:

Code: Select all

Global _DRAWING

Procedure Msg(T.S="",Title.S="")
  If Title="" :Title="Stop !" :EndIf
  Result = MessageRequester(Title,T+Chr(10)+Chr(10)+"Continue?",#PB_MessageRequester_YesNo)
  If Result = #PB_MessageRequester_No    ; else pressed Yes button (Result = 6)
    End
  EndIf
EndProcedure   

Macro STOPDRAW :If _DRAWING :StopDrawing() :_DRAWING=0 :EndIf:EndMacro
        
Macro DraWin(Win=0)
   STOPDRAW 
   _DRAWING=StartDrawing(WindowOutput(Win))
EndMacro 
   
Macro DrawIMG(IMG)
  STOPDRAW  
  _DRAWING=StartDrawing(ImageOutput(IMG))
EndMacro 
   
Macro GadImg(ImGad=_ImGad,IMG=_Img)
  STOPDRAW
  SetGadgetState(ImGad,ImageID(IMG))
EndMacro

Macro Escape
  If GetAsyncKeyState_(27)&$8000 :  End : EndIf 
EndMacro

 ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,500,300 ,"") 

DraWin()
Box(150,100,200,50,#green)
DrawText(150,170,"Box on window")
Msg("Drawing on Window"+#lf$+"next: drawing on Image") 

CreateImage(0,WindowWidth(0),WindowHeight(0))
ImageGadget(0,0,0,0,0,0) 

DrawIMG(0)
Box(150,100,200,50,#red) 
DrawText(150,170,"Box on Image. <Escape> To Quit",#Yellow,0)

GadImg(0,0) ; put the image on ImageGadget

Repeat 
Escape
  EV=WaitWindowEvent() 
Until EV=#PB_Event_CloseWindow
End

Cheers!

Posted: **Thu Mar 04, 2010 12:31 pm**

I think I should convert this little procedure to a macro, but macros and me don't always get along well

I have this on my PBInclude (13000 lines

); code found somewhere on the forum, unknown origin.

Code: Select all

Macro Max(A,B)
   ((Not A>B)*B)|((Not B>A)*A)
EndMacro
   
Macro Min(A,B)
   ((Not A<B)*B)|((Not B<A)*A)
EndMacro

Posted: **Thu Mar 04, 2010 12:40 pm**

Something i need in most of my projects, a procedure dating back many years. I used it originaly on VB6.
Returns the path of the executable.

Code: Select all

Procedure.s GetSelfPath()

  Define.s ModulePath

  ModulePath = Space(1024)
  GetModuleFileName_(0, @ModulePath, 1024)
  ProcedureReturn GetPathPart(Trim(ModulePath))

EndProcedure

Posted: **Thu Mar 04, 2010 1:30 pm**

Thorium, your procedure can be replaced with: ProgramFilename().

Posted: **Thu Mar 04, 2010 2:02 pm**

you can find some of mine here:
http://www.wannabephoenix.de/html2/pb.php?stuff=code
especially 'plus.pbi' is a collection of handy little helpers.
there are examples for each code too.

Posted: **Thu Mar 04, 2010 5:18 pm**

I've been doing a lot of experimentation with processes, threads, etc... lately. This is a very general .pbi I use for experimentation in various forms:

Code: Select all

code removed pending upload somewhere - sorry - did not realize there was some sort of line count or size limit for this thread

Posted: **Thu Mar 04, 2010 8:11 pm**

Hey SFSx01 you might wanna keep the quoted code shorter... (perhaps upload it somewhere and use a link to it).

The pagedown key on my keyboard starts to wear out

Posted: **Fri Mar 05, 2010 12:02 pm**

Yesterday evening I ran into a stupid problem: in CodeCaddy the codesync function no longer worked. Well, it worked sort of, but never created any folders. That was weird... that was one thing I had not changed, so I started digging in my code.

makesuredirectorypathexists_()
shcreatedirectoryex_()

Turned out I was using a WinApi call (MakeSureDirectoryPathExist) to create the folders, and sure enough, that one only existed in an Ascii flavour, but not for Unicode. Hmm. There was an alternative (SHCreateDirectoryEx) but alas, for that one I had to open a library / DLL, and it did not exist on all platforms.

Dang. So get on your coding wagon cowboy and start hammering.

x_getdeepestpath(s.s)
x_getparentpath(s.s)
x_absolutepath(s.s)
x_createdirectory(folder.s)

These four routines allow a little manupulation of file paths. x_getdeepestpath() and x_getparentpath() are complementary... The first one turns 'c:\windows\system32\' into 'system32\', and the latter returns 'c:\windos\system32\'.

x_absolutepath() takes a path, including relative paths using '..\' or '\' and tries to find, based on the current directory, the associated absolute path. Obviously I'm a lazy basterd, so I used x_getparentpath() whenever I encountered a '..\' combo.

But... I needed to create a folder structure to replace my WinApi call. So I took a path, turned it into an absolute path, then started parsing through it. Whenever I hit an existing folder in the chain I would not have to create a subfolder, just continue. So if I had the following folder structure:

c:\
c:\windows\
c:\windows\system32\

... I would pare it like: c:\ -> c:\windows\ -> c:\windows\system32\ -> then I should be able to create a subfolder under system32 like this: x_createdirectory("c:\windows\system32\whatever")

It worked. Until I actually tried my new routine inside CodeCaddy. And no folders were created. It turned out I had three small and unrelated different bugs in all three routines, and they confused the hell out of me. I hope I have them fixed now, so much time spend on less than a 100 lines... just because I returned an empty string as the parent folder of 'c:\'...

(By the way: how do you test the integrity of your includes / libraries? I use a seperate file called x_lib_test.pb, and every time I add a new function, or find a new bug, I add checks to that file, hoping that this will alert me in case I break something else... Unit testing for beginners, I guess

)

Posted: **Fri Mar 05, 2010 1:08 pm**

Code: Select all

; modified version from IBSoftware (CodeArchiv)
; on vista and above check the Request for "User mode" or "Administrator mode" in compileroptions
; (no virtualisation!)

Procedure ForceDirectories(Dir.s)
  Static tmpDir.s, Init
  Protected result
  
  If Len(Dir) = 0
    ProcedureReturn #False
  Else
    If Not Init
      tmpDir = Dir
      Init   = #True
    EndIf
    If (Right(Dir, 1) = "\")
      Dir = Left(Dir, Len(Dir) - 1)
    EndIf
    If (Len(Dir) < 3) Or FileSize(Dir) = -2 Or GetPathPart(Dir) = Dir
      If FileSize(tmpDir) = -2
        result = #True
      EndIf
      tmpDir = "" : Init = #False
      ProcedureReturn result
    EndIf
    ForceDirectories(GetPathPart(Dir))
    ProcedureReturn CreateDirectory(Dir)
  EndIf
EndProcedure

greetings
Thomas

Posted: **Mon Mar 08, 2010 3:51 pm**

Just search for my name on the Tips 'n' Tricks board. :roll:

Posted: **Mon Mar 08, 2010 6:43 pm**

Yeah, maybe I should have posted the first one on the Tips & Tricks board. If one of the mods might want to move it, that's fine by me.

PureBasic Forums - English

All Inclusive...

All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...