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

' Array-Test / Shuffle
' Mischt die Einträge der Listboxliste
cls
randomize
' Listboxliste mit Strings füllen
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

    '---------------------
    ' Mischt die Einträge der Listboxliste
    declare anz%
    anz%=getcount(0)
    Declare i%,nr%,L$[anz%]
    clear L$[]
    i%=0

    While i% < anz%' Durch die Listboxliste

        nr%=rnd(anz%)' Einen zufälligen Platz im Array wählen

        while L$[nr%]<>""' schon besetzt? Dann den nächsten freien Platz suchen

            inc nr%
            case nr%=anz%: nr%=0' falls am Ende: von vorne weg neu probieren

        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:\Programme\FreeBasic\inc\win\commctrl.bi" 'hier muss der richtige Pfad angegeben werden
  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,Vorgabe,s2,AktSubStr,LeftPart,RightPart
  dim as integer i,CurPos,erg,num
  dim as zstring pointer zs,zs2
  '{ 'Nummer der GB ermitteln
  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
  '}
  '{ 'aktuellen Eintrag ermitteln
  pAktEntry=allocate(10001)
  sendmessage(cast(handle,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(handle,hE),EM_GETSEL,0,0))
      '{ 'aktuellen Substring ermitteln
      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(Vorgabe,len(AktSubStr))=AktSubStr
              erg=1
            else
              erg=0
            endif
          else
            if ucase(left(Vorgabe,len(AktSubStr)))=ucase(AktSubStr)
              erg=1
            else
              erg=0
            endif
          endif
          if erg
            if len(AktSubStr)<>len(Vorgabe)
              s2=LeftPart+Vorgabe+RightPart
              zs=Allocate(len(s2)+1)
              poke zstring,zs,s2
              sendmessage(cast(handle,hE),WM_SETTEXT,0,cast(integer,zs))
              sendmessage(cast(handle,hE),EM_SETSEL,len(LeftPart)+len(AktSubStr),len(LeftPart)+len(Vorgabe))
              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 Zeile as integer,byval Spalte 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,Zeile,cast(integer,@LVI))
  ret=peek(zstring,LVItemText)
  deallocate(LVItemText)
  return ret
ENDPROC 'LVGetText
'}
'}

'*** Hauptprogramm
WindowStyle 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 nur anzeigen, wenn das Editfeld nicht den Fokus hat (default); 1=auch anzeigen, wenn fokussiert
_hE2%:=@create("EDIT",%HWnd,"",10,40,300,20)
widestring _ws#,0="rund um den Fernseher"
@sendmessage(_hE2%,~EM_SetCueBanner,0,_ws#) 'lParam: 0=Hinweis nur anzeigen, wenn das Editfeld nicht den Fokus hat (default); 1=auch anzeigen, wenn fokussiert
dispose _ws#
_hGB%:=@create("GRIDBOX",%HWnd,"1;0;0",1,0,0,0,0) 'sortiert, damit Einträge alphabetisch sortiert vorgegeben werden
@sendmessage(_hGB%,~WM_SETREDRAW,0,0) 'beschleunigt das Füllen der Gridbox deutlich, außerdem ist sie sowieso unsichtbar
@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, damit Einträge alphabetisch sortiert vorgegeben werden
@sendmessage(_hGB2%,~WM_SETREDRAW,0,0) 'beschleunigt das Füllen der Gridbox deutlich, außerdem ist sie sowieso unsichtbar
@addstring(_hGB2%,"Fernseher"):@addstring(_hGB2%,"Programm"):@addstring(_hGB2%,"Programmzeitschrift"):@addstring(_hGB2%,"Serie")
@addstring(_hGB2%,"Sender"):@addstring(_hGB2%,"Fernbedienung")
usermessages $10
SetMinLaenge(1) 'minimale Länge des eingegebenen Textfragments, ab der die Vorgaben hinzugefügt werden
_s$=" "
SetKeywordEnders(@addr(_s$)) 'nur " " als Endzeichen für Suchstrings definieren (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 von hashes.dll
 {$NoLocal2GlobalVarConversion}
declare Dat$,dll2&,Pfad$
cls
Pfad$=GetDir$("")
dll2&=UseDLL(Pfad$+"\\hashes.dll")
DEF testit(3) ! "hashes.dll","testit"
' Prüfdatei
Dat$=Pfad$+"\\Prüfdatei.txt"
'
Prüfsumme(Dat$)
'
FreeDLL dll2&
end
'---------------------

proc Prüfsumme

    '---------------------
    ' Berechnen der Prüfsumme einer Datei mittels MD5.pcu
    parameters Prüfdatei$
    declare T&,T$,Datei$
    Datei$ = Prüfdatei$' Hier muss durch eine lokale Variable eine lokale Adresse erzeugt werden
    ' in die Datei "MD5" wird der MD5 reingeschrieben
    ' der steht aber auch in t$
    t& =  testit(addr(Datei$),"MD5",chr$(0))
    t$ =  string$(t&,0)
    ' MD5 der Datei steht auch in t$
    messagebox(t$,"MD5",0)

endproc' Prüfsumme