VPF::Не работает программа - Форум программистов

Aleksey1987

Дата 26.6.2013, 00:39 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 9.3.2013

Репутация: нет
Всего: нет

Есть программа клиент сервер для передачи кадров с вебки по сети. В принципе работает изумительно. Исходники полностью скинуть не могу, только в личку. В общем суть проблемы.

Клиент

Код


procedure TForm1.TCPClient1Connected(Sender: TObject);
var
    FileName, SizeFile, InCom, recv: string;
    MemStream: TMemoryStream;
    bm : TBitMap;
begin
    while TCPClient1.Connected do
        begin
{**********************************************************************************}
            if StartedVideo = False then // если видео не стартовало
                begin
                    TCPClient1.WriteLn('start'); // отправляем серверу команду start
                    TCPClient1.WriteInteger(CurrentCam); // отправляем серверу id камеры
                    recv := TCPClient1.Readln; // читаем ответ сервера
                    if recv = 'OK' then // если камера с этим id доступна
                        begin
                            StartedVideo := True; // начинаем принимать кадры
                        end
                    else// if recv = 'Cam not support' then
                        begin
                            StartedVideo := False;
                            TCPClient1.Disconnect;
                            Exit;
                        end;
                end;
{**********************************************************************************}
            TCPClient1.WriteLn(SIZE);
            TCPClient1.WriteInteger(QUALITY);
            TCPClient1.WriteInteger(FLIP);
            TCPClient1.WriteInteger(SHARP);
            InCom := TCPClient1.Readln;
            if InCom = 'videostream sending' then
                begin
                    FileName := TCPClient1.Readln;
                    SizeFile := TCPClient1.Readln;
                    MemStream := TMemoryStream.Create;
                    TCPClient1.ReadStream(MemStream, StrToInt(SizeFile));
                    try
                        MemStream.SaveToFile('.\temp\' + FileName);
                        Form2.Image1.Picture.LoadFromFile('.\temp\' + FileName);
                    except
                    end;
                    MemStream.Free;
                    //Form2.Caption := FileName;
                    //Application.ProcessMessages;
                end
            else if InCom = 'bye' then
                    begin
                        TCPClient1.Disconnect;
                    end;
        end;
end;

Сервер

Код


function TForm1.StartVideo(Cam : Integer) : Boolean;
    begin
        try
            begin
                Form1.FilterGraph.ClearGraph;
                Form1.FilterGraph.Active := false;
                Form1.Filter.BaseFilter.Moniker := SysDev.GetMoniker(Cam);
                Form1.FilterGraph.Active := true;
                with Form1.FilterGraph as ICaptureGraphBuilder2 do
                    CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW , nil, Form1.Filter as IBaseFilter, nil, Form1.VideoWindow as IbaseFilter));
                Form1.FilterGraph.Play;
                CamOK := True;
                Result := True;
            end;
        except
            begin
                CamOK := False;
                Result := False;
            end;
        end;
    end;


procedure TForm1.TCPServer1Execute(AThread: TIdPeerThread);
    var
        MemStream : TMemoryStream;
        bmp, sbmp : Tbitmap;
        FileName, size : String;
        SizeFile, w, h, flip, quality, sharp, temp : integer;
        jpg : TJpegImage;
    begin
        jpg := TJpegImage.Create;
        bmp := TBitmap.Create;
        MemStream := TMemoryStream.Create;
        FileName := TCPServer1.LocalName+'.jpg';

        if AThread.Connection.ReadLn = 'start' then // если получена команда start
            begin
                if VideoStarted = False then
                    begin
                        temp := AThread.Connection.ReadInteger; // читаем id камеры
                        if StartVideo(temp) = True then // если камера доступна
                            begin
                                VideoStarted := True;
                                AThread.Connection.Writeln('OK'); // отвечаем ОК
                            end
                        else
                            begin
                                AThread.Connection.Writeln('Cam not support'); // иначе отвечаем не ОК
                            end;
                    end;
             end;
        if CamOK = True then
            SampleGrabber1.GetBitmap(bmp) // если доступна, то отправляем кадр
        else
            bmp.LoadFromResourceName(HInstance, 'BITMAP1'); // если нет, то отправляем картинку с перечеркнутой вебкой


        size := AThread.Connection.ReadLn;

        quality := AThread.Connection.ReadInteger;
        w := StrToInt(Copy(size,1,3));
        h := StrToInt(Copy(size,5,3));


        sbmp:=Tbitmap.create;
        sbmp.width:=w;
        sbmp.Height:=h;
        sbmp.pixelFormat:=pf24bit;
        SetStretchBltMode(sbmp.canvas.handle,4);
        StretchBlt(sbmp.canvas.handle,0,0,w,h,bmp.canvas.handle,
               0,0,bmp.width,bmp.height,SRCCOPY);

        flip := AThread.Connection.ReadInteger;
        sharp := AThread.Connection.ReadInteger;

        Image1.Picture.Assign(sbmp);

        if sharp <> 0 then
            BmpSharp(Image1.Picture.Bitmap, sharp);

        if flip > 0 then
            begin
                Mirror(Image1.Picture, flip);

                jpg.Assign(Image1.Picture.Bitmap);
                jpg.CompressionQuality := quality;
                jpg.PixelFormat := jf24Bit;
            end
        else if flip = 0 then
            begin
                jpg.Assign(Image1.Picture.Bitmap);
                jpg.CompressionQuality := quality;
                jpg.PixelFormat := jf24Bit;
            end;


        jpg.Compress;
        jpg.SaveToStream(MemStream);

        SizeFile:=MemStream.Size;
        MemStream.Position:=0;
        AThread.Connection.Writeln('videostream sending');
        AThread.Connection.Writeln(FileName);
        AThread.Connection.Writeln(IntToStr(SizeFile));
        AThread.Connection.OpenWriteBuffer;
        AThread.Connection.WriteStream(MemStream);
        AThread.Connection.CloseWriteBuffer;
        MemStream.Free;
        bmp.Free;
        sbmp.Free;
        jpg.Free;
        Form1.Caption := FileName+' (' + IntToStr(SizeFile) + ' bytes)';
    end;

Так вот суть проблемы. Какой бы id я не отправил с клиента всегда приходит ответ Cam no support. Обе камеры доступны сто пудов. Я добавил на сервере две кнопки и щелчком вызываю StartVideo(0) и StartVideo(1). Все работает. Предполагаю, что ошибка в том месте, где сервер проверяет if StartVideo(temp) = True then // если камера доступна . Такое ощущение, что он не ждет ответа от функции, а продолжает работать дальше.

Я уже башку всю сломал. Помогите, пожалуйста.

MetalFan

Дата 26.6.2013, 12:17 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

Цитата(Aleksey1987 @ 26.6.2013, 00:39

)

Какой бы id я не отправил с клиента всегда приходит ответ Cam no support. Обе камеры доступны сто пудов. Я добавил на сервере две кнопки и щелчком вызываю StartVideo(0) и StartVideo(1). Все работает.

Логично предположить, что приходит какой-то "неправильный" id-шник камеры)

--------------------

There are always someone smarter than you...

Aleksey1987

Дата 26.6.2013, 19:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 9.3.2013

Репутация: нет
Всего: нет

Щас проверил с помощью ShowMessage(IntToStr(CurrentCam)); Все id верные. Пичалька...

MetalFan

Дата 27.6.2013, 11:42 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

А, кстати, а учитвается ли то, что TCPServer1Execute выполняется в отдельном (не главном) потоке приложения?
Возможно в потоке и не отрабатывает правильно код из StartVideo

--------------------

There are always someone smarter than you...

Aleksey1987

Дата 27.6.2013, 17:59 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 14
Регистрация: 9.3.2013

Репутация: нет
Всего: нет

Я это знаю, что в отдельном потоке. Но вот как это побороть не в курсе. Можно ли как-то паузу организовать?

MetalFan

Дата 28.6.2013, 09:49 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

Aleksey1987, какую паузу?! код из потока пытается работать с компонентами на форме. От этого, скорее всего, и грабли.
Или делай код в StartVideo потокобезопасным, или вызывай его через Synchronize

--------------------

There are always someone smarter than you...

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »