mirror of
https://github.com/Laex/Delphi-OpenCV.git
synced 2024-11-16 00:05:52 +01:00
302 lines
8.8 KiB
ObjectPascal
302 lines
8.8 KiB
ObjectPascal
// ****************************************************************
|
|
// Delphi-OpenCV Demo
|
|
// Copyright (C) 2013 Project Delphi-OpenCV
|
|
// ****************************************************************
|
|
// Contributor:
|
|
// Laentir Valetov
|
|
// email:laex@bk.ru
|
|
// ****************************************************************
|
|
// You may retrieve the latest version of this file at the GitHub,
|
|
// located at git://github.com/Laex/Delphi-OpenCV.git
|
|
// ****************************************************************
|
|
// The contents of this file are used with permission, subject to
|
|
// the Mozilla Public License Version 1.1 (the "License"); you may
|
|
// not use this file except in compliance with the License. You may
|
|
// obtain a copy of the License at
|
|
// http://www.mozilla.org/MPL/MPL-1_1Final.html
|
|
//
|
|
// Software distributed under the License is distributed on an
|
|
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
|
// implied. See the License for the specific language governing
|
|
// rights and limitations under the License.
|
|
// ****************************************************************
|
|
unit ocv.comp.ViewFMX;
|
|
|
|
{$I OpenCV.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,
|
|
System.Types,
|
|
FMX.Types,
|
|
{$IFDEF VER20P} // Delphi XE6 and above
|
|
FMX.Graphics,
|
|
{$ELSE}
|
|
FMX.PixelFormats,
|
|
{$ENDIF}
|
|
FMX.Controls,
|
|
ocv.comp.Types;
|
|
|
|
{$IFNDEF VER20P}
|
|
|
|
// Delphi XE5 and below
|
|
const
|
|
PixelFormatBytes: array [TPixelFormat] of Integer = ( { pfUnknown } 0, { pfA16B16G16R16 } 8, { pfA2R10G10B10 } 4, { pfA2B10G10R10 } 4,
|
|
{ pfA8R8G8B8 } 4,
|
|
{ pfX8R8G8B8 } 4, { pfA8B8G8R8 } 4, { pfX8B8G8R8 } 4, { pfR5G6B5 } 2, { pfA4R4G4B4 } 2, { pfA1R5G5B5 } 2, { pfX1R5G5B5 } 2,
|
|
{ pfG16R16 } 4,
|
|
{ pfA8L8 } 2, { pfA4L4 } 1, { pfL16 } 2, { pfL8 } 1, { pfR16F } 2, { pfG16R16F } 4, { pfA16B16G16R16F } 8, { pfR32F } 4,
|
|
{ pfG32R32F } 8, { pfA32B32G32R32F } 16,
|
|
{ pfA8 } 1, { pfV8U8 } 2, { pfL6V5U5 } 2, { pfX8L8V8U8 } 4, { pfQ8W8V8U8 } 4, { pfV16U16 } 4, { pfA2W10V10U10 } 4, { pfU8Y8_V8Y8 } 4,
|
|
{ pfR8G8_B8G8 } 4, { pfY8U8_Y8V8 } 4,
|
|
{ pfG8R8_G8B8 } 4, { pfQ16W16V16U16 } 8, { pfCxV8U8 } 2, { pfDXT1 } 8, { pfDXT2 } 16, { pfDXT3 } 16, { pfDXT4 } 16, { pfDXT5 } 16,
|
|
{ pfA32B32G32R32 } 16, { pfB10G11R11F } 4);
|
|
{$ENDIF}
|
|
|
|
type
|
|
{$IFNDEF VER20P} // Delphi XE5 and below
|
|
TBitmapHack = class helper for TBitmap
|
|
public
|
|
procedure SetPixelFormat(Value: TPixelFormat);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
TocvViewFMX = class(TControl, IocvDataReceiver)
|
|
private
|
|
FStretch: Boolean;
|
|
FocvVideoSource: IocvDataSource;
|
|
FCenter: Boolean;
|
|
FProportional: Boolean;
|
|
FImage: IocvImage;
|
|
FOnAfterPaint: TOnOcvAfterViewPaint;
|
|
FOnBeforePaint: TOnOcvNotify;
|
|
procedure SetOpenCVVideoSource(const Value: IocvDataSource);
|
|
function isSourceEnabled: Boolean;
|
|
function PaintRect: TRectF;
|
|
protected
|
|
BackBuffer: TBitmap;
|
|
procedure Paint; override;
|
|
procedure TakeImage(const IplImage: IocvImage);
|
|
procedure SetVideoSource(const Value: TObject);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DrawImage(const IplImage: IocvImage);
|
|
published
|
|
property VideoSource: IocvDataSource Read FocvVideoSource write SetOpenCVVideoSource;
|
|
property Proportional: Boolean read FProportional write FProportional default false;
|
|
property Stretch: Boolean read FStretch write FStretch default True;
|
|
property Center: Boolean read FCenter write FCenter default false;
|
|
property Left;
|
|
property Top;
|
|
property Width;
|
|
property Height;
|
|
property Align;
|
|
property OnAfterPaint: TOnOcvAfterViewPaint read FOnAfterPaint write FOnAfterPaint;
|
|
property OnBeforePaint: TOnOcvNotify read FOnBeforePaint write FOnBeforePaint;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseUp;
|
|
property OnMouseMove;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseWheel;
|
|
property HitTest;
|
|
property PopupMenu;
|
|
property TabOrder;
|
|
property Visible;
|
|
{$IF CompilerVersion<21.0}
|
|
property DesignVisible;
|
|
{$ENDIF}
|
|
property Opacity;
|
|
property Margins;
|
|
property Padding;
|
|
property Position;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.UITypes;
|
|
|
|
{$IFNDEF VER20P}
|
|
|
|
// Delphi XE5 and below
|
|
procedure TBitmapHack.SetPixelFormat(Value: TPixelFormat);
|
|
begin
|
|
Self.FPixelFormat := Value;
|
|
end;
|
|
{$ENDIF}
|
|
{ TocvVewFMX }
|
|
|
|
constructor TocvViewFMX.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
{$IFDEF VER21P}
|
|
BackBuffer := TBitmap.Create;
|
|
{$ELSEIF VER20P} // Delphi XE6 and above
|
|
BackBuffer := TBitmap.Create;
|
|
BackBuffer.PixelFormat := TPixelFormat.RGB;
|
|
{$ELSE} // Delphi XE5 and below
|
|
BackBuffer := TBitmap.Create(0, 0);
|
|
BackBuffer.SetPixelFormat(TPixelFormat.pfX8R8G8B8);
|
|
{$ENDIF}
|
|
Stretch := True;
|
|
Proportional := false;
|
|
Center := false;
|
|
end;
|
|
|
|
destructor TocvViewFMX.Destroy;
|
|
begin
|
|
BackBuffer.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TocvViewFMX.DrawImage(const IplImage: IocvImage);
|
|
begin
|
|
FImage := IplImage;
|
|
Repaint;
|
|
end;
|
|
|
|
function TocvViewFMX.isSourceEnabled: Boolean;
|
|
begin
|
|
Result := (Assigned(VideoSource) and (VideoSource.Enabled)) or Assigned(FImage);
|
|
end;
|
|
|
|
procedure TocvViewFMX.Paint;
|
|
var
|
|
M: TBitmapData;
|
|
i: Integer;
|
|
SrcData, DestData: pByte;
|
|
nC: Integer;
|
|
begin
|
|
if (csDesigning in ComponentState) then
|
|
begin
|
|
Canvas.Stroke.Thickness := 1;
|
|
Canvas.Stroke.Kind := TBrushKind.bkSolid;
|
|
Canvas.Stroke.Color := TAlphaColorRec.Black;
|
|
Canvas.DrawRect(RectF(0, 0, Width, Height), 0, 0, AllCorners, 1);
|
|
end
|
|
else if (not isSourceEnabled) or (not Assigned(FImage)) then
|
|
inherited
|
|
else
|
|
begin
|
|
if Assigned(OnBeforePaint) then
|
|
OnBeforePaint(Self, FImage);
|
|
|
|
BackBuffer.Canvas.BeginScene;
|
|
if (BackBuffer.Width <> FImage.Width) or (BackBuffer.Height <> FImage.Height) then
|
|
BackBuffer.SetSize(FImage.Width, FImage.Height);
|
|
if BackBuffer.Map(TMapAccess.maWrite, M) then
|
|
try
|
|
SrcData := pByte(FImage.IpImage^.imageData);
|
|
DestData := pByte(M.Data);
|
|
nC := FImage.IpImage^.nChannels;
|
|
for i := 0 to M.Width * M.Height - 1 do
|
|
begin
|
|
DestData[i * PixelFormatBytes[BackBuffer.PixelFormat] + 0] := SrcData[i * nC + 0];
|
|
DestData[i * PixelFormatBytes[BackBuffer.PixelFormat] + 1] := SrcData[i * nC + 1];
|
|
DestData[i * PixelFormatBytes[BackBuffer.PixelFormat] + 2] := SrcData[i * nC + 2];
|
|
DestData[i * PixelFormatBytes[BackBuffer.PixelFormat] + 3] := $FF;
|
|
end;
|
|
finally
|
|
BackBuffer.Unmap(M);
|
|
end;
|
|
BackBuffer.Canvas.EndScene;
|
|
Canvas.DrawBitmap(BackBuffer, RectF(0, 0, BackBuffer.Width, BackBuffer.Height), PaintRect, 1, True);
|
|
|
|
// Canvas.Stroke.Thickness := 1;
|
|
// Canvas.Stroke.Kind := TBrushKind.bkSolid;
|
|
// Canvas.Stroke.Color := TAlphaColorRec.Black;
|
|
// Canvas.DrawRect(RectF(0, 0, Width, Height), 0, 0, AllCorners, 1);
|
|
|
|
if Assigned(OnAfterPaint) then
|
|
OnAfterPaint(Self, FImage);
|
|
|
|
end;
|
|
end;
|
|
|
|
function TocvViewFMX.PaintRect: TRectF;
|
|
var
|
|
ViewWidth, ViewHeight, CliWidth, CliHeight: Integer;
|
|
AspectRatio: Double;
|
|
begin
|
|
ViewWidth := FImage.IpImage^.Width;
|
|
ViewHeight := FImage.IpImage^.Height;
|
|
CliWidth := Trunc(Width);
|
|
CliHeight := Trunc(Height);
|
|
if (Proportional and ((ViewWidth > CliWidth) or (ViewHeight > CliHeight))) or Stretch then
|
|
begin
|
|
if Proportional and (ViewWidth > 0) and (ViewHeight > 0) then
|
|
begin
|
|
AspectRatio := ViewWidth / ViewHeight;
|
|
if ViewWidth > ViewHeight then
|
|
begin
|
|
ViewWidth := CliWidth;
|
|
ViewHeight := Trunc(CliWidth / AspectRatio);
|
|
if ViewHeight > CliHeight then
|
|
begin
|
|
ViewHeight := CliHeight;
|
|
ViewWidth := Trunc(CliHeight * AspectRatio);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
ViewHeight := CliHeight;
|
|
ViewWidth := Trunc(CliHeight * AspectRatio);
|
|
if ViewWidth > CliWidth then
|
|
begin
|
|
ViewWidth := CliWidth;
|
|
ViewHeight := Trunc(CliWidth / AspectRatio);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
ViewWidth := CliWidth;
|
|
ViewHeight := CliHeight;
|
|
end;
|
|
end;
|
|
|
|
With Result do
|
|
begin
|
|
Left := 0;
|
|
Top := 0;
|
|
Right := ViewWidth;
|
|
Bottom := ViewHeight;
|
|
end;
|
|
|
|
if Center then
|
|
OffsetRect(Result, (CliWidth - ViewWidth) div 2, (CliHeight - ViewHeight) div 2);
|
|
end;
|
|
|
|
procedure TocvViewFMX.SetOpenCVVideoSource(const Value: IocvDataSource);
|
|
begin
|
|
if FocvVideoSource <> Value then
|
|
begin
|
|
if Assigned(FocvVideoSource) then
|
|
FocvVideoSource.RemoveReceiver(Self);
|
|
FocvVideoSource := Value;
|
|
if Assigned(FocvVideoSource) then
|
|
FocvVideoSource.AddReceiver(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TocvViewFMX.SetVideoSource(const Value: TObject);
|
|
begin
|
|
VideoSource := Value as TocvDataSource;
|
|
end;
|
|
|
|
procedure TocvViewFMX.TakeImage(const IplImage: IocvImage);
|
|
begin
|
|
if not(csDestroying in ComponentState) then
|
|
DrawImage(IplImage);
|
|
end;
|
|
|
|
end.
|