+- Delphi Can (https://www.delphican.com)
+-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Mobil Platform - FireMonkey (FMX) (https://www.delphican.com/forumdisplay.php?fid=7)
+--- Konu Başlığı: Kameradan gelen görüntüyü ekrana boyama (/showthread.php?tid=5083)
Sayfalar:
1
2
Kameradan gelen görüntüyü ekrana boyama - codder71 - 12-07-2020
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.
Kameradan gelen görüntüyü ekrana boyama - mrmarman - 12-07-2020
Video çözünürlüğü düşürdüğünüzde verim artar.
CameraOnSampleBufferReady olayında resmi alıyorsunuz, buna uygun bir thread yapı kurmak kafi.
Cvp: Kameradan gelen görüntüyü ekrana boyama - codder71 - 12-07-2020
(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;
Kameradan gelen görüntüyü ekrana boyama - mrmarman - 12-07-2020
Aldığınız description ekran kopyasından yola çıkarak quality Embarcadero hesabınız varsa bu linki bir incelemek isteyebilirsiniz.
Cvp: Kameradan gelen görüntüyü ekrana boyama - codder71 - 14-07-2020
(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.
Cvp: Kameradan gelen görüntüyü ekrana boyama - gbg - 15-07-2020
(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:
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;Kameradan gelen görüntüyü ekrana boyama - mrmarman - 15-07-2020
@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.
Cvp: Kameradan gelen görüntüyü ekrana boyama - codder71 - 15-07-2020
(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?
Cvp: Kameradan gelen görüntüyü ekrana boyama - cinarbil - 15-07-2020
Telefon veya emulatörün kameralarına erişim izniniz var mı ?
Kamera listesinin boş olduğu anlamına geliyor diye zannediyorum.
Kameradan gelen görüntüyü ekrana boyama - mrmarman - 15-07-2020
Şö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.
