VERSION 5.00
Begin VB.Form fSudokuHelper
   Caption         =   "Sudoku Helper"
   ClientHeight    =   6615
   ClientLeft      =   1650
   ClientTop       =   1545
   ClientWidth     =   6600
   LinkTopic       =   "Form1"
   ScaleHeight     =   6615
   ScaleWidth      =   6600
   Begin VB.PictureBox p
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   6375
      Left            =   120
      ScaleHeight     =   6375
      ScaleWidth      =   6375
      TabIndex        =   0
      Top             =   120
      Width           =   6375
   End
End
Attribute VB_Name = "fSudokuHelper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Merkkien etäisyys (180 twips)
Private Const CharDist = 180
'Sudokunumeroiden etäisyys toisistaan merkkeinä
Private Const NumberDist = 3.5
'Sudokulohkojen etäisyys toisistaan merkkeinä
Private Const BlockDist = 12
Private CharSizeX As Single
Private CharSizeY As Single
'9x9 kokoinen taulukko ruuduista, joihin on jo laitettu iso merkki
Private BigChars(8, 8) As Long

Private Function Place(Block As Long, Number As Long, Char As Long) As Long
    'Laskee koordinaatit X tai Y -suunnassa
    Place = Block * (CharDist * BlockDist) + Number * (CharDist * _
            NumberDist) + Char * CharDist
End Function

Private Sub PaintChar(BlockX As Long, BlockY As Long, NumberX As Long, _
    NumberY As Long, Char As Long, _
    Optional Blank As Boolean = False, Optional BigChar As Boolean = False, _
    Optional VerifyPossibility As Boolean = False)
   
    If VerifyPossibility And Not Blank Then _
      If Not CharPossible(BlockX, BlockY, NumberX, NumberY, Char) Then Exit Sub
   
    Dim X As Long, Y As Long
    Dim cX As Double, cY As Double
    If BigChar Then
        'Jos iso merkki, niin piirretään aina vasemaan yläkulmaan...
        X = 0: Y = 0
        '...ja laitetaan muistiin että ko. ruutu on täytetty
        BigChars(BlockX * 3 + NumberX, BlockY * 3 + NumberY) = Char
    Else
        'Pienille merkeille lasketaan sijainti ruudukossa
        Y = (Char - 1) \ 3
        X = (Char - 1) Mod 3
    End If
    'Lasketaan kooridnaatit
    cX = Place(BlockX, NumberX, X) + Screen.TwipsPerPixelX
    cY = Place(BlockY, NumberY, Y) + Screen.TwipsPerPixelY
    'Jos iso merkki, tyhjennetään koko sudoku-numero
    If BigChar Then
        p.Line (cX, cY)-(cX + CharDist * 3, cY + CharDist * 3), &HFFFFFF, BF
    Else
        If BigChars(BlockX * 3 + NumberX, BlockY * 3 + NumberY) <> 0 Then Exit Sub
    End If
    If Blank Then
        'Jos haluttiin pyyhkiä merkki, piirretään valkoinen laatikko
        p.Line (cX, cY)-(cX + CharSizeX, cY + CharSizeY), &HFFFFFF, BF
    Else
        'Oikea kohta tekstille
        p.CurrentX = cX
        p.CurrentY = cY
        'Oikea tekstikoko
        p.FontSize = IIf(BigChar, 24, 8)
        'Tulostetaan merkki
        p.Print Char
    End If
End Sub

Private Sub Form_Load()
    'Lasketaan merkin koko (etäisyys miinus yksi pikseli)
    CharSizeX = CharDist - Screen.TwipsPerPixelX
    CharSizeY = CharDist - Screen.TwipsPerPixelY
    Dim X As Long, Y As Long, xx As Long, yy As Long, xxx As Long, yyy As Long
    'Käydään kaikki sudokulohkot läpi
    For xxx = 0 To 2: For yyy = 0 To 2
        'ja niiden sisällä käydään kaikki sudokunumerot läpi
        For xx = 0 To 2: For yy = 0 To 2
            'Ja niiden sisällä piirretään kukin merkki
            For X = 1 To 9
                PaintChar xxx, yyy, xx, yy, X
            Next
        Next: Next
        'Piirretään numeroruudukko (viivat) kullekin sudokulohkolle
        For xx = 0 To 3
            p.Line (Place(xxx, xx, 0), Place(yyy, 0, 0))- _
              (Place(xxx, xx, 0), Place(yyy, 3, 0) + Screen.TwipsPerPixelY), 0
            p.Line (Place(xxx, 0, 0), Place(yyy, xx, 0))- _
              (Place(xxx, 3, 0) + Screen.TwipsPerPixelX, Place(yyy, xx, 0)), 0
        Next
    Next: Next
End Sub

Private Sub GetPosition(ByVal Coord As Single, Block As Long, Number As Long, _
                        Char As Long)
    'Lasketaan osiot koordinaatin perusteella
    Coord = Coord / CharDist
    'Lohko
    Block = Int(Coord / BlockDist)
    Coord = Coord - Block * BlockDist
    'Numero
    Number = Int(Coord / NumberDist)
    Coord = Coord - Number * NumberDist
    'Merkki
    Char = Int(Coord)
End Sub

Private Sub p_MouseDown(Button As Integer, Shift As Integer, cX As Single, _
                        cY As Single)
    Dim X As Long, Y As Long, xx As Long, yy As Long, xxx As Long, yyy As Long
    Dim Char As Long, la As Long, lb As Long, bRemoveSmall As Boolean
   
    'Käyttäjä klikkasi hiirellä, lasketaan..
    GetPosition cX, xxx, xx, X
    GetPosition cY, yyy, yy, Y
       
    'jos ei numeron alueella, poistutaan
    If yyy > 2 Or xxx > 2 Or xx > 2 Or yy > 2 Or Y > 2 Or X > 2 Then Exit Sub
   
    If Button = vbRightButton Then
        If CharPossible(xxx, yyy, xx, yy, Y * 3 + X + 1) Then _
            PaintChar xxx, yyy, xx, yy, Y * 3 + X + 1, True
        Exit Sub
    End If
   
    'Onko ko ruudussa jo valittu numero
    If BigChars(xxx * 3 + xx, yyy * 3 + yy) > 0 Then
        'Valinnan arvo
        Char = BigChars(xxx * 3 + xx, yyy * 3 + yy)
        'Poistetaan iso merkki
        PaintChar xxx, yyy, xx, yy, Char, True, True
        'Poistetaan valinta
        BigChars(xxx * 3 + xx, yyy * 3 + yy) = 0
        'Piirretään pikkumerkit
        bRemoveSmall = False
        'Pikkumerkit omaan ruutuun
        For la = 1 To 9
            PaintChar xxx, yyy, xx, yy, la, False, False, True
        Next
    Else
        'Klikatun merkin arvo
        Char = Y * 3 + X + 1
        'Onko mahdollinen?
        If Not CharPossible(xxx, yyy, xx, yy, Char) Then Exit Sub
        'Poistetaan pikkumerkit
        bRemoveSmall = True
        'Piirretään iso merkki
        PaintChar xxx, yyy, xx, yy, Char, False, True
    End If
    For la = 0 To 2: For lb = 0 To 2
        'Poistetaan merkki samalta riviltä
        PaintChar la, yyy, lb, yy, Char, bRemoveSmall, False, True
        'Poistetaan merkki samasta sarakkeesta
        PaintChar xxx, la, xx, lb, Char, bRemoveSmall, False, True
        'Poistetaan merkki samasta lohkosta
        PaintChar xxx, yyy, la, lb, Char, bRemoveSmall, False, True
    Next: Next
End Sub

Private Function CharPossible(BlockX As Long, BlockY As Long, NumberX As Long, NumberY As Long, Char As Long) As Boolean
    Dim la As Long, lb As Long
    'Oletuksena EI ok
    CharPossible = False
    For la = 0 To 2: For lb = 0 To 2
        'Onko numero samalla rivillä?
        If BigChars(la * 3 + lb, BlockY * 3 + NumberY) = Char Then Exit Function
        'Onko numero samassa sarakkeessa?
        If BigChars(BlockX * 3 + NumberX, la * 3 + lb) = Char Then Exit Function
        'Onko numero samassa lohkossa?
        If BigChars(BlockX * 3 + la, BlockY * 3 + lb) = Char Then Exit Function
    Next: Next
    'Ei löytynyt esteitä -> OK
    CharPossible = True
End Function