Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для мобильных телефонов > MidletPascal > Основной форум

Основной форум Сюда все проблемы связанные с программированием.

Ответ
 
Опции темы
Старый 05.02.2013, 21:32   #1
9ik
Оператор ЭВМ
 
Регистрация: 19.10.2010
Сообщений: 22
Написано одно полезное сообщение
не пропадают кнопки

Если зайти в меню, выбрать "Сегодня", потом нажать "Назад", потом опять выбрать "Сегодня", то кнопки "Назад" и "Выход" добавляются еще раз и компануются в меню очистка формы почему-то не работает. Возможные проблемные места помечены красным
program BSUIRaspisanie;
uses resloader;
uses parse;

var
  form, i, time: integer;

  //***************************************

function NumberOfWeek: char; //функция вычисления дня недели
const
  START1213 = 1346011201;
  END1213 = 1372622401;
  START1314 = 1377460801;
  END1314 = 1404158401;
  START1415 = 1409515201;
  END1415 = 1435694401;

begin

  if (time > START1213) and (time < END1213) then
    NumberOfWeek := getChar(integerToString((((time - START1213) / 604800) mod
      4) + 1), 0);
  else
    if (time > START1314) and (time < END1314) then
      NumberOfWeek := getChar(integerToString((((time - START1314) / 604800) mod
        4) +
        1), 0);
  else
    if (time > START1415) and (time < END1314) then
      NumberOfWeek := getChar(integerToString((((time - START1415) / 604800) mod
        4) +
        1), 0)
    else
    begin
      showAlert('Ошибка!',
        'Невозможно прочитать время',
        loadImage('/error.png'),
        ALERT_ERROR);
      Delay(3000);
      halt;
    end;
end;

//*******************************************

procedure ReadToScreen(NameOfFile: string; day: integer);
//процедура вывода на экран и самого меню
var
  s, temp: string;
  week: char;
  res: resource;
  step,num: integer;
begin
  ShowCanvas;
  setFont(FONT_FACE_MONOSPACE,FONT_STYLE_BOLD,FONT_SIZE_LARGE);

  drawImage(loadImage('/font.png'),0,0);
  day := day + getWeekDay(time) - 2;
  week := NumberOfWeek;
  
  if (getWeekDay(time) - 2 = -1) or (getWeekDay(time) - 2 = 6) then
    if ord(week) < 52 then
      week:=chr(ord(week)+1);
    else
      week:='1';

  res := OpenResource(NameOfFile);
  num:=0;
  if resourceAvailable(res) = true then
  begin
    if (day <> -1) and (day <> 6) then
    begin
      temp := ReadLinesBlock(NameOfFile, day, 1, 1);
      parse.line(temp, "/");
      i := 2;
      while (i<parse.len) do
      begin
      if (getChar(parse.get(i), 0) = 'a') or (week = getChar(parse.get(i), 0)) or (week = getChar(parse.get(i), 1)) then num:=num+2;
      i:=i+3;
      end;
      i:=2;
      step:=(getHeight-(num*(getStringHeight(parse.get(1))+15)-15)) div 2;
      drawText(integerToString(step),0,0);
      while (i < parse.len) do
      begin
        if (getChar(parse.get(i), 0) = 'a') or (week =
          getChar(parse.get(i), 0)) or (week = getChar(parse.get(i), 1)) then
          begin
          setColor(255,0,0);
          drawText(parse.get(i - 2),60,step);
          step:=step+15;
          drawText(parse.get(i - 1),60,step);
          repaint;
          step:=step+15;
          end;
        i := i + 3;
      end
    end;
  else
  begin
    setColor(255,0,0);
    drawText(integerTostring(getWidth),60,25);
    repaint;
  end;

  CloseResource(res);
end
else
  begin
    showAlert('Ошибка!',
      'Ошибка чтения или файл не найден',
      loadImage('/error.png'),
      ALERT_ERROR);
    Delay(3000);
    halt;
  end;

end;

procedure StartScreen; //процедура начального экрана
var
  pShow, pExit, choiceGroupID, today, tomorrow: integer;
  NextCmd, BackCmd, ExitCmd, clicked: command;
begin
  showMenu('Raspisanie', CH_IMPLICIT);
  pShow := menuAppendString('Показать');
  pExit := menuAppendString('Выход');

  NextCmd := createCommand('ДАЛЕЕ', CM_OK, 1);
  addCommand(NextCmd);

  while (getClickedCommand <> NextCmd) do
    Delay(100);

  if menuGetSelectedIndex = pShow then
  begin //ChoiceScreen
    clearForm;
    setFormTitle('Сейчас ' + NumberOfWeek + ' неделя');
    choiceGroupID := formAddChoice('На какой день?', CH_EXCLUSIVE);
    today := choiceAppendString(choiceGroupID, 'Сегодня');
    tomorrow := choiceAppendString(choiceGroupID, 'Завтра');

    BackCmd := createCommand('РќРђР—РђР”', CM_BACK, 1);
    addCommand(BackCmd);
    addCommand(NextCmd);
    ExitCmd := createCommand('ВЫХОД', CM_EXIT, 1);

    repeat
      clicked := getClickedCommand;
      delay(100);
    until (clicked <> emptyCommand);
    if clicked = BackCmd then
    StartScreen;
    if clicked = NextCmd then
    begin
      if choiceIsSelected(choiceGroupID, tomorrow) then ReadToScreen('140102.txt', 1)
      else
        if choiceIsSelected(choiceGroupID, today) then ReadToScreen('140102.txt', 0);

      FormRemove(choiceGroupID);
      addCommand(ExitCmd);
      addCommand(BackCmd);
      repeat
        clicked := getClickedCommand;
        delay(100);
      until (clicked <> emptyCommand);
      clearForm;
      if clicked = BackCmd then StartScreen;
      if clicked = ExitCmd then halt;
    end;
end;

if menuGetSelectedIndex = pExit then
  halt;

end;

begin
  time := getCurrentTime;
  drawImage(loadImage('/startscreen.png'),0,0);
  repaint;
  delay(3000);
  StartScreen;
end.
BSUIRaspisanie.rar
(Offline)
 
Ответить с цитированием
Старый 28.02.2013, 04:06   #2
Вова
AnyKey`щик
 
Регистрация: 19.02.2013
Сообщений: 17
Написано 2 полезных сообщений
(для 2 пользователей)
Ответ: не пропадают кнопки

Мне кажется надо добавить процедуры RemoveCommand(ExitCmd) и RemoveCommand(BackCmd), чтобы стирать эти кнопки до того как заново их создавать. У меня в программе тоже был этот баг. Мне помогло. Тебе не знаю , потому что компе не могу даже нормально скомпилировать - куча ошибок. Пробуй
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 14:02.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com