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

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

В событии 2я процедура начинается раньше чем заканчивается 1я! [D7, WinXP]


Страницы:   1 2 3

RoLeX ©   (2006-10-24 15:43:00) 

Итак, предположим событие Button1Click. Между begin и end расположены две процедуры/функции:
procedure TForm1.Button1Click(Sender: TObject);
begin
procedure1;
procedure2;
end;

Так вот, у меня 2я процедура начинается раньше чем первая! Из-за этого ошибка. 1я процедура относительно продолжительная (делает скриншот экрана и сжимает его, а потом сохраняет файл).

Вот моя ситуация:
procedure GetScreenImage(AWidth, AHeight,AQuality: Integer);
var JPEG: TJPEGImage; bmp, tmpBitmap: TBitmap;
begin
JPEG:=TJPEGImage.Create;
Bmp:=TBitmap.Create;
tmpBitmap:=TBitmap.Create;
try
tmpBitmap.Width := AWidth;
tmpBitmap.Height := AHeight;
bmp.Width:=Screen.Width;
bmp.Height:=Screen.Height;
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,GetDC(GetDesktopWindow), 0, 0, SRCCopy);
SetStretchBltMode(tmpBitmap.Canvas.Handle, STRETCH_HALFTONE);
StretchBlt(tmpBitmap.Canvas.Handle, 0, 0, AWidth, AHeight,bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, tmpBitmap.Canvas.CopyMode);
bmp.Assign(tmpBitmap);
JPEG.Assign(bmp);
JPEG.CompressionQuality:=AQuality;
jpeg.Compress;
JPEG.SaveToFile(ch+'\screen.jpg');
finally
JPEG.Free;
bmp.Free;
tmpBitmap.Free;
end;
end;

1-я процдура:GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

2-я процдура:
   with TFileStream.Create(ch+'\screen.jpg', fmOpenRead) do
   try
   file_size := Size;
   AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
   read_total := 0;
   while (read_total <> file_size) do
   begin
     read_current := Read(buf, 1024);
     AThread.Connection.WriteBuffer(buf, read_current);
     Inc(read_total, read_current);
   end;
   finally
     Free;
   end;

RoLeX   (2006-10-24 18:10:00) [21]

ой... не так :)
Вот:

var stop:boolean;
А если сделать так:
1-я процедура:
stop:=false;
DeleteFile(ch+'screen.jpg');
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

repeat
2-я процдура:
if Fileexist(ch+'screen.jpg') then
begin
 stop:=true;
 with TFileStream.Create(ch+'\screen.jpg', fmOpenRead) do
 try
 file_size := Size;
 AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
 read_total := 0;
 while (read_total <> file_size) do
 begin
   read_current := Read(buf, 1024);
   AThread.Connection.WriteBuffer(buf, read_current);
   Inc(read_total, read_current);
 end;
 finally
   Free;
 end;
end;
until stop=true;

Что скажите?

RoLeX   (2006-10-24 18:07:00) [22]

var stop:boolean;
А если сделать так:
1-я процедура:
stop:=false;
DeleteFile(ch+'screen.jpg');
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

repeat
2-я процдура:
if Fileexist(ch+'screen.jpg') then stop:=true;
  with TFileStream.Create(ch+'\screen.jpg', fmOpenRead) do
  try
  file_size := Size;
  AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
  read_total := 0;
  while (read_total <> file_size) do
  begin
    read_current := Read(buf, 1024);
    AThread.Connection.WriteBuffer(buf, read_current);
    Inc(read_total, read_current);
  end;
  finally
    Free;
  end;
until stop=true;

Что скажите?

RoLeX   (2006-10-24 17:21:00) [23]

А что все затихли?
Я вот подумал, а если сделать в процедуре GetScreenImage(); в конце удаление файла screen.jpg, а потом нужно как-то подождать когда появится файл screen.jpg и как только он появился, выполнять оставшийся код ( with TFileStream.Create(ch+'\screen.jpg', fmOpenRead) do...)

RoLeX   (2006-10-24 17:07:00) [24]

Если быстро посылать эти запросы, то клиент виснет и потом не оживает.
Смотрим до куда дошла прога, и видим что после запроса файл screen.jpg на машине сервера не обновился.
А если убарть строку
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));
то как часто не нажимай на кнопку Button1 на клиенте, всё работает ОК.

Сергей М.   (2006-10-24 16:59:00) [25]


> RoLeX   (24.10.06 16:53) [17]


Чудесно.

И какая конкретно строка в этом коде приводит к "ошибке" ?

RoLeX   (2006-10-24 16:53:00) [26]

Сервер:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var sCommand, sAction,s:string;
   plist:TStrings;
   i:integer;

 file_size, read_total: Int64;
 buf: array [0..1024 - 1] of Byte;
 read_current: Integer;
begin

try
s:=uppercase(AThread.Connection.ReadLn);
sCommand:=copy(s,1,3);
sAction:=copy(s,5,length(s));
plist:=TStringList.Create;        
if (sCommand = 'SСR') then
   begin
   plist.Clear; plist.AddStrings(GetList(sAction));
   GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

   with TFileStream.Create(ch+'\screen.jpg', fmOpenRead) do
   try
   file_size := Size;
   AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
   read_total := 0;
   while (read_total <> file_size) do
   begin
     read_current := Read(buf, 1024);
     AThread.Connection.WriteBuffer(buf, read_current);
     Inc(read_total, read_current);
   end;
   finally
     Free;
   end;

   AThread.Connection.Disconnect;
   End
except
end;
end;


Клиент:

procedure TForm1.Button1Click(Sender: TObject);
var plist:TStrings;
 buf: array [0..1024 - 1] of Byte;
 file_size, read_current: Int64;
 read_total: Integer;
begin
 plist:=TStringList.Create;
 plist.Clear;
 plist.Insert(0,'SСR:');
 plist.Insert(1,'250');
 plist.Insert(2,'200');
 plist.Insert(3,IntToStr(TrackBar1.Position));
 try
     if IdTCPClient1.connected then IdTCPClient1.DisConnect;
     IdTCPClient1.Host:=Edit1.Text;
     IdTCPClient1.Port:=StrToInt(Edit3.text);
     IdTCPClient1.Connect;
     IdTCPClient1.WriteLn(GiveString(plist));
     if Form1.IdTCPClient1.Socket.Recv(file_size, SizeOf(Int64)) = SizeOf(Int64) then
     begin
     read_total := 0;
     with TFileStream.Create('C:\screen.jpg', fmCreate) do
     try
       while (read_total <> file_size)  do
       begin
         read_current := Form1.IdTCPClient1.Socket.Recv(buf, 1024);
         Write(buf, read_current);
         Inc(read_total, read_current);
       end;
     finally
       Free;
     end;
     end;
     IdTCPClient1.Disconnect;
    if FileExists('C:\screen.jpg') then
     begin
     Image2.Picture.Graphic := nil;
     Image2.Picture.LoadFromFile('C:\screen.jpg');
     if Image2.Picture.Graphic is TJPEGImage then TJPEGImage(Image2.Picture.Graphic).Performance := jpBestSpeed;
     DeleteFile('C:\screen.jpg');
     end;

 except
 end;
end;

Anatoly Podgoretsky   (2006-10-24 16:52:00) [27]


> Нет)) Ну так что делать то?

Если нет, то ничего не надо делать, поскольку нет предмета.

novill   (2006-10-24 16:47:00) [28]

> [11] Anatoly Podgoretsky ©   (24.10.06 16:40)
Сдал...

Сергей М.   (2006-10-24 16:45:00) [29]


> Нет)


Что "нет" ?

В прятки играть будем или РЕАЛЬНЫЙ код приведешь наконец-то ?

RoLeX   (2006-10-24 16:44:00) [30]

Нет)) Ну так что делать то?

Сергей М.   (2006-10-24 16:43:00) [31]


> RoLeX   (24.10.06 16:38) [10]



> Ну так что?


Что-что..

Плохой из тебя кибальчиш, вот что) ... раскололся на первом же буржуинском допросе)

Впрочем это уже не важно.

Ты по-прежнему продолжаешь утверждать, что при заведомо последовательном вызове тобой в контексте одного и того же потока процедур №1 и №2 последняя процедура исполняется раньше вызова первой ?

Anatoly Podgoretsky   (2006-10-24 16:40:00) [32]

Опа уже появились потоки, может тогда появятся и критические секции!

RoLeX   (2006-10-24 16:38:00) [33]

У меня событие на самом деле не Button1Click, а IdTCPServer1Execute. Ну так что?

Elen   (2006-10-24 16:37:00) [34]


> RoLeX



> иногда выскакивает ошибка

Текст ошибки - ...

> когда часто совершаю событие

Как часто. Может вторая процедура предидущего события еще не закончила работу, как началась первая нового события...

Сергей М.   (2006-10-24 16:35:00) [35]


> RoLeX   (24.10.06 16:22) [6]
>
>


Откуда у тебя в обработчике некоего события формы взялся AThread ?
Горбатого ты нам тут лепишь) ...

novill   (2006-10-24 16:27:00) [36]

не факт, но пока копать больше негде.

RoLeX   (2006-10-24 16:22:00) [37]


> novill ©   (24.10.06 16:18) [5]
> А что ты там AThread мутишь? Это не тот который TThread?
>

AThread: TIdPeerThread

(Это из события IdTCPServer1Execute). Хотите сказать что у меня в новом потоке вторая процедура, поэтому такое и получается?

novill   (2006-10-24 16:18:00) [38]

А что ты там AThread мутишь? Это не тот который TThread?

Anatoly Podgoretsky   (2006-10-24 16:13:00) [39]

Процедуры выполняются строго последовательно и пока первая не закончит работу, ни о какой второй говорить не приходится. Все остальное фантастика.

Сергей М.   (2006-10-24 16:11:00) [40]


> RoLeX   (24.10.06 16:07) [2]
>
> Что значит вру, если у меня иногда выскакивает ошибка


Железная логика - "если у меня иногда что-то там куда-то там выскакивает, то я прав в утверждении, что 2-я процедура 'начинается' раньше 1-ой".

Страницы:   1 2 3

Наверх

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