Kameradan gelen görüntüyü ekrana boyama

[codder71]

Merhaba arkadaşlar 

Bir projemde kameradan gelen görüntüyü telefon ekranına yansıtmaya çalışıyorum. Direk gelen görüntüyü Rectangle vcl nesnesine bitmap yönteminden yüklüyorum ama tahmin edeceğiniz gibi çok verimli olmuyor. Bunu daha verimli bir şekilde nesneye nasıl yazabilirim. Bazı sitelerde telefonun gpu sunu kullanarak yapılan yöntemler gördüm fakat kullanırken hata oluşuyor. Fakat kullanırken devamlı hata alıyorum. Bu konuda yardımlarınızı bekliyorum. İyi çalışmalar dilerim.

[mrmarman]

Video çözünürlüğü düşürdüğünüzde verim artar.

CameraOnSampleBufferReady olayında resmi alıyorsunuz, buna uygun bir thread yapı kurmak kafi.

[codder71]

(12-07-2020, Saat: 15:31)mrmarman Adlı Kullanıcıdan Alıntı: Video çözünürlüğü düşürdüğünüzde verim artar.

CameraOnSampleBufferReady olayında resmi alıyorsunuz, buna uygun bir thread yapı kurmak kafi.

Hocam öncelikle cevabınız için yine teşekkür ediyorum. Thread yapı ile yapmak istiyorum fakat vcl threadın çökmesine sebep oluyor. İçeride Synchronize ettiğimde de threadin bir anlamı kalmıyor. Bende bunun için acaba telefon gpusu kullanılarak yapılan bir yöntem var mı diye siz hocalarımıza sormak istedim.
Hocam altta paylaştığım şekilde bir yapı buldum ama kullanamadım. Devamlı hata veriyor.


     

procedure TMyObject.onPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);

 function _drawBitmap(const aBitmap: {$IFDEF _USE_TEXTURE}TTexture{$ELSE}Tbitmap{$ENDIF}; const aTopLeft: TpointF; Const aOpacity: Single): boolean;
 var aDestRect: TrectF;
 begin
   Result := False;
   if aBitmap <> nil then begin

     //calculate aDestRect
     aDestRect := canvas.AlignToPixel(
                    TRectF.Create(
                       aTopLeft,
                       aBitmap.Width/ScreenScale,
                       aBitmap.Height/ScreenScale));

     //if the aBitmap is visible
     if ARect.IntersectsWith(aDestRect) then begin

       Result := True;

       {$IFDEF _USE_TEXTURE}
       TCustomCanvasGpu(Canvas).DrawTexture(aDestRect, // ATexRect
                                            TRectF.Create(0,
                                                          0,
                                                          aBitmap.Width,
                                                          aBitmap.Height), // ARect
                                            ALPrepareColor(TCustomCanvasGpu.ModulateColor, aOpacity * AbsoluteOpacity), // https://quality.embarcadero.com/browse/RSP-15432
                                            aBitmap);
       {$ELSE}
       Canvas.DrawBitmap(aBitmap, // ABitmap
                         TRectF.Create(0,
                                       0,
                                       aBitmap.Width,
                                       aBitmap.Height), // SrcRect
                         aDestRect, // DstRect
                         aOpacity * AbsoluteOpacity, // AOpacity
                         samevalue(aDestRect.Width, aBitmap.Width, Tepsilon.Position) and
                         samevalue(aDestRect.height, aBitmap.height, Tepsilon.Position)); // HighSpeed - set interpolation to none
       {$ENDIF};

     end;

   end;
 end;

begin

 _drawBitmap(aBitmap, aPos, 1);

end; 

[mrmarman]

Aldığınız description ekran kopyasından yola çıkarak quality Embarcadero hesabınız varsa bu linki bir incelemek isteyebilirsiniz.

[codder71]

(12-07-2020, Saat: 21:11)mrmarman Adlı Kullanıcıdan Alıntı: Aldığınız description ekran kopyasından yola çıkarak quality Embarcadero hesabınız varsa bu linki bir incelemek isteyebilirsiniz.

Hocam aynı şifre ile girilebiliyorsa dosyaları indirip test edeceğim.

[gbg]

(12-07-2020, Saat: 14:58)codder71 Adlı Kullanıcıdan Alıntı: Merhaba arkadaşlar

Bir projemde kameradan gelen görüntüyü telefon ekranına yansıtmaya çalışıyorum. Direk gelen görüntüyü Rectangle vcl nesnesine bitmap yönteminden yüklüyorum ama tahmin edeceğiniz gibi çok verimli olmuyor. Bunu daha verimli bir şekilde nesneye nasıl yazabilirim. Bazı sitelerde telefonun gpu sunu kullanarak yapılan yöntemler gördüm fakat kullanırken hata oluşuyor. Fakat kullanırken devamlı hata alıyorum. Bu konuda yardımlarınızı bekliyorum. İyi çalışmalar dilerim.

You can use this code for show camera pic on FMX TImage
put TImage (rename to imgPerson) on form and use code:

Kod: (Select All)

procedure TfrmCustomer.SampleBufferReady (Sender: TObject;
  const ATime: TMediaTime);
begin
 try
  TThread.Synchronize (TThread.CurrentThread, SampleBufferSync);
  // Resize the image so that the video is buffered in its original size
  //ımage1.width:=ımage1.bitmap.width;
  //ımage1.height:=ımage1.bitmap.height;
 except on E: Exception do
  ShowMessage ('Webcam BufferReady error:' + E.Message);
 end;
end;

procedure TfrmCustomer.SampleBufferSync;
begin
 try
  VideoCamera.SampleBufferToBitmap (imgPerson.Bitmap, false);
 except on E: Exception do
  ShowMessage ('Webcam BufferSync error:' + E.Message);
 end;
end;

[mrmarman]

@gbg

This is the regular and usual method that you gave. @codder71 says this is not fast enought. So that he is looking forward a new method for SampleBufferToBitmap work more effective.

Alıntı:@ "Gbg"

Bu, verdiğiniz kurallı ve olağan yöntemdir. @ "codder71" bunun yeterince hızlı olmadığını söylüyor. Dolayısıyla SampleBufferToBitmap için daha etkili yeni bir yöntem aramaktadır.

[codder71]

(12-07-2020, Saat: 21:11)mrmarman Adlı Kullanıcıdan Alıntı: Aldığınız description ekran kopyasından yola çıkarak quality Embarcadero hesabınız varsa bu linki bir incelemek isteyebilirsiniz.

Merhabalar hocam 

Örneği denemek istediğimde setting kısmında bir hata alıyorum. Acaba sebebi ne olabilir?

[cinarbil]

Telefon veya emulatörün kameralarına erişim izniniz var mı ?
Kamera listesinin boş olduğu anlamına geliyor diye zannediyorum.

[mrmarman]

Şöyle bir durum söz konusu.

Hızlandırıcı unsur olarak kullanılan kaynak Delphi'nin daha önceki sürümleri olduğundan ilgili property/functin/procedure zamanla dildeki gelişmeler ile orantılı değişim gösterebiliyor. 

"GetAvailableCaptureSettings" şeklinde bir geliştirme yapıldı.  Böyle deneyin.

Takıldığınız yerde nokta dahil sonrasını silin ve tekrar nokta işareti koyun. Size en yakın sonuçlar önerilecektir.


Ben kendi projelerimde geleneksel takılmıştım.

    for i := 0 to High(CameraComponent.AvailableCaptureSettings) do
    begin
        Size := TSize.Create(CameraComponent.AvailableCaptureSettings[i].Width, CameraComponent.AvailableCaptureSettings[i].Height);

        if (UsefulSettings.TryGetValue(Size, MaxSetting)) then
        begin
          if ( CameraComponent.AvailableCaptureSettings[i].FrameRate > MaxSetting.FrameRate) then
            UsefulSettings.AddOrSetValue(Size, CameraComponent.AvailableCaptureSettings[i] );
        end
        else
          UsefulSettings.Add(Size, CameraComponent.AvailableCaptureSettings[i] );
    end;

Şeklindeki yapı, gördüğünüz ARRAY tipi yapının muadilidir.