XProfan

declarar 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
imprimir getCircP(@addr(r!),@addr(w!))
waitinput
end

declarar r!,w!,resultado!

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

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

declarar r!,w!,resultado! shared

pbProc getCircP()
  resultado!=sin(0.0174532925199433*w!/1000.0)*r!
ENDPROC

cls
r!=2
w!=3
getCircP()
imprimir resultado!
waitinput
end

' Array-Test / Shuffle
' Mischt el Einträge el Listboxliste
cls
randomize
' Listboxliste con Cuerdas 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 el Einträge el Listboxliste
    declarar anz%
    anz%=getcount(0)
    Declarar i%,nr%,L$[anz%]
    clear L$[]
    i%=0

    Mientras que i% < anz%' Durch el Listboxliste

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

        mientras que L$[nr%]<>""' ya besetzt? Dann el nächsten freien Platz suchen

            inc nr%
            caso nr%=anz%: nr%=0' si al Ende: de vorne weg neu probieren

        wend

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

    wend

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

ENDPROC' shuffle

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

'{ 'fbPROCs
FBGLOBAL
  #include "D:\Programas\FreeBasic\inc\win\commctrl.bi" 'hier muss el richtige Pfad angegeben voluntad
  dim shared as integer _MaxNum=0,_MinLaenge=1
  redim shared as integer _NumhGB(0 to 1)
  redim shared as cadena _OldAktEntry(0 to 1)
  dim shared as cadena _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 cadena AktEntry,Vorgabe,s2,AktSubStr,LeftPart,RightPart
  dim as integer i,CurPos,erg,num
  dim as zstring pointer zs,zs2
  '{ 'Nummer el 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
          más
            AktSubStr=mid(AktEntry,i,1)+AktSubStr
          endif
        más
          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
        más
          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
            más
              erg=0
            endif
          más
            if ucase(left(Vorgabe,len(AktSubStr)))=ucase(AktSubStr)
              erg=1
            más
              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
  volver 0
ENDPROC 'AmendEditText

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

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

'{ 'Hilfsfunktionen
fbPROC LVGetCount(byval hLV as integer) as integer
  volver sendmessage(cast(any pointer,hLV),LVM_GETITEMCOUNT,0,0)
ENDPROC 'LVGetCount
fbPROC LVFindText(byval hLV as integer,byval texto as cadena,byval StartLine as integer) as integer 'search is caso insensitive
  dim as LVFINDINFOA LVFI
  dim as zstring pointer zs
  dim as integer erg
  LVFI.flags=LVFI_PARTIAL O LVFI_STRING
  zs=allocate(len(texto)+1)
  poke zstring,zs,texto
  LVFI.psz=zs
  erg=sendmessage(cast(any pointer,hLV),LVM_FINDITEM,StartLine,cast(integer,@LVFI))
  deallocate(zs)
  volver erg
ENDPROC 'LVFindText
fbPROC LVGetText(byval hLV as integer,byval Línea as integer,byval Spalte as integer=0) as cadena
  dim as LVITEM LVI
  dim as cadena 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,Línea,cast(integer,@LVI))
  ret=peek(zstring,LVItemText)
  deallocate(LVItemText)
  volver ret
ENDPROC 'LVGetText
'}
'}

'*** Hauptprogramm
Ventana de Estilo 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 sólo Mostrar, si el Editar campo no el Fokus ha (default); 1=auch Mostrar, si fokussiert
_hE2%:=@create("EDIT",%HWnd,"",10,40,300,20)
widestring _ws#,0="rund en el Fernseher"
@sendmessage(_hE2%,~EM_SetCueBanner,0,_ws#) 'lParam: 0=Hinweis sólo Mostrar, si el Editar campo no el Fokus ha (default); 1=auch Mostrar, si fokussiert
disponer _ws#
_hGB%:=@create("GRIDBOX",%HWnd,"1;0;0",1,0,0,0,0) 'sortiert, así Einträge alphabetisch sortiert vorgegeben voluntad
@sendmessage(_hGB%,~WM_SETREDRAW,0,0) 'beschleunigt el Füllen el Gridbox deutlich, außerdem es ellos 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, así Einträge alphabetisch sortiert vorgegeben voluntad
@sendmessage(_hGB2%,~WM_SETREDRAW,0,0) 'beschleunigt el Füllen el Gridbox deutlich, außerdem es ellos sowieso unsichtbar
@addstring(_hGB2%,"Fernseher"):@addstring(_hGB2%,"Programa"):@addstring(_hGB2%,"Programmzeitschrift"):@addstring(_hGB2%,"Serie")
@addstring(_hGB2%,"Sender"):@addstring(_hGB2%,"Fernbedienung")
usermessages $10
SetMinLaenge(1) 'minimale Longitud des eingegebenen Textfragments, de el el Vorgaben hinzugefügt voluntad
_s$=" "
SetKeywordEnders(@addr(_s$)) 'sólo " " como Endzeichen para 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
    mientras que @iskey(27)
      sleep 25
    endwhile
  endif
endwhile
end

' Test de hashes.dll
 {$NoLocal2GlobalVarConversion}
declarar 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 el Prüfsumme uno Expediente mittels MD5.pcu
    parámetros Prüfdatei$
    declarar T&,T$,Expediente$
    Expediente$ = Prüfdatei$' Hier muss por una lokale Variable una lokale Adresse producido voluntad
    ' en el Expediente "MD5" se el MD5 reingeschrieben
    ' el es aber auch en t$
    t& =  testit(addr(Expediente$),"MD5",chr$(0))
    t$ =  cadena$(t&,0)
    ' MD5 el Expediente es auch en t$
    messagebox(t$,"MD5",0)

ENDPROC' Prüfsumme