XProfan

declare r!,w!

pbProc getCircP(*r,*w)
  protected r.d,w.d
  r=PeekD(*r)
  w=PeekD(*w)
  procedurereturn sin(0.0174532925199433*w/1000.0)*r
endproc

cls
r!=2
w!=3
print getCircP(@addr(r!),@addr(w!))
waitinput
end

declare r!,w!,result!

pbProc getCircP(*r,*w,*result)
  protected r.d,w.d
  r=PeekD(*r)
  w=PeekD(*w)
  PokeD(*result,sin(0.0174532925199433*w/1000.0)*r)
endproc

cls
r!=2
w!=3
getCircP(@addr(r!),@addr(w!),@addr(result!))
print result!
waitinput
end

declare r!,w!,result! shared

pbProc getCircP()
  result!=sin(0.0174532925199433*w!/1000.0)*r!
endproc

cls
r!=2
w!=3
getCircP()
print result!
waitinput
end

' aray-Test / Shuffle
' mix The Entries the Listboxliste
cls
randomize
' Listboxliste with Strings fill
clearlist
addstring(0,"BlaBla1")
addstring(0,"BlaBla2")
addstring(0,"BlaBla3")
addstring(0,"BlaBla4")
addstring(0,"BlaBla5")
listbox$("Start",1)
shuffle()
listbox$("Ergebnis",1)
end
'---------------------

proc shuffle

    '---------------------
    ' mix The Entries the Listboxliste
    declare anz%
    anz%=getcount(0)
    Declare i%,nr%,L$[anz%]
    clear L$[]
    i%=0

    While i% < anz%' by the Listboxliste

        nr%=rnd(anz%)' a casually Space in the aray dial

        while L$[nr%]<>""' already occupied? then whom next disengaged Space search

            inc nr%
            case nr%=anz%: nr%=0' if end: of in front lane new try

        wend

        L$[nr%]=getstring$(0,i%)
        Inc i%

    wend

    clearlist
    move("ArrToList",L$[])

endproc' shuffle

declare _hE%,_hE2%,_hGB%,_hGB2%,_ende%,_s$,_ws#

'{ 'fbPROCs
FBGLOBAL
  #include "D:\programs\FreeBasic\inc\win\commctrl.bi" 'here must the right way indicated go
  dim shared as integer _MaxNum=0,_MinLaenge=1
  redim shared as integer _NumhGB(0 to 1)
  redim shared as string _OldAktEntry(0 to 1)
  dim shared as string _KeywordEnders
  _KeywordEnders=" .,:-+*/\!;"
ENDFBGLOBAL

fbPROC AmendEditText(byval hE as integer,byval hGB as integer,byval CaseSensitive as integer) as integer export
  dim as byte pointer pAktEntry
  dim as string AktEntry,default,s2,AktSubStr,LeftPart,RightPart
  dim as integer i,CurPos,erg,num
  dim as zstring pointer zs,zs2
  '{ 'number the GB detect
  num=0
  for i=1 to _MaxNum
    if _NumhGB(i)=hGB
      num=i
      exit for
    endif
  next i
  if num=0
    _MaxNum=_MaxNum+1
    num=_MaxNum
    redim preserve _NumhGB(0 to num)
    redim preserve _OldAktEntry(0 to num)
    _NumhGB(num)=hGB
    _OldAktEntry(num)=""
  endif
  '}
  '{ 'actually entry detect
  pAktEntry=allocate(10001)
  sendmessage(cast(lever,hE),WM_GETTEXT,10000,cast(integer,pAktEntry))
  AktEntry=Peek(zstring,pAktEntry)
  deallocate(pAktEntry)
  '}
  if AktEntry<>_OldAktEntry(num)
    if len(AktEntry)>len(_OldAktEntry(num))
      CurPos=loword(sendmessage(cast(lever,hE),EM_GETSEL,0,0))
      '{ 'actually Substring detect
      AktSubStr=""
      for i=CurPos to 0 step -1
        if i>0
          if instr(_KeywordEnders,mid(AktEntry,i,1))<>0
            LeftPart=left(AktEntry,i)
            exit for
          else
            AktSubStr=mid(AktEntry,i,1)+AktSubStr
          endif
        else
          LeftPart=""
        endif
      next i
      for i=Curpos+1 to len(AktEntry)
        if instr(_KeywordEnders,mid(AktEntry,i,1))<>0
          RightPart=right(AktEntry,len(AktEntry)-(i-1))
          exit for
        else
          AktSubStr=AktSubStr+mid(AktEntry,i,1)
        endif
      next i
      '}
      if len(AktSubStr)>=_MinLaenge
        i=LVFindText(hGB,AktSubStr,-1)
        if i>=0
          Vorgabe=LVGetText(hGB,i)
          if CaseSensitive
            if left(default,len(AktSubStr))=AktSubStr
              erg=1
            else
              erg=0
            endif
          else
            if ucase(left(default,len(AktSubStr)))=ucase(AktSubStr)
              erg=1
            else
              erg=0
            endif
          endif
          if erg
            if len(AktSubStr)<>len(default)
              s2=LeftPart+default+RightPart
              zs=Allocate(len(s2)+1)
              poke zstring,zs,s2
              sendmessage(cast(lever,hE),WM_SETTEXT,0,cast(integer,zs))
              sendmessage(cast(lever,hE),EM_SETSEL,len(LeftPart)+len(AktSubStr),len(LeftPart)+len(default))
              deallocate(zs)
            endif
          endif
        endif
      endif
    endif
    _OldAktEntry(num)=AktEntry
  endif
  return 0
ENDPROC 'AmendEditText

fbPROC SetMinLaenge(byval Laenge as integer) as integer export
  _MinLaenge=Laenge
  if _MinLaenge<1
    _MinLaenge=1
  endif
  return 0
ENDPROC 'SetMinLaenge

fbPROC SetKeywordEnders(byval Text as zstring pointer) as integer export
  _KeywordEnders=peek(zstring,Text)
  return 0
ENDPROC 'SetKeywordEnders

'{ 'Hilfsfunktionen
fbPROC LVGetCount(byval hLV as integer) as integer
  return sendmessage(cast(any pointer,hLV),LVM_GETITEMCOUNT,0,0)
ENDPROC 'LVGetCount
fbPROC LVFindText(byval hLV as integer,byval Text as string,byval StartLine as integer) as integer 'search is case insensitive
  dim as LVFINDINFOA LVFI
  dim as zstring pointer zs
  dim as integer erg
  LVFI.flags=LVFI_PARTIAL OR LVFI_STRING
  zs=allocate(len(Text)+1)
  poke zstring,zs,Text
  LVFI.psz=zs
  erg=sendmessage(cast(any pointer,hLV),LVM_FINDITEM,StartLine,cast(integer,@LVFI))
  deallocate(zs)
  return erg
ENDPROC 'LVFindText
fbPROC LVGetText(byval hLV as integer,byval row as integer,byval slot as integer=0) as string
  dim as LVITEM LVI
  dim as string ret,s
  dim as zstring pointer LVItemText
  'LVI=mask&,iItem&,iSubItem&,state&,stateMask&,pszText&,cchTextMax&,iImage&,lParam&,iIndent&,iGroupId&,cColumns&,puColumns&,piColFmt&,iGroup&
  LVItemText=Allocate(2001)
  LVI.iItem=Zeile
  LVI.iSubItem=Spalte
  LVI.mask=LVIF_TEXT
  LVI.pszText=LVItemText
  LVI.cchTextMax=2000
  sendmessage(cast(any pointer,hLV),LVM_GETITEMTEXT,row,cast(integer,@LVI))
  ret=peek(zstring,LVItemText)
  deallocate(LVItemText)
  return ret
ENDPROC 'LVGetText
'}
'}

'*** Hauptprogramm
Window Style 1+2+4+8+512
cls
_hE%:=@create("EDIT",%HWnd,"",10,10,300,20)
dim _ws#,1000
widestring _ws#,0="Automarken"
@sendmessage(_hE%,~EM_SetCueBanner,0,_ws#) 'lParam: 0=Hinweis only Show, if the Editfeld not whom Fokus has (default); 1=auch Show, if fokussiert
_hE2%:=@create("EDIT",%HWnd,"",10,40,300,20)
widestring _ws#,0="around whom telly"
@sendmessage(_hE2%,~EM_SetCueBanner,0,_ws#) 'lParam: 0=Hinweis only Show, if the Editfeld not whom Fokus has (default); 1=auch Show, if fokussiert
dispose _ws#
_hGB%:=@create("GRIDBOX",%HWnd,"1;0;0",1,0,0,0,0) 'sortiert, so Entries alphabetical sortiert pretended go
@sendmessage(_hGB%,~WM_SETREDRAW,0,0) 'speed the stuff the GridBOX explicit, moreover is tappt im dunkeln anyhow invisible
@addstring(_hGB%,"BMW"):@addstring(_hGB%,"Audi"):@addstring(_hGB%,"VW"):@addstring(_hGB%,"Skoda"):@addstring(_hGB%,"Nissan")
@addstring(_hGB%,"Honda"):@addstring(_hGB%,"Chevrolet"):@addstring(_hGB%,"Mini"):@addstring(_hGB%,"Mercedes")
@addstring(_hGB%,"Opel"):@addstring(_hGB%,"Alfa"):@addstring(_hGB%,"Romeo"):@addstring(_hGB%,"Aston"):@addstring(_hGB%,"Martin")
@addstring(_hGB%,"Bentley"):@addstring(_hGB%,"Bugatti"):@addstring(_hGB%,"Buick"):@addstring(_hGB%,"cadillac"):@addstring(_hGB%,"Chrysler")
@addstring(_hGB%,"Citroen"):@addstring(_hGB%,"Dacia"):@addstring(_hGB%,"Daihatsu"):@addstring(_hGB%,"Dodge")
_hGB2%:=@create("GRIDBOX",%HWnd,"1;0;0",1,0,0,0,0) 'sortiert, so Entries alphabetical sortiert pretended go
@sendmessage(_hGB2%,~WM_SETREDRAW,0,0) 'speed the stuff the GridBOX explicit, moreover is tappt im dunkeln anyhow invisible
@addstring(_hGB2%,"telly"):@addstring(_hGB2%,"Program"):@addstring(_hGB2%,"Programmzeitschrift"):@addstring(_hGB2%,"series")
@addstring(_hGB2%,"Transmitter"):@addstring(_hGB2%,"Fernbedienung")
usermessages $10
SetMinLaenge(1) 'minimale length the inputted Textfragments, ex the The Vorgaben added
_s$=" "
SetKeywordEnders(@addr(_s$)) 'only " " as Endzeichen for Suchstrings define (default=" .,:-+*/\!;")
@setfocus(%HWnd)
_ende%=0
whilenot _ende%
  waitinput
  AmendEditText(_hE%,_hGB%,0) '0=case insensitive, 1=case sensitive
  AmendEditText(_hE2%,_hGB2%,0) '0=case insensitive, 1=case sensitive
  if @iskey(27) or (%uMessage=$10)
    _ende%=1
    while @iskey(27)
      sleep 25
    endwhile
  endif
endwhile
end

' Test of hashes.dll
 {$NoLocal2GlobalVarConversion}
declare Dat$,dll2&,way$
cls
Pfad$=$ GetDir("")
dll2&=UseDLL(way$+"\\hashes.dll")
DEF testit(3) ! "hashes.dll","testit"
' Prüfdatei
Dat$=way$+"\\Prüfdatei.txt"
'
Prüfsumme(Dat$)
'
FreeDLL dll2&
end
'---------------------

proc Prüfsumme

    '---------------------
    ' to charge the Prüfsumme of/ one File through MD5.pcu
    parameters Prüfdatei$
    declare T&,T$,File$
    File$ = Prüfdatei$' here must by a local Variable a local address created go
    ' into File "MD5" becomes the MD5 reingeschrieben
    ' the standing but too in t$
    t& =  testit(addr(File$),"MD5",chr $(0))
    t$ =  string $(t&,0)
    ' MD5 the File standing too in t$
    messagebox(t$,"MD5",0)

endproc' Prüfsumme