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
imprimer 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!))
imprimer 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()
imprimer result!
waitinput
end

' Array-Test / Shuffle
' Mischt qui Einträge qui Listboxliste
cls
randomize
' Listboxliste avec Cordes 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 qui Einträge qui Listboxliste
    declare anz%
    anz%=getcount(0)
    Déclarer i%,nr%,L$[anz%]
    clear L$[]
    i%=0

    Tandis que i% < anz%' par qui Listboxliste

        nr%=rnd(anz%)' Einen zufälligen place im Array choisir

        tandis que L$[nr%]<>»' déjà besetzt? ensuite den prochain freien place chercher

            inc nr%
            cas nr%=anz%: nr%=0' si am Ende: de vorne weg récente essayer

        Wend

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

    Wend

    clearlist
    déplacer("ArrToList",L$[])

endproc' shuffle

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

'{ 'fbPROCs
FBGLOBAL
  #include "D:\Programme\FreeBasic\inc\win\commctrl.bi" 'ici muss qui richtige Pfad angegeben volonté
  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
  '{ 'numéro qui GB ermitteln
  num=0
  for i=1 to _MaxNum
    si _NumhGB(i)=hGB
      num=i
      exit for
    endif
  next i
  si 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)
  '}
  si AktEntry<>_OldAktEntry(num)
    si 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
        si i>0
          si instr(_KeywordEnders,mid(AktEntry,i,1))<>0
            LeftPart=left(AktEntry,i)
            exit for
          d'autre
            AktSubStr=mid(AktEntry,i,1)+AktSubStr
          endif
        d'autre
          LeftPart=""
        endif
      next i
      for i=Curpos+1 to len(AktEntry)
        si instr(_KeywordEnders,mid(AktEntry,i,1))<>0
          RightPart=right(AktEntry,len(AktEntry)-(i-1))
          exit for
        d'autre
          AktSubStr=AktSubStr+mid(AktEntry,i,1)
        endif
      next i
      '}
      si len(AktSubStr)>=_MinLaenge
        i=LVFindText(hGB,AktSubStr,-1)
        si i>=0
          Vorgabe=LVGetText(hGB,i)
          si CaseSensitive
            si left(Vorgabe,len(AktSubStr))=AktSubStr
              erg=1
            d'autre
              erg=0
            endif
          d'autre
            si ucase(left(Vorgabe,len(AktSubStr)))=ucase(AktSubStr)
              erg=1
            d'autre
              erg=0
            endif
          endif
          si erg
            si 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
  si _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 cas insensitive
  dim as LVFINDINFOA LVFI
  dim as zstring pointer zs
  dim as integer erg
  LVFI.flags=LVFI_PARTIAL OU 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 la ligne 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,la ligne,cast(integer,@LVI))
  ret=peek(zstring,LVItemText)
  deallocate(LVItemText)
  return ret
ENDPROC 'LVGetText
'}
'}

'*** Hauptprogramm
Fenêtre 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 seulement Montrer, si cela Modifier le champ de pas den Fokus hat (default); 1=auch Montrer, si 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 seulement Montrer, si cela Modifier le champ de pas den Fokus hat (default); 1=auch Montrer, si fokussiert
dispose _ws#
_hGB%:=@create("GRIDBOX",%HWnd,"1;0;0",1,0,0,0,0) 'sortiert, avec cela Einträge alphabetisch sortiert vorgegeben volonté
@sendmessage(_hGB%,~WM_SETREDRAW,0,0) 'beschleunigt cela Füllen qui Gridbox deutlich, aussi ist vous 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, avec cela Einträge alphabetisch sortiert vorgegeben volonté
@sendmessage(_hGB2%,~WM_SETREDRAW,0,0) 'beschleunigt cela Füllen qui Gridbox deutlich, aussi ist vous sowieso unsichtbar
@addstring(_hGB2%,"Fernseher"):@addstring(_hGB2%,"Programme"):@addstring(_hGB2%,"Programmzeitschrift"):@addstring(_hGB2%,"Serie")
@addstring(_hGB2%,"Sender"):@addstring(_hGB2%,"Fernbedienung")
usermessages $10
SetMinLaenge(1) 'minimale Longueur des eingegebenen Textfragments, ab qui qui Vorgaben hinzugefügt volonté
_s$=" "
SetKeywordEnders(@addr(_s$)) 'seulement " " comme Endzeichen pour Suchstrings définir (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
  si @iskey(27) or (%uMessage=$10)
    _ende%=1
    tandis que @iskey(27)
      sleep 25
    endwhile
  endif
endwhile
end

' Test de 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 qui Prüfsumme einer Dossier mittels MD5.pcu
    parameters Prüfdatei$
    declare T&,T$,Dossier$
    Dossier$ = Prüfdatei$' ici muss par une lokale Variable une lokale Adresse erzeugt volonté
    ' dans qui Dossier "MD5" wird qui MD5 reingeschrieben
    ' qui steht mais aussi dans t$
    t& =  testit(addr(Dossier$),"MD5",chr$(0))
    t$ =  string$(t&,0)
    ' MD5 qui Dossier steht aussi dans t$
    messagebox(t$,"MD5",0)

endproc' Prüfsumme