pan

Вы неожиданно собрали в череп мой взорванный мозг! Была похожая ситуация, когда я явно задаю размер Image.Bitmap.SetSize, рисую с таким же RectF и вижу на экране левую верхнюю четверть изображения. C TImageControl было всё в порядке. В итоге для задания размера создал TBitmap и сделал Image.Bitmap.Assign Вообще то эмбра утверждает, что TImage нужно использовать для рисования на контроле, а если это просто картинка на форме, то TImageControl. Если ещё нужны функции редактирования юзером, то TImageViewer. TImageControl содержит TImage с WrapMode=Fit, только не даёт к нему доступа. Я в погоне за быстродействием хотел готовить картинку с размером, совпадающим с размером на экране, чтобы исключить масштабирование, но не понял как поймать размер экрана внутри "дурацкой белой рамки". Но всё равно рисование на TImageControl.Bitmap приводит к тому, что он переносит картинку в TImageControl.Image.Bitmap, если я правильно понимаю, а это уже не про быстродействие. В случае как у автора ветки, я думаю стоило рисовать прямо на Image.Bitmap, а если переносить целиком с совпадающими размерами, то Assign.

В ряде случаев достаточно PermissionsService.IsPermissionGranted Тут разжёвывают как правильно организовать запросы прав

Была задача сохранять надписи с приборов, т.е. сохраняется центральная часть фото, причём для прицеливания на экран выводится тоже только часть изображения с камеры, соответствующая видимой части экрана. Начитавшись форумов о тормозах, решил что CameraComponent.Quality:=TVideoCaptureQuality.LowQuality это мой вариант, но в процессе отладки заметил, что если в одной процедуре деактивировать CameraComponent и через пару действий снова активировать, тормоза пропадают и на MediumQuality. Потанцевал с бубном в этом направлении и получил несколько правил для комфортной работы CameraComponent: 1. Включение камеры нужно выполнять, когда закончилась подготовка экрана. Если например включается страница TabControl, на которую выводим изображение с камеры, то в этой процедуре нельзя включать камеру, нужно перенести это действие в Application.OnIdle: Application.OnIdle:=CameraActivate; //CameraComponent.Active:=true; procedure TFormApp.CameraActivate(Sender: TObject; var Done: Boolean); begin Done:=true; Application.OnIdle:=nil; CameraComponent.Active:=true; end; 2. Если включен автофокус CameraComponent.FocusMode:=TFocusMode.ContinuousAutoFocus;, после включения камере надо дать время потупить (пропустить несколько CameraComponentSampleBufferReady): procedure TFormApp.CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); begin TThread.Synchronize(TThread.CurrentThread, CameraComponentSampleBufferReadySync); end; procedure TFormApp.CameraComponentSampleBufferReadySync; begin if CameraActivateStep>0 then CameraActivateStep:=CameraActivateStep-1 else begin CameraComponent.SampleBufferToBitmap(CameraBitmapFull,true); with ImagePositionImg.Bitmap.Canvas do if BeginScene then try DrawBitmap(CameraBitmapFull,RectScreenOnCamera,RectScreenOnScreen,1,true); DrawRect(RectAimOnScreen,1); finally EndScene; end; end; end; Я до конца так и не понял, нужен ли этот Synchronize, в примере эмбры на паскале он был а на си нет... 3. Если камера затупила во время работы, нужно сделать перезапуск в одной процедуре: CameraComponent.Active:=false; CameraComponent.Active:=true; Вдруг кому поможет... Это была Delphi 11.3

Ну если тут ещё кто-то бродит... Тоже нужно было сделать изображение чёрно-белым для пересылки в Base64. Вот так получилось: procedure TForm1.ButtonStopClick(Sender: TObject); var SendData:TBitmapSurface; SizeX,SizeY,i,j:integer; Bmp:TBitMapData; begin CameraComponent1.Active:=false; SendData:=TBitmapSurface.Create; SizeX:=0; SizeY:=0; if BmpCut.Map(TMapAccess.Read,Bmp) then begin SizeX:=Bmp.Width; SizeY:=Bmp.Height; SendData.SetSize(SizeX,SizeY,TPixelFormat.L); for j:=0 to SizeY-1 do for i:=0 to SizeX-1 do SendData.Pixels[i,j]:=Bmp.GetPixel(i,j); BmpCut.Unmap(Bmp); end; Label2.Text:=IntToStr(SizeX)+'X'+IntToStr(SizeY)+'X'+IntToStr(SendData.BytesPerPixel); Image1.Bitmap.Assign(SendData); BmpCut.Free; SendData.Free; end; Label2.Text показал 1 байт на пиксель, в Image1 было чёрно-белое фото. Собственно отсылки тут нет. Только не нужно хранить в невидимом TImage, храните в TBitmapSurface.