Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.09.2012, 18:13   #1
Lightnin
 
Регистрация: 06.09.2012
Сообщений: 2
По умолчанию блок-схема для Сапера

Помогите составить блок-схему для программы Сапер
код:
Код:
unit Minesf;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, Grids, StdCtrls, Menus, ExtCtrls, ImgList;

const NItems = 10;
const NMines = 12;

type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    Panel1: TPanel;
    LabelShots: TLabel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    NewGame1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    ImageList: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormDestroy(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure NewGame1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    Playing: Boolean;
    Bmp: TBitmap;
    LastBmp: Char;
    Shots,
    MinesFound: Integer;

    Display: array [0 .. NItems - 1, 0 .. NItems -1] of Boolean;

    Map: array [0 .. NItems - 1, 0 .. NItems -1] of Char;

    procedure ComputeMines (X, Y: Integer);

    procedure FloodZeros (X, Y: Integer);

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses MMSystem;

procedure TForm1.FormCreate(Sender: TObject);
var
  I, J, X, Y, MinesToPlace: Integer;
  TempBmp:TBitmap;
begin
  If Imagelist.Count<=0 then
  begin
    TempBmp:=TBitmap.Create;
    TempBmp.LoadFromFile('def.bmp');
    Imagelist.Clear;
    Imagelist.Add(TempBmp,TempBmp);
    TempBmp.Free;
  end;
  Randomize;
  Playing := True;
  Shots := 0;
  MinesFound := 0;
  Bmp := TBitmap.Create;
  LastBmp := ' ';

  for I := 0 to NItems - 1 do
    for J := 0 to NItems - 1 do
    begin
      Map [I, J] := ' ';
      Display [I, J] := False;
    end;

  MinesToPlace := NMines;
  while MinesToPlace > 0 do
  begin
    X := Random (NItems);
    Y := Random (NItems);
    if Map [X, Y] <> 'M' then
    begin
      Map [X, Y] := 'M';
      Dec (MinesToPlace);
    end;
  end;

  for I := 0 to NItems - 1 do
    for J := 0 to NItems - 1 do
      if not (Map [I, J] = 'M') then
        ComputeMines (I, J);
end;

procedure TForm1.ComputeMines (X, Y: Integer);
var
  Col, Row: Integer;
  Total : Char;
begin
  Total := '0';
  for Col := X - 1 to X + 1 do
    for Row := Y -1 to Y + 1 do
      if (Col >= 0) and (Col < NItems) and
          (Row >= 0) and (Row < NItems) then

        if (Map [Col, Row] = 'M') or
            (Map [Col, Row] = 'K') then
          Inc (Total);
  Map [X, Y] := Total;
end;

procedure TForm1.FloodZeros (X, Y: Integer);
var
  Col, Row: Integer;
  MyRect: TRect;
begin
  if Map [X, Y] = '0' then
    for Col := X - 1 to X + 1 do
      for Row := Y -1 to Y + 1 do
        if (Col >= 0) and (Col < NItems) and
          (Row >= 0) and (Row < NItems) and
          not ( (Col = X) and (Row = Y) )then
        begin

          if (Map [Col, Row] = '0') and
              (Display [Col, Row] = False) then
          begin

            Display [Col, Row] := True;
            FloodZeros (Col, Row);
          end
          else
            Display [Col, Row] := True;
          MyRect := DrawGrid1.CellRect (Col, Row);
          InvalidateRect (DrawGrid1.Handle, @MyRect, False);
        end
end;

procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: LongInt;
  MyRect: TRect;
begin
  if not Playing then Exit;
  DrawGrid1.MouseToCell (X, Y, Col, Row);
  if not Playing then
    SysUtils.Beep
  else if Button = mbLeft then
  begin
    Inc (Shots);
    LabelShots.Caption := 'Shots: ' + IntToStr (Shots);

    if (Map [Col, Row] = 'M') or (Map [Col, Row] = 'K') then
    begin
      PlaySound ('Boom.wav', 0, snd_async);
      Playing := False;
      ShowMessage(' Game Over');
    end

Последний раз редактировалось Serge_Bliznykov; 11.09.2012 в 14:25.
Lightnin вне форума Ответить с цитированием
Старый 09.09.2012, 18:13   #2
Lightnin
 
Регистрация: 06.09.2012
Сообщений: 2
По умолчанию

Код:
else
    begin
      Display [Col, Row] := True;
      if Map [Col, Row] = '0' then
        FloodZeros (Col, Row);
    end;
  end
  else
  begin
    case Map [Col, Row] of

      'M': begin
        Map [Col, Row] := 'K';
        Display [Col, Row] := True;
        Inc (MinesFound);
        if MinesFound = NMines then
        begin
          MessageDlg ('You have won. Congratulations!',
            mtInformation, [mbOK], 0);
          Playing := False;
          DrawGrid1.Repaint;
        end
      end;

      'K': begin
        Map [Col, Row] := 'M';
        Display [Col, Row] := False;
        Dec (MinesFound);
      end;
      '0'..'8': begin
        Map [Col, Row] := 'W';
        Display [Col, Row] := True;
      end;

      'W': begin
        ComputeMines (Col, Row);
        Display [Col, Row] := False;
      end;
    end;
  end;
  MyRect := DrawGrid1.CellRect (Col, Row);
  InvalidateRect (DrawGrid1.Handle, @MyRect, False);
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer; Rect: TRect; State: TGridDrawState);

  procedure MyDraw(ACode:Char);
  var dx:integer;
  begin
    Case ACode of
    '0': dx:=0;
    '1': dx:=1;
    '2': dx:=2;
    '3': dx:=3;
    '4': dx:=4;
    '5': dx:=5;
    '6': dx:=6;
    '7': dx:=7;
    '8': dx:=8;
    'M': dx:=9;
    'K': dx:=10;
    'W': dx:=10;
    'U': dx:=11;
    end;
  Imagelist.Draw(DrawGrid1.Canvas,Rect.Left, Rect.Top,dx);
  end;

var Code: Char;
begin
  Code := Map [Col, Row];

  if Display [Col, Row] then
  begin
    if not (Code = LastBmp) then LastBmp := Code;
    MyDraw(Code);
  end
  else
  begin
    if not (LastBmp = 'U') then LastBmp := 'U';
    MyDraw(LastBmp);
  end;

  if (not Playing) and (Code = 'M') then
  begin
    if not (Code = LastBmp) then LastBmp := Code;
    MyDraw(Code);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  MessageDlg ('Мастер сапера в Delphi',
    mtInformation, [mbOK], 0);
end;

procedure TForm1.NewGame1Click(Sender: TObject);
begin
  FormCreate (self);
  DrawGrid1.Repaint;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

end.


___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 11.09.2012 в 14:27.
Lightnin вне форума Ответить с цитированием
Старый 11.09.2012, 08:58   #3
astecenko
Homo Interneticus
Форумчанин
 
Аватар для astecenko
 
Регистрация: 04.03.2011
Сообщений: 611
По умолчанию

Если Вы хотите чтобы Вам помогли, то следуйте правилам форума, а именно: оформите код как код (в панели инструментов окна редактирования сообщения есть спец. кнопка "Код" #

К сведению: обычно на основании блок-схем алгоритма пишется программа, а не наоборот.

Опять же, если хотите именно чтобы Вам помогли, а не сделали за Вас продемонстрируйте что получилось у Вас, Вы же сами что-то рисовали? Если хотите чтобы сделали за Вас - то Вам в раздел Фриланс.
astecenko вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Блок схема для программы Bloodnes Помощь студентам 6 13.01.2011 17:26
Блок схема для P_Sharp Денис999 Помощь студентам 2 23.12.2010 18:22
блок схема для алгоритма RC6 Anenya.K Софт 5 09.03.2010 18:38
БЛок-схема для цикла с параметром Den55 Помощь студентам 0 10.02.2010 23:37
Блок-схема для С++ LoRD_ОЛЕДЖАН Помощь студентам 0 24.10.2009 22:06