С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Sanuushka
1 / 1 / 0
Регистрация: 22.11.2015
Сообщений: 31
1

Виселица

21.05.2017, 22:31. Просмотров 163. Ответов 0

Подобная тема уже была, но у меня вопрос: нашла игру "Виселица". Я приделала к ней ограниченное число ходов, и посмотрите что получилось: когда человек проигрывает и собирается играть снова, фокус на алфавитной доске остаётся и буква, на которой фокус, больше не появляется до обновления игры. Как это можно было бы исправить?
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls;
 
type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    StringGrid2: TStringGrid;
    Label1: TLabel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Zapolnenie;
 
  private
  public
  end;
 
var
  Form1 : TForm1;
    sch : Integer;
    strl : TStringList;
    Z, ZT : String;
 
implementation
{$R *.dfm}
 
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  sch := 0;
  Button1.Click;
end;
 
 
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
Var
  StringGrid : TStringGrid;
  C : TCanvas;
begin
  StringGrid := Sender as TStringGrid;
  C := StringGrid.Canvas;
  C.Font := StringGrid.Font;
  if (ARow >= StringGrid.FixedRows) and (ACol >= StringGrid.FixedCols) then
    C.Brush.Color := StringGrid.Color
  else C.Brush.Color := StringGrid2.Color;
  If ActiveControl = Sender then //выкл выдел
    if (gdSelected in State) then
    begin
      C.Font.Color := 0;
      C.Brush.Color := StringGrid1.Color;
    end;
  C.FillRect(Rect);
  C.TextOut(Rect.Left+2,Rect.Top+2, StringGrid.Cells[ACol, ARow]);
end;
 
 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);     //очистка
begin
 strl.Free;
end;
 
 
 
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  sim:char;   //выбранный символ
  i,j:integer;  //для циклов
  ugStr:String;  //угаданные буквы
begin
 
  if length(StringGrid1.Cells[ACol,ARow])>0 then
  begin
    sim:= StringGrid1.Cells[ACol,ARow][9];
    sch := sch+1;
  end;
  {проверка}
 
  if pos(sim,Z)>0 then            //записывает в SG2 если угадал
  Begin
      for i:=1 to length(Z) do        //пробегается по слову
      Begin
             if Z[i]=sim then
             Begin
                 StringGrid2.Cells[i-1,0]:=sim;  //соответсв. записывает в нужную яч
             end;
         end;
      end;
 
      for i:=0 to StringGrid2.ColCount do
      Begin
        ugStr:=ugStr+StringGrid2.Cells[i,0];
        for j:=length(ugStr) downto 1 do
        Begin
          if pos(' ',ugStr) > 0 then delete(ugStr,pos(' ',ugStr),1);
        end;
      end;
  if sch=12 then
  begin
     if MessageDlg('Вы проиграли виселице. Начать игру заново?', mtConfirmation, [mbYes, mbNo], 0)=mrYes then
     begin
        Button1.Click;
        Button1.SetFocus;
     end;
  end;
  if ugStr=ZT then
  Begin
      ShowMessage('Вы победили!');
      ugStr := '';
  end;
  StringGrid1.Cells[ACol,ARow]:='';
 
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
var
    i, j : Integer;
begin
 
    sch := 0;
    zapolnenie;
    i := 1;
    Randomize;
    While  odd(i)  do i:= Random(strl.Count-1);        //нечет - вопрос, чет - ответ
    Label1.Caption := strl.Strings[i];
    Z := (strl.Strings[i+1]);                          //ответ
    ZT := Z;                                           //oтвет без пробелов
    StringGrid2.ColCount := length(strl.Strings[i+1]);   //колво ячеек сколько символов в ответе
    StringGrid2.Width := length(strl.Strings[i+1])*StringGrid2.DefaultColWidth+15; //ширина
    for i := 0 to StringGrid2.ColCount do StringGrid2.Cells[i,0] := '';
    for j := length(ZT) downto 1 do
     if pos(' ',ZT) > 0 then Delete(ZT,pos(' ',ZT),1);
end;
 
 
 
procedure TForm1.zapolnenie;
   var i, j, k : Integer;
begin
     k := 192;
     for j := 0 to 3 do  Begin
        for i := 0 to 7 do StringGrid1.Cells[i,j] := '        '+chr(i+k);
        k := k+8;
     end;
     strl := TStringList.Create;  //контейнер для хранения строк
     strl.LoadFromFile('D:\HMRusBase.txt');
     Randomize;  //генератор случайных значений
end;
 
 
 
procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
  Var
    StringGrid: TStringGrid;
    C: TCanvas;
begin
  StringGrid := Sender as TStringGrid;
  C := StringGrid.Canvas;
  C.Font := StringGrid.Font;
  if (ARow >= StringGrid.FixedRows) and (ACol >= StringGrid.FixedCols)
    then C.Brush.Color := StringGrid.Color
  else C.Brush.Color := StringGrid2.Color;
  If ActiveControl = Sender then
    if (gdSelected in State) then
    begin
      C.Font.Color := 0;
      C.Brush.Color := StringGrid1.Color;
    end;
  C.FillRect(Rect);
  C.TextOut(Rect.Left+2,Rect.Top+2, StringGrid.Cells[ACol, ARow]);
end;
 
 
 
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (Key=VK_Up) or (Key=VK_Down) or (Key=VK_Left) or (Key=VK_RIGHT) then Key:=VK_Shift;
end;
 
end.
0
Миниатюры
Виселица  
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.05.2017, 22:31
Ответы с готовыми решениями:

Игра 'Виселица'
У вас у кого-нибудь случайно нет исходника игры "Виселица" на Delphi? Помогите,...

Программа виселица
Набрасал тут код для игры. Но не могу сделать так чтобы 1 и последняя буквы...

Создать игру виселица
Извините помогите пожалуйста ,нужно создать игру виселица ну или какой нить...

Игра "Виселица"
пожалуйста напишите код, чтобы загаданное слово отображалось...

Игра Виселица
Создать игру виселица, которое содержит окно с горизонтальным меню на языке...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.05.2017, 22:31

код игры виселица
нужно составить программу виселицы к слову морковь Добавлено через 1 час 26...

Виселица с графическим интерфейсом
Нужна помощь,если кто готов помочь.То буду безумно благодарен. За ранее...

Виселица: проблема с Label
Привет! я почти написал с помощю AWT игру виселица но не хватает последнего...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru