Задать вопрос

Alertoso

Комментарии

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, можете подсказать, пожалуйста, через какой компонент лучше это реализовать?(Когда буду ставить ферзя, то буду удалять ферзя, когда отменять ход, то наоборот возвращать)
    6070d78693dba199930981.png
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    Alertoso, да, там логику нужно было соблюсти)
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, а если он даже после ругательства поставит на красную клетку? Клетка ведь красная исчезает, хотя сейчас подумаю...
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, можете подсказать, пожалуйста, как можно, если с подсказками, запретить пользователю ставить ферзя на поля, которые будут закрашены красным цветом, то есть на какие ставить ферзя нельзя, я попробовал через CanSelect, но это не то, что я бы хотел...
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, https://drive.google.com/drive/folders/1BGD_NOdB08...
    Понимаю, что вопрос с буквами скорее косметический, просто интересно
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, сделал, можете подсказать, пожалуйста, почему буквы слегка нечёткие? Если с фоном букв, то там они чёткие...
    procedure TfrmMain.grdChessBoardDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  CellColor: TColor;
  i, j: integer;
  CurrentTickCount: cardinal;
  SolutionArray: TArray<integer>;
  img1, img2: TPicture;
  t1: TRect;
  str1, str2: string;
begin
  with grdChessBoard do
    if (ACol >= 1) and (ARow >= 1) then
    if Queens[ACol, ARow] then
    begin
      if (ACol + ARow) mod 2 = 0 then
        Canvas.StretchDraw(CellRect(ACol, ARow), img1.Graphic)
      else
        Canvas.StretchDraw(CellRect(ACol, ARow), img2.Graphic);
    end
    else
    begin
      if (ACol >= 1) and (ARow >= 1) then
        if ((ACol + ARow) mod 2) = 0 then
        CellColor := $9ecfff
      else
        CellColor := $478bd1;
      Canvas.Brush.Color := CellColor;
      Canvas.FillRect(Rect);
    end;
  i:=1;
  J:=QueensCount;
  while (I <= QueensCount) do with grdChessBoard do
  begin
    Font.Size:=20+trunc(grdChessBoard.DefaultRowHeight/QueensCount)-1;
    Font.Style:=[fsBold];
    Font.Name:='Times New Roman';
    grdChessBoard.Canvas.Brush.Style:=bsClear;
    t1:=grdChessBoard.CellRect(i,0);
    str1:=char(ord(96+i));
    canvas.textout(t1.left, t1.top, str1);
    t1:=grdChessBoard.CellRect(0,i);
    str2:=IntToStr(J);
    canvas.textout(t1.left, t1.top, str2);
    Inc(I);
    Dec(J);
  end;
end;
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    Alertoso, ну она и не работает, но просто как можно оформить это красиво(дело в том, что от формы я отказался, почитал документацию, в делфи есть такая неплохая вещь, как MessageDlg), вот в зависимости, что было нажато, я хочу и очищать доску
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, такая чистка же не будет работать?
    procedure TfrmMain.Clean;
var
  CellColor: TColor;
  ACol, ARow: Integer;
  Rect: TRect;
begin
  for ACol := 1 to QueensCount do
    for ARow := 1 to QueensCount do
    Begin
      with grdChessBoard do
      if (ACol >= 1) and (ARow >= 1) then
      begin
          if ((ACol + ARow) mod 2) = 0 then
          CellColor := $9ecfff
        else
          CellColor := $478bd1;
        Canvas.Brush.Color := CellColor;
        Canvas.FillRect(Rect);
      end;
    End;
end;
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, насчёт зачем скрывать форму, соглашусь, да, сообщение, удалось ли пользователю правильно расставить ферзей или нет, насчёт проверки, согласен, добавил ещё один флаг, который определяет, нужно ли проверять диагонали
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    Alertoso, нормальный выход?
    procedure TfrmMain.Check;
var
  I, q: Integer;
  J, f: Integer;
  Temp1, Temp2: Integer;
  Flag: Boolean;
begin
  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    Temp2 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[I, J] = 1 then
        inc(Temp1);
      if Mas[J, I] =1 then
        inc(Temp2);
      Inc(J);
      if (Temp1 >= 2) or (Temp2 >= 2) then
      Flag := False;
    End;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[I, J] = 1 then
      Begin
        for Q := 1 to QueensCount do
          for F := 1 to QueensCount do
              if (Mas[Q,F]=1) and (abs(I-Q)=abs(J-F)) then
                inc(Temp1);
        End;
      Inc(J);
      if Temp1 >= 2 then
      Flag := False;
    End;
    if Temp1 >= 2 then
      Flag := False;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

end;
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    Alertoso, можно ли проверку вертикали и горизонтали в одну процедуру сделать?
    procedure TfrmMain.Check;
var
  I, q: Integer;
  J, f: Integer;
  Temp1: Integer;
  Flag: Boolean;
begin
  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[I, J] = 1 then
        inc(Temp1);
      Inc(J);
      if Temp1 >= 2 then
      Flag := False;
    End;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[J, I] = 1 then
        inc(Temp1);
      Inc(J);
      if Temp1 >= 2 then
      Flag := False;
    End;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[I, J] = 1 then
      Begin
        for Q := 1 to QueensCount do
          for F := 1 to QueensCount do
              if (Mas[Q,F]=1) and (abs(I-Q)=abs(J-F)) then
                inc(Temp1);
        End;
      Inc(J);
      if Temp1 >= 2 then
      Flag := False;
    End;
    if Temp1 >= 2 then
      Flag := False;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

end;

    P.S. 
    if (Mas[I, J] = 1) or (Mas[J,I] = 1) then
  inc(Temp1);

    Не пашет(
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    Alertoso, разобрался, всё дело было в этой строчке
    if Mas[I, J] = 1 then
  inc(Temp1);
if Mas[J, I] = 1 then
  inc(Temp1);
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, в консоли проверка по диагонали работает, может с массивом что-то не так(при присваивании 1)?
    procedure TfrmMain.grdChessBoardClick(Sender: TObject);
var
  CellColor: TColor;
begin
  Queens[grdChessBoard.Col, grdChessBoard.Row] := not Queens[grdChessBoard.Col, grdChessBoard.Row];
  with grdChessBoard do
    if Queens[grdChessBoard.Col, grdChessBoard.Row] then
    begin
      if (Col >= 1) and (Row >= 1) then
      Begin
        Mas[Col, Row]:=1;
        if (Col + Row) mod 2 = 0 then
          Canvas.StretchDraw(CellRect(Col, Row), img1.Graphic)
        else
          Canvas.StretchDraw(CellRect(Col, Row), img2.Graphic);
        inc(Temp);
      End;
    end
    else
    begin
      Mas[Col, Row]:=0;
      if ((Col + Row) mod 2) = 0 then
        CellColor := $9ecfff
      else
        CellColor := $478bd1;
      grdChessBoard.Canvas.Brush.Color := CellColor;
      grdChessBoard.Canvas.FillRect(CellRect(Col, Row));
      dec(Temp);
    end;
    if Temp = QueensCount then
    Begin
      grdChessBoard.Enabled := False;
      Check;
    End;
end;

procedure TfrmMain.Check;
var
  I, q: Integer;
  J, f: Integer;
  Temp1: Integer;
  Flag: Boolean;
begin
  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while J <= QueensCount do
    Begin
      if Mas[I, J] = 1 then
        inc(Temp1);
      if Mas[J, I] = 1 then
        inc(Temp1);
      Inc(J);
    End;
    if Temp1 >= 2 then
      Flag := False;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

  I := 1;
  Flag := True;
  while (I <= QueensCount) and Flag do
  Begin
    J := 1;
    Temp1 := 0;
    while (J <= QueensCount) and Flag do
    Begin
      if Mas[I, J] = 1 then
      Begin
        for Q := 1 to QueensCount do
          for F := 1 to QueensCount do
              if (Mas[Q,F]=1) and (abs(I-Q)=abs(J-F)) then
                inc(Temp1);
        End;
      Inc(J);
      if Temp1 >= 2 then
      Flag := False;
    End;
    if Temp1 >= 2 then
      Flag := False;
    Inc(I);
  End;
  if not Flag then
  Begin
    frmMain.Hide;
    Form1.Show;
  End;

end;
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, а как проще всего реализовать проверку на есть ли по диагонали ферзь или нет?
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, да, всё вышло, осталось допилить ограничения по определённому количеству ферзей и вывести в конце сообщение, вышло правильно или нет(это с подсказками), ну и ещё подумать, спасибо, буду думать!
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, ну я про то, что не получится сделать так, когда нажал, сразу же получил ферзя на то место?
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, я правильно понимаю, что ферзи будут выводиться все вместе, а не поочерёдно?
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, реализовал как планировал(немного со временем действительно есть момент):
    procedure TfrmMain.grdChessBoardClick(Sender: TObject);
var
  img1, img2: TPicture;
  i, j: Integer;
begin
    img1:= TPicture.Create;
    img1.LoadFromFile('D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Ферзь 1.bmp');
    img2:= TPicture.Create;
    img2.LoadFromFile('D:\Работы по ОАиП\Курсовая работа\Формы(без стека)\Ферзь 2.bmp');
    with grdChessBoard do
      if (grdChessBoard.Col+grdChessBoard.Row) mod 2 = 0 then
        Canvas.StretchDraw(CellRect(grdChessBoard.Col, grdChessBoard.Row), img1.Graphic)
      else
        Canvas.StretchDraw(CellRect(grdChessBoard.Col, grdChessBoard.Row), img2.Graphic);
    inc(q);
    Temp1[q]:=grdChessBoard.Col;
    Temp2[q]:=grdChessBoard.Row;
    for I := 1 to q do with grdChessBoard do
      if (Temp1[i]+Temp2[i]) mod 2 = 0 then
        Canvas.StretchDraw(CellRect(Temp1[i], Temp2[i]), img1.Graphic)
      else
        Canvas.StretchDraw(CellRect(Temp1[i], Temp2[i]), img2.Graphic);
     if q-1 = QueensCount then grdChessBoard.Enabled := False;
end;

    Может всё-таки есть лучше способ?
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, да уж, fasm совсем мне мозги запудрил), тогда другой вопрос: при событии OnClick происходит перемещение ферзя в другую клетку, как и надо, но при этом происходит удаление предыдущей позиции/ферзя, можно ли это как-то обойти? Есть идея с вспомогательной структурой данных, но можно ли как-то лучше это обойти?
    P.S. Насчёт времени прорисовки не знаю, возможно, с моей идей и не выйдет даже
    Написано

  • Как можно оптимизировать код?

    @Alertoso Автор вопроса
    kalapanga, проверил, файлы именно там, прилагаю папку с проектом(на RadioGroup2 не стоит обращать внимания, я потом хочу сделать с подсказами или без)
    https://drive.google.com/drive/folders/1BGD_NOdB08...
    Если про глобалку, то я сделал, но там что-то ошибка...
    Написано