PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » OpenSource » Судоку


Судоку

Сообщений 1 страница 7 из 7

1

http://s001.radikal.ru/i195/1004/fc/8ed752da4fba.jpg

Код:
Enumeration
  #Window_0
  #Window_1
EndEnumeration

Enumeration
  #MenuBar_0
  #MENU_1
  #MENU_2
  #MENU_3
  #MENU_4
  #MENU_5
  #MENU_6
  #MENU_7
  #MENU_8
EndEnumeration

Structure RAZG
  STRING.s
  COLUMN.s
  BLOCK.s
EndStructure   

Global Dim matrix.RAZG(8)

LoadFont(0, "Arial", 16)

; две процедуры LineGadget   и   Line_0   для рисования линий на окне
Procedure LineGadget(Gadget, x, y ,Width,Height) 
  Protected Image 
  Image=CreateImage(#PB_Any, Width,Height) 
  If Image 
    If StartDrawing(ImageOutput(Image)) 
        Line(x, y, Width, Height, RGB(150,150,150)) 
      StopDrawing() 
      ImageGadget(Gadget, x, y ,Width, Height, ImageID(Image)) 
    EndIf 
  EndIf 
EndProcedure 
Procedure Line_0(g,w,h,uvx,uvy,uvw,uvh)
  
  x=15 : y=15 
  
  For c=1 To 10 
    Select c
      Case 1,4,7,10
        LineGadget(g, x, y ,w+uvw,h+uvh)
      Case 2,3,5,6,8,9
        LineGadget(g, x, y ,w,h)
    EndSelect
    
    x=x+uvx : y=y+uvy    
    g+1
  Next
  
EndProcedure
; Поддержка событий мыши для TextGadget
Procedure IsMouseOver(wnd) 
  GetWindowRect_(wnd,re.RECT) 
  GetCursorPos_(pt.POINT)
  ProcedureReturn PtInRect_(re,pt\x|(pt\y<<32)) 
EndProcedure
; основное окно
Procedure Open_Window_0()
  
  If OpenWindow(#Window_0, 216,215, 390, 410, "Судоку",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar |#PB_Window_ScreenCentered)
    If CreateMenu(#MenuBar_0, WindowID(#Window_0))
      MenuTitle("Меню")
      MenuItem(#MENU_1, "Новая игра")
      OpenSubMenu("Уровень")
        MenuItem(#MENU_2, "Легкий")
        MenuItem(#MENU_3, "Средний")
        MenuItem(#MENU_4, "Тяжелый")
        MenuItem(#MENU_5, "Свой уровень")
      CloseSubMenu()
      MenuItem(#MENU_6,"Открыть сохраненный судоку")
      MenuItem(#MENU_7,"Сохранить судоку")
      MenuItem(#MENU_8,"Об игре")
    EndIf
    
    x=18 : y=18 : d=1 
    For b=1 To 9
      For c=1 To 9
        TextGadget(d, x, y, 36,36, "",#PB_Text_Center|#SS_CENTERIMAGE)
        SetGadgetFont(d, FontID(0))
        x+40
        d+1
      Next
      y+40
      x=18
    Next
  EndIf
  
EndProcedure
; окно для ввода цифр
Procedure Open_Window_1()
  If OpenWindow(#Window_1, 216, 0,280, 40, "Нажмите нужное число",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar  |#PB_Window_ScreenCentered)
    ee=10
    For e=150 To 158
      ButtonGadget(e, ee,10,20,20,Str(e-149))
      ee+30
    Next  
  EndIf
EndProcedure
; начальная расстановка строк для генерации
Procedure NACHALO_GENER_DANN()  
  matrix(0)\STRING="916358724"
  matrix(1)\STRING="234167589"
  matrix(2)\STRING="578249136"
  matrix(3)\STRING="123475698"
  matrix(4)\STRING="459681273"
  matrix(5)\STRING="687923415"
  matrix(6)\STRING="341592867"
  matrix(7)\STRING="762834951"
  matrix(8)\STRING="895716342"
EndProcedure
; Образование столбцов из строк
Procedure COLUMN_OBRAZOVANIE()
  For b=0 To 8 
    For a=0 To 8
      str.s+Mid(matrix(a)\STRING, b+1,1)
    Next  
    matrix(b)\COLUMN=str
    str=""
  Next
EndProcedure
; образование строк из столбцов
Procedure STRING_OBRAZOVANIE()
  For b=0 To 8 
    For a=0 To 8
      str.s+Mid(matrix(a)\COLUMN, b+1,1)
    Next  
    matrix(b)\STRING=str
    str=""
  Next
EndProcedure
; Образование блоков из строк
Procedure BLOCK_OBRAZOVANIE()
  c=1
  d=0
  For b=0 To 8 
    For a=d To d+2
      str.s+Mid(matrix(a)\STRING, c,3)
    Next  
    matrix(b)\BLOCK=str
    c+3
    If c=10
      c=1
      d+3
    EndIf   
    str=""
  Next
EndProcedure
;Обмен строк и столбцов
Procedure OBMEN(n,f)
  c.b=Random(2)+n
  e.b=Random(2)+n
  If f=0
    a.s=matrix(c)\STRING
    b.s=matrix(e)\STRING
  Else
    a.s=matrix(c)\COLUMN
    b.s=matrix(e)\COLUMN
  EndIf
  d.s=a.s : a.s=b.s : b.s=d.s
  If f=0
    matrix(c)\STRING=a.s
    matrix(e)\STRING=b.s
    COLUMN_OBRAZOVANIE()
  Else
    matrix(c)\COLUMN=a.s
    matrix(e)\COLUMN=b.s
    STRING_OBRAZOVANIE()
  EndIf
EndProcedure
;Основная генерация
Procedure GENERATOR()
  For a=0 To 1000
    Select Random(5)
      Case 0
        OBMEN(0,0)
      Case 1
        OBMEN(3,0) 
      Case 2
        OBMEN(6,0) 
      Case 3
        OBMEN(0,1) 
      Case 4
        OBMEN(3,1)
      Case 5
        OBMEN(6,1)
    EndSelect 
  Next
EndProcedure
;складывание в общую строку всех строк
Procedure.s ST_PLUS()
  For a=0 To 8
    str.s+matrix(a)\STRING
  Next  
  ProcedureReturn str
EndProcedure
;складывание в общую строку всех чисел из гаджетов
Procedure.s ST_PLUS_Gadget()
  For a=1 To 81
    str.s+GetGadgetText(a)
  Next  
  ProcedureReturn str
EndProcedure
; Ищем какое число больше всех встречается в строке
Procedure Many(a.s)
  e=1
  For d=1 To 9 
    Repeat 
      b=FindString(a.s, Str(d), e+b)
      If b<>0
        c+1
      EndIf   
    Until b=0
    If c1<c
      c1=c
      CHISLO=d
    EndIf
    c=0
    e=1
  Next
  ProcedureReturn CHISLO
EndProcedure
; Разбиваем строку по структурированному массиву
Procedure RAZ_STR(str.s)
  b=1
  For a=0 To 8
    matrix(a)\STRING = Mid(str.s, b, 9 )
    b+9
  Next  
EndProcedure
;Удаляем число,больше всех встречающееся в строке
Procedure.s clear_CHISLO(many_CH)
  Repeat 
    n=Random(8)
    If FindString(matrix(n)\STRING, Str(many_CH),1)<>0
      str.s=ReplaceString(matrix(n)\STRING,Str(many_CH) ," ") 
      matrix(n)\STRING=str.s
      Break
    EndIf        
  ForEver
EndProcedure  
; Основная процедура отвечающая за генерацию матрицы
Procedure BEGIN(UROVEN)
  NACHALO_GENER_DANN()       ; берем начальную инфу
  COLUMN_OBRAZOVANIE()         ; образование столбцов
  GENERATOR()                                 ;генерируем
  Repeat 
    str.s=ST_PLUS()                                       ;складываем строку
    st.s=ReplaceString(str.s, " ", "")          ;Удаляем пробелы в строке для подсчета
    If Len(st.s)=UROVEN                                           ; считаем чему равна строка без пробелов
      KON=1                                                      ; поднимаем флаг, если равно заложенному уровню
    EndIf   
    many_CH=Many(str.s)                              ; Узнаем самое часто встречающееся число
    RAZ_STR(str.s)                                          ; Разбиваем строку по структурированному массиву
    clear_CHISLO(many_CH)               ; Удаляем такое число в одной из девяти строк рандомно 
  Until KON=1                                                    ; если флаг поднят завершаем этот цикл
EndProcedure
;Возвращаем номер гаджета
Procedure GADGET(st)
  For a=1 To 81
    If  IsMouseOver(GadgetID(a)) 
      Gadget=a
      font=GetGadgetColor(a, #PB_Gadget_FrontColor)
      
      If font>0 And GetGadgetText(a)<>" "
        If st=1
          SetGadgetText(a," ")
        Else
          Open_Window_1()
        EndIf 
      ElseIf GetGadgetText(a)=" " 
        If st=1
          SetGadgetText(a," ")
        Else
          Open_Window_1()
        EndIf
      EndIf  
    EndIf
  Next   
  ProcedureReturn Gadget
  
EndProcedure
;Поиск дубликатов
Procedure CHECK(str.s)
  e=1
  For d=1 To 9 
    Repeat 
      b=FindString(str.s, Str(d), e+b)
      If b<>0
        c+1
      EndIf   
    Until b=0
    If c>1
      ProcedureReturn 1 
    Else
      c=0
    EndIf   
  Next
  ProcedureReturn 0
EndProcedure
;Процедура контролирующая поиск дубликатов
Procedure SHERSTIM()
  str.s=ST_PLUS_Gadget()
  RAZ_STR(str.s)
  COLUMN_OBRAZOVANIE()
  BLOCK_OBRAZOVANIE()
  For a=0 To 8
    If CHECK(matrix(a)\STRING)=1 Or CHECK(matrix(a)\COLUMN)=1 Or CHECK(matrix(a)\BLOCK)=1
      ProcedureReturn 1
    EndIf   
  Next
  ProcedureReturn 0
EndProcedure
; отправка в гаджеты чисел
Procedure Vgadget(str.s)
  For a=1 To 81                                                 
    SetGadgetText(a,Mid(str.s, a, 1 ))
    SetGadgetColor(a,#PB_Gadget_FrontColor,RGB(0, 0, 0))
  Next 
EndProcedure 
; установка маркера в меню
Procedure MENU(st)
  For a=2 To 5
    SetMenuItemState(0, a, 0)
  Next
  SetMenuItemState(0, st, 1)
EndProcedure
; В зависимости от уровня(закладываемого в меню), начинаем новую игру
Procedure MENU_DO(st)
  BEGIN(st)
  str.s=ST_PLUS()                                                        
  Vgadget(str.s)                            
EndProcedure
; Начинаем
Open_Window_0()                                       ; открываем главное окно
MENU(3)
Line_0(101,360,1,0,40,0,2)                          ; рисуем строки
Line_0(111,1,360,40,0,2,0)                          ; рисуем столбцы
LineGadget(121, 15, 375 ,363,3)                ; брак в рисовании, подрисовываем немного линию
MENU_DO(36)                                                ; начинаем игру
;-главный цикл
Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          getstate=1
          Select getstate
            Case GetMenuItemState(0, 2)           ;GetMenuItemState()   считываем какое меню маркировано
              MENU_DO(41)
            Case GetMenuItemState(0, 3)
              MENU_DO(36)
            Case GetMenuItemState(0, 4)
              MENU_DO(31)
            Case GetMenuItemState(0, 5)
              MENU_DO(SVUR)
          EndSelect      
        Case 2   
          MENU(2)
          MENU_DO(41)
        Case 3
          MENU(3)
          MENU_DO(36)
        Case 4
          MENU(4)
          MENU_DO(31)
        Case 5
           SVUR=Val(InputRequester("Свой уровень", "Введите число нужных заполненных ячеек", ""))+1
          If SVUR>81
            SVUR=81
          ElseIf SVUR<1
            SVUR=1
          EndIf  
          MENU(5)
          MENU_DO(SVUR)
        Case 6
          file.s=OpenFileRequester("Загрузить судоку", "Sud", "Файлы судоку(*.sud)|*.sud", 0)
          If file.s
            If ReadFile(0, file.s) 
              While Eof(0) = 0          
                str.s=ReadString(0)     
              Wend
              CloseFile(0)             
            EndIf
            Vgadget(str.s)
          EndIf  
        Case 7
          File$ = SaveFileRequester("Введите имя для сохранения судоку", "", "", 0)
          If File$
            str.s=ST_PLUS_Gadget()
            OpenFile(0,File$+".sud")
            WriteString(0,str.s)
            CloseFile(0)
          EndIf
        Case 8
          MessageRequester("Об игре","Автор Станислав Будинов, администратор сайта www.mneniya.ucoz.ru")
      EndSelect
    Case #WM_LBUTTONUP 
      Gadget=GADGET(0)                      ; Узнаем гаджет
    Case #WM_RBUTTONUP
      GADGET(1)                                    ; Узнаем и очищаем гаджет
    Case #PB_Event_Gadget       
      Select EventGadget()
        Case 150 To 158
          SetGadgetText(Gadget,GetGadgetText(GetActiveGadget()))            ; считываем инфу с кнопки
          If SHERSTIM()=0   
            SetGadgetColor(Gadget,#PB_Gadget_FrontColor,RGB(9, 13, 160))     ; этот цвет если число вписывается
          Else 
            SetGadgetColor(Gadget,#PB_Gadget_FrontColor,RGB(243, 5, 12))     ; а этот цвет если не вписывается
          EndIf   
          CloseWindow(#Window_1)            
      EndSelect     
    Case #PB_Event_CloseWindow     
      If EventWindow()=#Window_0
        End
      ElseIf    EventWindow()=#Window_1
        CloseWindow(#Window_1)
      EndIf 
  EndSelect     
ForEver

Скачать

0

2

Немного доработал игру.
Например, теперь при запуске не видно построения окна.
Дополнительное окно полностью блокирует основное.
По моему так лучше.

Код:
Enumeration
  #Window_0
  #Window_1
EndEnumeration

Enumeration
  #MenuBar_0
  #MENU_1
  #MENU_2
  #MENU_3
  #MENU_4
  #MENU_5
  #MENU_6
  #MENU_7
  #MENU_8
EndEnumeration

Structure RAZG
  STRING.s
  COLUMN.s
  BLOCK.s
EndStructure   

Global Dim matrix.RAZG(8)

LoadFont(0, "Arial", 16)

; две процедуры LineGadget   и   Line_0   для рисования линий на окне
Procedure LineGadget(Gadget, x, y ,Width,Height) 
  Protected Image 
  Image=CreateImage(#PB_Any, Width,Height) 
  If Image 
    If StartDrawing(ImageOutput(Image)) 
        Line(x, y, Width, Height, RGB(150,150,150)) 
      StopDrawing() 
      ImageGadget(Gadget, x, y ,Width, Height, ImageID(Image)) 
    EndIf 
  EndIf 
EndProcedure 
Procedure Line_0(g,w,h,uvx,uvy,uvw,uvh)
  
  x=15 : y=15 
  
  For c=1 To 10 
    Select c
      Case 1,4,7,10
        LineGadget(g, x, y ,w+uvw,h+uvh)
      Case 2,3,5,6,8,9
        LineGadget(g, x, y ,w,h)
    EndSelect
    
    x=x+uvx : y=y+uvy    
    g+1
  Next
  
EndProcedure
; Поддержка событий мыши для TextGadget
Procedure IsMouseOver(wnd) 
  GetWindowRect_(wnd,re.RECT) 
  GetCursorPos_(pt.POINT)
  ProcedureReturn PtInRect_(re,pt\x|(pt\y<<32)) 
EndProcedure
; основное окно
Procedure Open_Window_0()
  
  If OpenWindow(#Window_0, 216,215, 390, 410, "Судоку",  #PB_Window_MinimizeGadget|#PB_Window_Invisible|#PB_Window_ScreenCentered)
    If CreateMenu(#MenuBar_0, WindowID(#Window_0))
      MenuTitle("Меню")
      MenuItem(#MENU_1, "Новая игра")
      OpenSubMenu("Уровень")
        MenuItem(#MENU_2, "Легкий")
        MenuItem(#MENU_3, "Средний")
        MenuItem(#MENU_4, "Тяжелый")
        MenuItem(#MENU_5, "Свой уровень")
      CloseSubMenu()
      MenuItem(#MENU_6,"Открыть сохраненный судоку")
      MenuItem(#MENU_7,"Сохранить судоку")
      MenuItem(#MENU_8,"Об игре")
    EndIf
    
    x=18 : y=18 : d=1 
    For b=1 To 9
      For c=1 To 9
        TextGadget(d, x, y, 36,36, "",#PB_Text_Center|#SS_CENTERIMAGE)
        SetGadgetFont(d, FontID(0))
        x+40
        d+1
      Next
      y+40
      x=18
    Next
  EndIf
  
EndProcedure
; окно для ввода цифр
Procedure Open_Window_1()
  If OpenWindow(#Window_1, 216, 0,280, 40, "Нажмите нужное число",  #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_WindowCentered, WindowID(#Window_0))
    DisableWindow(#Window_0,1)
    ee=10
    For e=150 To 158
      ButtonGadget(e, ee,10,20,20,Str(e-149))
      ee+30
    Next  
  HideWindow(#Window_1,0)
  EndIf
EndProcedure
; начальная расстановка строк для генерации
Procedure NACHALO_GENER_DANN()  
  matrix(0)\STRING="916358724"
  matrix(1)\STRING="234167589"
  matrix(2)\STRING="578249136"
  matrix(3)\STRING="123475698"
  matrix(4)\STRING="459681273"
  matrix(5)\STRING="687923415"
  matrix(6)\STRING="341592867"
  matrix(7)\STRING="762834951"
  matrix(8)\STRING="895716342"
EndProcedure
; Образование столбцов из строк
Procedure COLUMN_OBRAZOVANIE()
  For b=0 To 8 
    For a=0 To 8
      str.s+Mid(matrix(a)\STRING, b+1,1)
    Next  
    matrix(b)\COLUMN=str
    str=""
  Next
EndProcedure
; образование строк из столбцов
Procedure STRING_OBRAZOVANIE()
  For b=0 To 8 
    For a=0 To 8
      str.s+Mid(matrix(a)\COLUMN, b+1,1)
    Next  
    matrix(b)\STRING=str
    str=""
  Next
EndProcedure
; Образование блоков из строк
Procedure BLOCK_OBRAZOVANIE()
  c=1
  d=0
  For b=0 To 8 
    For a=d To d+2
      str.s+Mid(matrix(a)\STRING, c,3)
    Next  
    matrix(b)\BLOCK=str
    c+3
    If c=10
      c=1
      d+3
    EndIf   
    str=""
  Next
EndProcedure
;Обмен строк и столбцов
Procedure OBMEN(n,f)
  c.b=Random(2)+n
  e.b=Random(2)+n
  If f=0
    a.s=matrix(c)\STRING
    b.s=matrix(e)\STRING
  Else
    a.s=matrix(c)\COLUMN
    b.s=matrix(e)\COLUMN
  EndIf
  d.s=a.s : a.s=b.s : b.s=d.s
  If f=0
    matrix(c)\STRING=a.s
    matrix(e)\STRING=b.s
    COLUMN_OBRAZOVANIE()
  Else
    matrix(c)\COLUMN=a.s
    matrix(e)\COLUMN=b.s
    STRING_OBRAZOVANIE()
  EndIf
EndProcedure
;Основная генерация
Procedure GENERATOR()
  For a=0 To 1000
    Select Random(5)
      Case 0
        OBMEN(0,0)
      Case 1
        OBMEN(3,0) 
      Case 2
        OBMEN(6,0) 
      Case 3
        OBMEN(0,1) 
      Case 4
        OBMEN(3,1)
      Case 5
        OBMEN(6,1)
    EndSelect 
  Next
EndProcedure
;складывание в общую строку всех строк
Procedure.s ST_PLUS()
  For a=0 To 8
    str.s+matrix(a)\STRING
  Next  
  ProcedureReturn str
EndProcedure
;складывание в общую строку всех чисел из гаджетов
Procedure.s ST_PLUS_Gadget()
  For a=1 To 81
    str.s+GetGadgetText(a)
  Next  
  ProcedureReturn str
EndProcedure
; Ищем какое число больше всех встречается в строке
Procedure Many(a.s)
  e=1
  For d=1 To 9 
    Repeat 
      b=FindString(a.s, Str(d), e+b)
      If b<>0
        c+1
      EndIf   
    Until b=0
    If c1<c
      c1=c
      CHISLO=d
    EndIf
    c=0
    e=1
  Next
  ProcedureReturn CHISLO
EndProcedure
; Разбиваем строку по структурированному массиву
Procedure RAZ_STR(str.s)
  b=1
  For a=0 To 8
    matrix(a)\STRING = Mid(str.s, b, 9 )
    b+9
  Next  
EndProcedure
;Удаляем число,больше всех встречающееся в строке
Procedure.s clear_CHISLO(many_CH)
  Repeat 
    n=Random(8)
    If FindString(matrix(n)\STRING, Str(many_CH),1)<>0
      str.s=ReplaceString(matrix(n)\STRING,Str(many_CH) ," ") 
      matrix(n)\STRING=str.s
      Break
    EndIf        
  ForEver
EndProcedure  
; Основная процедура отвечающая за генерацию матрицы
Procedure BEGIN(UROVEN)
  NACHALO_GENER_DANN()       ; берем начальную инфу
  COLUMN_OBRAZOVANIE()         ; образование столбцов
  GENERATOR()                                 ;генерируем
  Repeat 
    str.s=ST_PLUS()                                       ;складываем строку
    st.s=ReplaceString(str.s, " ", "")          ;Удаляем пробелы в строке для подсчета
    If Len(st.s)=UROVEN                                           ; считаем чему равна строка без пробелов
      KON=1                                                      ; поднимаем флаг, если равно заложенному уровню
    EndIf   
    many_CH=Many(str.s)                              ; Узнаем самое часто встречающееся число
    RAZ_STR(str.s)                                          ; Разбиваем строку по структурированному массиву
    clear_CHISLO(many_CH)               ; Удаляем такое число в одной из девяти строк рандомно 
  Until KON=1                                                    ; если флаг поднят завершаем этот цикл
EndProcedure
;Возвращаем номер гаджета
Procedure GADGET(st)
  For a=1 To 81
    If  IsMouseOver(GadgetID(a)) 
      Gadget=a
      font=GetGadgetColor(a, #PB_Gadget_FrontColor)
      
      If font>0 And GetGadgetText(a)<>" "
        If st=1
          SetGadgetText(a," ")
        Else
          Open_Window_1()
        EndIf 
      ElseIf GetGadgetText(a)=" " 
        If st=1
          SetGadgetText(a," ")
        Else
          Open_Window_1()
        EndIf
      EndIf  
    EndIf
  Next   
  ProcedureReturn Gadget
  
EndProcedure
;Поиск дубликатов
Procedure CHECK(str.s)
  e=1
  For d=1 To 9 
    Repeat 
      b=FindString(str.s, Str(d), e+b)
      If b<>0
        c+1
      EndIf   
    Until b=0
    If c>1
      ProcedureReturn 1 
    Else
      c=0
    EndIf   
  Next
  ProcedureReturn 0
EndProcedure
;Процедура контролирующая поиск дубликатов
Procedure SHERSTIM()
  str.s=ST_PLUS_Gadget()
  RAZ_STR(str.s)
  COLUMN_OBRAZOVANIE()
  BLOCK_OBRAZOVANIE()
  For a=0 To 8
    If CHECK(matrix(a)\STRING)=1 Or CHECK(matrix(a)\COLUMN)=1 Or CHECK(matrix(a)\BLOCK)=1
      ProcedureReturn 1
    EndIf   
  Next
  ProcedureReturn 0
EndProcedure
; отправка в гаджеты чисел
Procedure Vgadget(str.s)
  For a=1 To 81                                                 
    SetGadgetText(a,Mid(str.s, a, 1 ))
    SetGadgetColor(a,#PB_Gadget_FrontColor,RGB(0, 0, 0))
  Next 
EndProcedure 
; установка маркера в меню
Procedure MENU(st)
  For a=2 To 5
    SetMenuItemState(0, a, 0)
  Next
  SetMenuItemState(0, st, 1)
EndProcedure
; В зависимости от уровня(закладываемого в меню), начинаем новую игру
Procedure MENU_DO(st)
  BEGIN(st)
  str.s=ST_PLUS()                                                        
  Vgadget(str.s)                            
EndProcedure
; Начинаем
Open_Window_0()                                       ; открываем главное окно
MENU(3)
Line_0(101,360,1,0,40,0,2)                          ; рисуем строки
Line_0(111,1,360,40,0,2,0)                          ; рисуем столбцы
LineGadget(121, 15, 375 ,363,3)                ; брак в рисовании, подрисовываем немного линию
MENU_DO(36)                                                ; начинаем игру
HideWindow(#Window_0,0)
;-главный цикл
Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          getstate=1
          Select getstate
            Case GetMenuItemState(0, 2)           ;GetMenuItemState()   считываем какое меню маркировано
              MENU_DO(41)
            Case GetMenuItemState(0, 3)
              MENU_DO(36)
            Case GetMenuItemState(0, 4)
              MENU_DO(31)
            Case GetMenuItemState(0, 5)
              MENU_DO(SVUR)
          EndSelect      
        Case 2   
          MENU(2)
          MENU_DO(41)
        Case 3
          MENU(3)
          MENU_DO(36)
        Case 4
          MENU(4)
          MENU_DO(31)
        Case 5
           SVUR=Val(InputRequester("Свой уровень", "Введите число нужных заполненных ячеек", ""))+1
          If SVUR>81
            SVUR=81
          ElseIf SVUR<1
            SVUR=1
          EndIf  
          MENU(5)
          MENU_DO(SVUR)
        Case 6
          file.s=OpenFileRequester("Загрузить судоку", "Sud", "Файлы судоку(*.sud)|*.sud", 0)
          If file.s
            If ReadFile(0, file.s) 
              While Eof(0) = 0          
                str.s=ReadString(0)     
              Wend
              CloseFile(0)             
            EndIf
            Vgadget(str.s)
          EndIf  
        Case 7
          File$ = SaveFileRequester("Введите имя для сохранения судоку", "", "", 0)
          If File$
            str.s=ST_PLUS_Gadget()
            OpenFile(0,File$+".sud")
            WriteString(0,str.s)
            CloseFile(0)
          EndIf
        Case 8
          MessageRequester("Об игре","Автор Станислав Будинов, администратор сайта www.mneniya.ucoz.ru")
      EndSelect
    Case #WM_LBUTTONUP 
      Gadget=GADGET(0)                      ; Узнаем гаджет
    Case #WM_RBUTTONUP
      GADGET(1)                                    ; Узнаем и очищаем гаджет
    Case #PB_Event_Gadget       
      Select EventGadget()
        Case 150 To 158
          SetGadgetText(Gadget,GetGadgetText(GetActiveGadget()))            ; считываем инфу с кнопки
          If SHERSTIM()=0   
            SetGadgetColor(Gadget,#PB_Gadget_FrontColor,RGB(9, 13, 160))     ; этот цвет если число вписывается
          Else 
            SetGadgetColor(Gadget,#PB_Gadget_FrontColor,RGB(243, 5, 12))     ; а этот цвет если не вписывается
          EndIf   
          CloseWindow(#Window_1)  
          DisableWindow(#Window_0, 0)          
      EndSelect     
    Case #PB_Event_CloseWindow     
      If EventWindow()=#Window_0
        End
      ElseIf    EventWindow()=#Window_1
        CloseWindow(#Window_1)
        DisableWindow(#Window_0, 0)
      EndIf 
  EndSelect     
ForEver

0

3

Отличная работа) Хоть я и не собрал :blush: , но мне нравится

0

4

Например, теперь при запуске не видно построения окна.

Сказать по чести, я его на своем компе и не видел, может просто у меня пошустрее железяка.

Дополнительное окно полностью блокирует основное.

Хорошая идея

0

5

daiomik написал(а):

Отличная работа) Хоть я и не собрал  , но мне нравится

Почему не собрал? неохота или не получается? В любом случае в архиве есть EXE файл.

0

6

haav написал(а):

неохота или не получается?

да просто поставил уровень сложности на максимум, так на финишной черте началась неразбериха. А так вообще игра интересная, люблю позаморачиваться. Часто в газетах печатают подобные вещи:)

0

7

haav написал(а):

при запуске не видно построения окна.

у меня тоже подобный баг наблюдается

0


Вы здесь » PureBasic - форум » OpenSource » Судоку