Def Spalte_from_ID(1) (INT(@&(1)/Wurzel2(puzzle_teile&))+IF((@&(1) mod Wurzel2(puzzle_teile&))=0,0,1))
Def Zeile_from_ID(1) INT(@&(1)-((Spalte_from_ID(@&(1))-1)*Wurzel2(puzzle_teile&)))
Def ID_from_Zeile_Spalte(2) INT(((@&(2)-1)*Wurzel2(puzzle_teile&))+@&(1))
Def Wurzel2(1) Sqrt(@&(1))
Def CloseDlg(1) (%umessage = $10) And (GetActiveWindow() = &(1))
Def DateiName(1) SubStr$(@$(1),-1,"\\")
Def DateiPfad(1) Translate$(@$(1),("\\" + DateiName(@$(1))),"")
Def &Rahmen_Dicke 3
Def Rahmen_Hover_Color(0) RGB(128,255,0)
Def Back_Color(0) RGB(0,0,0)
Windowstyle 26
Window %MaxX,%MaxY - %MaxX,%MaxY
CLS Back_Color()

Declare bt_pics&[],bt&[],pic_part&[], apos&[], x&, spalte_&, zeile_&, i&, i_&, z&, space&,zeile&,spalte&, kombi$[],faktor&
Declare apic&,apic_x&,apic_y&,part_x&,part_y&,aempty_part&,index_list&,nempty_part&, error_&, bild_$,dg&,spedit&,ok&,tmp$
Var Programm$=Par$(If((Upper$(SubStr$(Par$(0), -1, "\\"))="PROFAN.EXE") or (Upper$(SubStr$(Par$(0), -1, "\\"))="XPROFAN.EXE"),1,0))
Var txt$=DateiPfad(Programm$)+"\Options.dat"
Var zaehler&=1
Assign #1,txt$
Reset #1
WhileNot eof(#1)
  Input #1,tmp$
  kombi$[zaehler&]=tmp$
  zaehler&=zaehler&+1
EndWhile
Close #1

bt_pics&[0]=DrawButton(95,"Bild laden")
bt_pics&[1]=DrawButton(85,"Mischen")
bt_pics&[2]=DrawButton(85,"Auflösen")
bt_pics&[3]=DrawButton(105,"Schwierigkeit")
bt_pics&[4]=DrawButton(32,"")
StartPaint bt_pics&[4]
  UsePen 0,1,RGB(255,255,210)
  UseBrush 1,RGB(0,128,0)
  Rectangle 6,6 - 26,24
  Rectangle 9,9 - 23,21
EndPaint
bt&[0]=Create("PicButton",%hwnd,bt_pics&[0],2,height(%hwnd)-32,95,30)
bt&[1]=Create("PicButton",%hwnd,bt_pics&[1],102,height(%hwnd)-32,85,30)
bt&[2]=Create("PicButton",%hwnd,bt_pics&[2],192,height(%hwnd)-32,85,30)
bt&[3]=Create("PicButton",%hwnd,bt_pics&[3],width(%hwnd)-145,height(%hwnd)-32,105,30)
bt&[4]=Create("PicButton",%hwnd,bt_pics&[4],width(%hwnd)-35,height(%hwnd)-32,32,30)
Create("Tooltip",%hwnd,bt&[4],"Orginalbild anzeigen")
Var puzzle_teile&=3^2
If FileExists(DateiPfad(Programm$)+"\Beispiel1.jpg")
  Var bild$=DateiPfad(Programm$)+"\Beispiel1.jpg"
Else
  Var bild$=LoadFile$("Lade ein Bild als Puzzle","Bild|*.BMP;*.PNG;*.JPG;*.JPEG;*.JPE;*.GIF")
EndIf
case bild$="" : end
error_&=LoadPic(bild$,1)
If error_&<>1
  MixPic()
  ShowPuzzle()
else
  End
EndIf
Setfocus(0)
UserMessages 16, $10
WhileNot (iskey(27) or (%umessage=16)) '################################################################################# Hauptschleife
  Waitinput 100
  If ((x&<>MouseInPart()) and (GetActiveWindow()=%hwnd)) 'Hover-Effekt
    Umrahmen(spalte&,zeile&,Back_Color()) 'Altes Hover zurücksetzen
    x&=MouseInPart()
    spalte&=spalte_&
    zeile&=zeile_&
    Case (x&<>nempty_part&) and (x&<>0) : Umrahmen(spalte&,zeile&,Rahmen_Hover_Color()) 'Neues Hover setzen, wenn nicht Leerfeld
  ElseIf (Getfocus(%hwnd) and (MouseInPart()=nempty_part&))
    Setfocus(0)
  ElseIf ((Getfocus(%hwnd) and (nempty_part&<>MouseInPart()) and (Between(CursorPos("X1",0, %hwnd), 0, apic_x&, CursorPos("Y1",0, %hwnd),0,apic_y&)=1)) or ((IsKey(37) or IsKey(38) or IsKey(39) or IsKey(40)) and (GetActiveWindow()=%hwnd))) 'Part angeklickt oder Pfeiltasten benutzt
    Umrahmen(spalte&,zeile&,Back_Color()) 'Hover-Effekt entfernen
    i&=MouseInPart()
    case iskey(37) : i&=nempty_part&+Wurzel2(puzzle_teile&)
    case iskey(38) : i&=nempty_part&+1
    case iskey(39) : i&=nempty_part&-Wurzel2(puzzle_teile&)
    case iskey(40) : i&=nempty_part&-1
    If ((Spalte_from_ID(i&)=Spalte_from_ID(nempty_part&)) or (Zeile_from_ID(i&)=Zeile_from_ID(nempty_part&)))
      If ((Spalte_from_ID(i&)>0) and (Spalte_from_ID(i&)<(Wurzel2(puzzle_teile&)+1))) and ((i&>0) and (i&<(puzzle_teile&+1)))
        If (Spalte_from_ID(i&)=Spalte_from_ID(nempty_part&)) 'vertikales verschieben
          faktor&=(Zeile_from_ID(i&)-Zeile_from_ID(nempty_part&))
          whileloop If(faktor&<0,-1,1),faktor&,If(faktor&<0,-1,1)
            i&=ID_from_Zeile_Spalte(Zeile_from_ID(nempty_part&)+IF(&loop<1,-1,1),Spalte_from_ID(nempty_part&))
            Whileloop puzzle_teile& 'Wahre Positions-ID des Angeklickten Parts ermitteln
              Case (apos&[&loop]=i&) : i_&=&loop
            EndWhile
            whileloop 1,part_y&,1
              If (i&>nempty_part&)
                Rectangle2(((Spalte_from_ID(i&)-1)*part_x&), (((Zeile_from_ID(i&)-1)*part_y&)+(part_y&-&loop)),part_x&, &loop)
                DrawPic pic_part&[i_&], ((Spalte_from_ID(i&)-1)*part_x&), (((Zeile_from_ID(i&)-1)*part_y&)-&loop); 0
              Else
                Rectangle2(((Spalte_from_ID(i&)-1)*part_x&), (((Zeile_from_ID(i&)-1)*part_y&)),part_x&, &loop)
                DrawPic pic_part&[i_&], ((Spalte_from_ID(i&)-1)*part_x&), (((Zeile_from_ID(i&)-1)*part_y&)+&loop); 0
              Endif
            EndWhile
            apos&[i_&]=nempty_part&
            nempty_part&=i&
            Sleep 100
          EndWhile
        ElseIf (Zeile_from_ID(i&)=Zeile_from_ID(nempty_part&)) 'horizontales verschieben
          faktor&=(Spalte_from_ID(i&)-Spalte_from_ID(nempty_part&))
          whileloop If(faktor&<0,-1,1),faktor&,If(faktor&<0,-1,1)
            i&=ID_from_Zeile_Spalte(Zeile_from_ID(nempty_part&),Spalte_from_ID(nempty_part&)+IF(&loop<1,-1,1))
            Whileloop puzzle_teile& 'Wahre Positions-ID des Angeklickten Parts ermitteln
              Case (apos&[&loop]=i&) : i_&=&loop
            EndWhile
            whileloop 1,part_x&,1
              If (Spalte_from_ID(i&)>Spalte_from_ID(nempty_part&))
                Rectangle2(((Spalte_from_ID(i&)-1)*part_x&)+(part_x&-&loop), (Zeile_from_ID(i&)-1)*part_y&, &loop, part_y&)
                DrawPic pic_part&[i_&], ((Spalte_from_ID(i&)-1)*part_x&)-&loop, (Zeile_from_ID(i&)-1)*part_y&; 0
              Else
          			Rectangle2(((Spalte_from_ID(i&)-1)*part_x&), (Zeile_from_ID(i&)-1)*part_y&,&loop, part_y&)
          			DrawPic pic_part&[i_&], ((Spalte_from_ID(i&)-1)*part_x&)+&loop, (Zeile_from_ID(i&)-1)*part_y&; 0
              Endif
            EndWhile
            apos&[i_&]=nempty_part&
            nempty_part&=i&
            Sleep 100
          EndWhile
        Endif
      Endif
    EndIf
    Setfocus(0)
  Elseif Getfocus(bt&[4]) ' Orginalbild öffnen
    ShellExec(bild$,"Open",1)
    Setfocus(0)
  ElseIf Getfocus(bt&[0]) 'Bild laden
    bild_$=LoadFile$("Lade ein Bild als Puzzle","Bild|*.BMP;*.PNG;*.JPG;*.JPEG;*.JPE;*.GIF")
    If (bild_$<>"") and Fileexists(bild_$)
      error_&=LoadPic(bild_$,1)
      If error_&<>1
        bild$=bild_$
        MixPic()
        ShowPuzzle()
      Endif
    EndIf
    Setfocus(0)
  ElseIf Getfocus(bt&[1]) 'Mischen
    If Fileexists(bild$)
      DeletePics()
      error_&=LoadPic(bild$)
      If error_&<>1
        whileloop 10
          MixPic()
          ShowPuzzle()
          case (&loop<>10) : Sleep 50
        Endwhile
      Endif
    EndIf
    Setfocus(0)
  ElseIf Getfocus(bt&[2]) 'Auflösen
    If Fileexists(bild$)
      DeletePics()
      error_&=LoadPic(bild$)
      If error_&<>1
        whileloop puzzle_teile&
          apos&[&loop]=&loop
        EndWhile
        aempty_part&=1
        nempty_part&=1
        ShowPuzzle()
      Endif
    EndIf
    Setfocus(0)
  ElseIf Getfocus(bt&[3]) 'Schwierigkeits-Grad einstellen
    EnableWindow %hwnd,0
    Windowstyle 24+1024
    dg&=Create("Window",%hwnd,"Schwierigkeit",WindowRect(%hwnd,"X1")+((width(%hwnd)-200)/2),WindowRect(%hwnd,"Y1")+((height(%hwnd)-80)/2),150,57)
    spedit&=Create("SpinEdit",dg&,Str$(INT(Wurzel2(puzzle_teile&)-2))+";1;5",5,5,40,22)
    ok&=Create("Button",dg&,"Speichern",55,4,85,24)
    DeletePics()
    WhileNot iskey(27)
      Waitinput 100
      If Getfocus(ok&) or iskey(13)
        while (iskey(1) or iskey(13))
        Endwhile
        puzzle_teile&=(Val(Gettext$(spedit&))+2)^2
        break
      Endif
    EndWhile
    While iskey(27)
    EndWhile
    Destroywindow(dg&)
    SetActiveWindow(%hwnd)
    EnableWindow %hwnd,1
    If Fileexists(bild$)
      error_&=LoadPic(bild$)
      If error_&<>1
        MixPic()
        ShowPuzzle()
      Endif
    EndIf
    Setfocus(0)
  Elseif Iskey(17) and (GetActiveWindow()=%hwnd) 'Leer Feld aufzeigen über Strg
    Umrahmen(Spalte_from_ID(x&),Zeile_from_ID(x&),Back_Color()) 'Hover-Effekt ausblenden
    Umrahmen(Spalte_from_ID(nempty_part&),Zeile_from_ID(nempty_part&),255) 'Lerres Feld markieren
    while Iskey(17)
    Endwhile
    Umrahmen(Spalte_from_ID(nempty_part&),Zeile_from_ID(nempty_part&),Back_Color()) 'Leeres Feld demarkieren
    x&=-1 'Hovereffekt einleiten
    Setfocus(0)
  Endif
EndWhile
Showwindow(%hwnd,0)
DeletePics()
whileloop 0,4,1
  DeleteObject bt_pics&[&loop]
EndWhile
End

Proc Rectangle2
  Parameters x1&,y2&,dx&,dy&
  Rectangle x1&,y2& - (x1&+dx&),(y2&+dy&)
EndProc
Proc Umrahmen
  Parameters spalte___&,zeile___&,col&
  UseBrush 0,0
  UsePen 0,&Rahmen_Dicke,col&
  Rectangle (spalte___&-1)*part_x&,(zeile___&-1)*part_y& - ((spalte___&-1)*part_x&)+part_x&,(zeile___&-1)*part_y&+part_y&
EndProc
Proc DeletePics
  whileloop puzzle_teile&
    DeleteObject pic_part&[&loop]
  EndWhile
EndProc
Proc LoadPic
  Parameters pfad$, size&
  var err&=0
  If Fileexists(pfad$)
    apic&=Create("hPic",-1,pfad$)
    Deleteobject apic&
    If (%bmpx>(%maxX-100)) or (%bmpy>(%maxy-200)) 'Bild laden
      apic&=Create("hSizedPic", -1, pfad$, %maxX-100, %maxy-200, 1)
    Else
      apic&=Create("hPic",-1,pfad$)
    Endif
    IF (%bmpx>400) and (%bmpy>300)
      Clear pic_part&[]
      SetSize pic_part&[], puzzle_teile&+1
      apic_x&=%bmpx
      apic_y&=%bmpy
      part_x&=%bmpx/Wurzel2(puzzle_teile&)
      part_y&=%bmpy/Wurzel2(puzzle_teile&)
      zeile&=1
      spalte&=1
      whileloop puzzle_teile& 'Bild in Puzzle-Teile teilen
        pic_part&[&loop]=Create("hPicCopy", apic&, (spalte&-1)*part_x&, (zeile&-1)*part_y&, part_x&, part_y&)
        StartPaint pic_part&[&loop]
          UseBrush 0,0
          UsePen 0,&Rahmen_Dicke,Back_Color()
          Rectangle 0,0 - %bmpx,%bmpy
        EndPaint
        If (&loop Mod Wurzel2(puzzle_teile&)=0)
          spalte&=spalte&+1
          zeile&=1
        Else
          zeile&=zeile&+1
        EndIf
      EndWhile
      If size&=1
        Setwindowpos %hwnd=((%MaxX-(part_x&*Wurzel2(puzzle_teile&)))/2),(((%MaxY-(part_y&*Wurzel2(puzzle_teile&)))-35)/2) - (part_x&*Wurzel2(puzzle_teile&))+6, (part_y&*Wurzel2(puzzle_teile&))+67
        Setwindowpos bt&[0]=2,(height(%hwnd)-32) - 95,30
        Setwindowpos bt&[1]=102,(height(%hwnd)-32) - 85,30
        Setwindowpos bt&[2]=192,(height(%hwnd)-32) - 85,30
        Setwindowpos bt&[3]=(width(%hwnd)-145),(height(%hwnd)-32) - 105,30
        Setwindowpos bt&[4]=(width(%hwnd)-35),(height(%hwnd)-32) - 32,30
      Endif
      SetText %hwnd,"Schiebe-Puzzle - "+pfad$
    Else
      err&=1
      Messagebox("Das ausgewählte Bild ist nicht ladbar.\nBitte verwenden sie eine Grafik mit der Mindestgröße von 400x300px.","Bild nicht ladbar!",48)
    Endif
  Else
    err&=1
  Endif
  DeleteObject apic&
  Return err&
EndProc
Proc MixPic
  Declare kombination$, random&
  Clear apos&[]
  SetSize apos&[], puzzle_teile&+1
  aempty_part&=1
  While (kombination$="")
    Randomize
    random&=RND(zaehler&-1)+1
    If (SUBSTR$(kombi$[random&],1,"=")=Str$(INT(Wurzel2(puzzle_teile&)-2)))
      kombination$=SUBSTR$(kombi$[random&],2,"=")
    EndIf
  EndWhile
  whileloop puzzle_teile&
    apos&[&loop]=Val(SubStr$(kombination$,&loop,"|"))
    Case (aempty_part&=&loop) : nempty_part&=Val(SubStr$(kombination$,&loop,"|"))
  EndWhile
EndProc
Proc ShowPuzzle
  UsePen 0,0,0
  UseBrush 1,0
  Rectangle 0,0 - apic_x&,apic_y&
  zeile&=1
  spalte&=1
  whileloop puzzle_teile&
    z&=&loop
    whileloop puzzle_teile&
      IF apos&[&loop]=z&
        z&=&loop
        break
      Endif
    Endwhile
    Case (aempty_part&<>z&) : DrawPic pic_part&[z&], (spalte&-1)*part_x&, (zeile&-1)*part_y&; 0
    If ((&loop Mod Wurzel2(puzzle_teile&))=0)
      spalte&=spalte&+1
      zeile&=1
    Else
      zeile&=zeile&+1
    EndIf
  Endwhile
EndProc
Proc DrawButton
  Parameters dx&,text$
  var bt_pic&=Create("hNewPic", dx&,30,0)
  StartPaint bt_pic&
    UsePen 0,1,RGB(255,255,210)
    UseBrush 1,RGB(0,128,0)
    RoundRect 0,0 - %BmpX,%BmpY; 22,22
    UseFont "Arial",16,0,1,0,0
    TextColor RGB(255,255,210),-1
    DrawText 0, 7, %BmpX,%BmpY, text$, 1
  EndPaint
  Return bt_pic&
EndProc
Proc MouseInPart
  Var x_&=0
  zeile_&=1
  spalte_&=1
  whileloop puzzle_teile&
    If Between(CursorPos("X1",0, %hwnd), (spalte_&-1)*part_x&, ((spalte_&-1)*part_x&)+part_x&, CursorPos("Y1",0, %hwnd), (zeile_&-1)*part_y&, (zeile_&-1)*part_y&+part_y&)=1
      x_&=&loop
      break
    EndIf
    If (&loop Mod Wurzel2(puzzle_teile&)=0)
      spalte_&=spalte_&+1
      zeile_&=1
    Else
      zeile_&=zeile_&+1
    EndIf
  EndWhile
  Return x_&
EndProc
Proc CursorPos
  Parameters Modus$, global&, hdl&
  Declare mpos#
  Dim mpos#,8
  External("user32","GetCursorPos",mpos#)
  Case global&<>1 : External("USER32","ScreenToClient",hdl&,mpos#)
  Case Modus$="X1" : Return long(mpos#,0)
  Case Modus$="Y1" : Return long(mpos#,4)
  Case Modus$="X2" : Return IF(global&=1,%maxx,width(hdl&))-long(mpos#,0)
  Case Modus$="Y2" : Return IF(global&=1,%maxy,height(hdl&))-long(mpos#,4)
  Return 1
EndProc
Proc WindowRect
  Parameters hdl&,Modus$, global&, hwnd&
  Declare x%, b#
  Dim b#,16
  External("USER32", "GetWindowRect",hdl&,b#)
  Case global&<>1 : External("USER32","ScreenToClient",hwnd&,b#):External("USER32","ScreenToClient",hwnd&,b#+8)
  Case Modus$="Breite" : x%=Long(b#,8)-Long(b#,0)
  Case Modus$="Höhe" : x%=Long(b#,12)-Long(b#,4)
  Case Modus$="X1" : x%=Long(b#,0)
  Case Modus$="Y1" : x%=Long(b#,4)
  Case Modus$="X2" : x%=Long(b#,8)
  Case Modus$="Y2" : x%=Long(b#,12)
  Dispose b#
  Return x%
EndProc
