Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Зависание программы [D7, WinXP]


Pattern ©   (2006-12-06 23:17:00) 

Пишу программу для GSM модема, в которой предполагается его работа по определённого вида скрипту:
INITPORT COM12
SEND 'ATE0'
WAITMULTI 'OK|ERROR', 1000
IF 1 InitGSM

Данные строки обрабатываю через TRegExp. Вопрос заключается в том, что на данном этапе я всего лишь решил проверить правильность чтения команд из скрипта и столкнулся с такой проблемой, что основное и дополнительные окна программы при выполнении исходного скрипта зависают (то есть я не могу его ни сдвинуть с места, ни отправить в трей, ни свернуть). Предполагается циклическое выполнение скрипта. В программе имеются 2 окна: главное mainFrm и дополнительное frmSriptEditor (редактор скрипта). Данные читаются из компоненты TMemo дополнительного окна.
Помогите разобраться с данной проблемой. В дополнение стоит наверное написать, что на событии TMemo.OnChange установлена процедура TMemo.Update, ибо иначе текущие считанные строки не отображаются.
procedure TmainFrm.actMRunExecute(Sender: TObject);
var
 a: Integer;
 DateOut, TimeOut : TDateTime;
 DateTimeOut : string;
begin
 if actMWizzard.Checked then
 begin
   if frmSriptEditor.spfMemo.Lines.Count>0 then
     for a:=0 to frmSriptEditor.spfMemo.Lines.Count-1 do
     begin
       DateOut:=Date;
       TimeOut:=Time;
       DateTimeOut:=DateToStr(DateOut)+' '+TimeToStr(TimeOut)+' ';
       case AnsiIndexStr(AutoScript(frmSriptEditor.spfMemo.Lines[a]),
         ['initlog','initport','closeport','delay','goto','if','send','wait','waitmulti', 'label','comment','']) of
         0: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         1: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         2: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         3: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         4: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         5: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         6: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         7: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         8: mainMemo.Lines.Add(DateTimeOut+'<-- '+frmSriptEditor.spfMemo.Lines[a]);
         9: mainMemo.Lines.Add(DateTimeOut+'<-- LABEL: '+frmSriptEditor.spfMemo.Lines[a]);
         10:
           begin
             with mainMemo.Lines do
             begin
               Add(DateTimeOut+'/*');
               Add(DateTimeOut+frmSriptEditor.spfMemo.Lines[a]);
               Add(DateTimeOut+'*/');
             end;
           end;
         11: Continue;
       end;
       with frmSriptEditor.spfMemo do
       begin
         CurX:=0;
         CurY:=a;
         Update
       end;
     end
   else
     ShowMessage('Скрипт не имеет данных');
 end;
end;

function TmainFrm.AutoScript(CurString: String): String;
const
 RExLabel = '^\[{1}';
 RExComment = '^;{1}';
 RExWord = '^[A-Z]+';
var
 REx: TRegExpr;
begin
 Result:='';
 REx:=TRegExpr.Create;
 try
   REx.Expression:=RExLabel;
   if REx.Exec(CurString) then
     Result:='label';
   if Result='' then
   begin
     REx.Expression:=RExComment;
     if REx.Exec(CurString) then
       Result:='comment';
   end;
   if Result='' then
   begin
     REx.Expression:=RExWord;
     if REx.Exec(CurString) then
       Result:=LowerCase(REx.Match[0]);
   end;
 finally
   REx.Free;
 end;
end;


Pattern   (2006-12-08 12:39:00) [1]

Огромное спасибо за помощь! Разобрался.


Сергей М.   (2006-12-08 09:52:00) [2]

procedure SetCaretPosition(Memo: TMemo; x,y: integer);
var i:integer;
begin
 i := sendmessage(memo.handle, em_lineindex, y, 0) + x;
 sendmessage(memo.handle, em_setsel, i, i);
end;

..
    for a:=0 to frmSriptEditor.spfMemo.Lines.Count-1 do
   begin
     .....
     SetCaretPosition(frmSriptEditor.spfMemo.Handle, 0, a);
     Application.ProcessMessages;
   end


Pattern   (2006-12-07 14:55:00) [3]

Огромное спасибо Сергей М.! Действительно Application.ProcessMessages; вывело программу из зависания. По поводу оптимизации кода, то она не требуется. При определении какой либо из команд, будет выполняться своя функция (например, 1 - initport - будет выполнена попытка подключения к COM порту, 3 - delay - будет установлена задержка перед выполнением очередной команды и т.д.). А на данном этапе это просто проверка, что всё верно определяется.
Меня инетересует вот ещё какой вопрос. В своём примере ты не указал следующий код, который был приведён в моём примере       with frmSriptEditor.spfMemo do
      begin
        CurX:=0;
        CurY:=a;
        Update
      end;
Этот у чтасток в дополнительном окне frmSriptEditor курсор в Memo перемещает в текущую строку, которая считывается в данный момент. Если этот код не указывать, естественно ничего не происходит. А если его оставлять, программа начинает более "натужно работать", когда видны оба окна (главное и дополнительное) и в то же время когда окно frmSriptEditor невидимо, этот код вообще является лишним. Может есть к этому то же какой то оптимальный подход?
Ещё раз спасибо за помощь!


Сергей М.   (2006-12-07 08:45:00) [4]

procedure TmainFrm.actMRunExecute(Sender: TObject);
var
DateTimeOut : string;
begin
if actMWizzard.Checked then
begin
  if frmSriptEditor.spfMemo.Lines.Count>0 then
    with mainMemo.Lines do
    for a:=0 to frmSriptEditor.spfMemo.Lines.Count-1 do
    begin
      DateTimeOut:=DateTimeToStr(Now)+' ';
      case AnsiIndexStr(AutoScript(frmSriptEditor.spfMemo.Lines[a]),
        ['initlog','initport','closeport','delay','goto','if','send','wait','waitmulti',  'label','comment','']) of
        0..8: Add(DateTimeOut+'


Наверх

Титульная страница Поиск, карта сайта Написать письмо