2014-02-24 20:18:30 +01:00
// *****************************************************************
// 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 uOCVIOProperties;
interface
Uses
System. Classes,
DesignEditors,
2014-05-11 02:42:34 +02:00
DesignIntf,
uOCVImageOperation;
2014-02-24 20:18:30 +01:00
Type
2014-05-11 02:42:34 +02:00
TImageOperationProperty = class( TComponentProperty)
private
FInstance: TPersistent;
protected
function GetInstance: TPersistent; virtual ;
2014-02-24 20:18:30 +01:00
public
function GetAttributes: TPropertyAttributes; override ;
function GetValue: string ; override ;
2014-05-11 02:42:34 +02:00
procedure GetProperties( Proc: TGetPropProc) ; override ;
2014-02-24 20:18:30 +01:00
procedure GetValues( Proc: TGetStrProc) ; override ;
procedure SetValue( const Value: string ) ; override ;
2014-05-11 02:42:34 +02:00
procedure Initialize; override ;
property Instance: TPersistent read GetInstance;
2014-02-24 20:18:30 +01:00
end ;
2014-05-11 02:42:34 +02:00
TImageOperationCollectionItemProperty = class( TClassProperty)
2014-05-07 13:14:32 +02:00
public
function GetAttributes: TPropertyAttributes; override ;
function GetValue: string ; override ;
procedure GetValues( Proc: TGetStrProc) ; override ;
procedure SetValue( const Value: string ) ; override ;
end ;
2014-02-24 20:18:30 +01:00
2014-05-11 02:42:34 +02:00
TImagePreprocessingProperty = class( TImageOperationCollectionItemProperty)
public
// function GetAttributes: TPropertyAttributes; override;
// function GetValue: string; override;
procedure GetValues( Proc: TGetStrProc) ; override ;
// procedure SetValue(const Value: string); override;
end ;
TocvIOPropertyChangeEvent = procedure( Sender: TObject; const PropName: string ) of object ;
TocvCustomImageOperationProperty = class( TocvCustomImageOperation)
private
FUpdateCount: Integer ;
FOnChanging: TNotifyEvent;
FOnChanged: TNotifyEvent;
FOnChangingProperty: TocvIOPropertyChangeEvent;
FOnChangedProperty: TocvIOPropertyChangeEvent;
protected
procedure Changed; virtual ;
procedure Changing; virtual ;
procedure ChangedProperty( const PropName: string ) ; virtual ;
procedure ChangingProperty( const PropName: string ) ; virtual ;
procedure SetUpdateState( Updating: Boolean ) ; virtual ;
property UpdateCount: Integer read FUpdateCount;
public
procedure BeginUpdate; virtual ;
procedure EndUpdate; virtual ;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
property OnChangedProperty: TocvIOPropertyChangeEvent read FOnChangedProperty write FOnChangedProperty;
property OnChangingProperty: TocvIOPropertyChangeEvent read FOnChangingProperty write FOnChangingProperty;
end ;
2014-02-24 20:18:30 +01:00
implementation
Uses
System. SysUtils,
System. TypInfo,
System. RTLConsts,
uOCVTypes;
2014-05-06 21:13:57 +02:00
{TImageOperationProperty}
2014-02-24 20:18:30 +01:00
function TImageOperationProperty. GetAttributes: TPropertyAttributes;
begin
Result : = inherited GetAttributes;
2014-05-11 02:42:34 +02:00
Result : = Result - [ paReadOnly] + [ paValueList, paSortList, paRevertable, paSubProperties, paVolatileSubProperties] ;
2014-02-24 20:18:30 +01:00
end ;
function TImageOperationProperty. GetValue: string ;
begin
Result : = GetRegisteredImageOperations. GetNameByClass( TocvImageOperation( GetOrdValue) . ClassType) ;
end ;
procedure TImageOperationProperty. GetValues( Proc: TGetStrProc) ;
var
2014-05-06 21:13:57 +02:00
I: Integer ;
2014-02-24 20:18:30 +01:00
rIO: TRegisteredImageOperations;
begin
rIO : = GetRegisteredImageOperations;
2014-05-06 21:13:57 +02:00
for I : = 0 to rIO. Count - 1 do
Proc( rIO[ I] ) ;
2014-02-24 20:18:30 +01:00
end ;
procedure TImageOperationProperty. SetValue( const Value: string ) ;
Var
APropertiesClass: TocvImageOperationClass;
2014-05-07 13:14:32 +02:00
I: Integer ;
2014-02-24 20:18:30 +01:00
AIntf: IocvEditorPropertiesContainer;
begin
2014-05-06 21:13:57 +02:00
APropertiesClass : = GetRegisteredImageOperations. FindByName( Value) ;
2014-02-24 20:18:30 +01:00
if APropertiesClass = nil then
APropertiesClass : = TocvImageOperationClass( GetRegisteredImageOperations. Objects[ 0 ] ) ;
2014-05-06 21:13:57 +02:00
2014-05-07 13:14:32 +02:00
for I : = 0 to PropCount - 1 do
if Supports( GetComponent( I) , IocvEditorPropertiesContainer, AIntf) then
2014-02-24 20:18:30 +01:00
AIntf. SetPropertiesClass( APropertiesClass) ;
2014-05-06 21:13:57 +02:00
Modified;
2014-02-24 20:18:30 +01:00
end ;
2014-05-07 13:14:32 +02:00
{TImagePreprocessingProperty}
2014-05-11 02:42:34 +02:00
//function TImagePreprocessingProperty.GetAttributes: TPropertyAttributes;
//begin
// Result := inherited GetAttributes;
// Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paSubProperties];
//end;
//function TImagePreprocessingProperty.GetValue: string;
//begin
// Result := GetRegisteredImageOperations.GetNameByClass(TocvImageOperation(GetOrdValue).ClassType);
//end;
procedure TImagePreprocessingProperty. GetValues( Proc: TGetStrProc) ;
begin
Proc( 'None' ) ;
Proc( 'Threshold' ) ;
Proc( 'AdaptiveThreshold' ) ;
end ;
//procedure TImagePreprocessingProperty.SetValue(const Value: string);
//Var
// APropertiesClass: TocvImageOperationClass;
// I: Integer;
// AIntf: IocvEditorPropertiesContainer;
//begin
// APropertiesClass := GetRegisteredImageOperations.FindByName(Value);
// if APropertiesClass = nil then
// APropertiesClass := TocvImageOperationClass(GetRegisteredImageOperations.Objects[0]);
//
// for I := 0 to PropCount - 1 do
// if Supports(GetComponent(I), IocvEditorPropertiesContainer, AIntf) then
// AIntf.SetPropertiesClass(APropertiesClass);
//
// Modified;
//end;
{TocvCustomImageOperationProperty}
procedure TocvCustomImageOperationProperty. BeginUpdate;
begin
if FUpdateCount = 0 then
SetUpdateState( True ) ;
Inc( FUpdateCount) ;
end ;
procedure TocvCustomImageOperationProperty. Changed;
begin
if ( FUpdateCount = 0 ) and Assigned( FOnChanged) then
FOnChanged( Self) ;
end ;
procedure TocvCustomImageOperationProperty. ChangedProperty( const PropName: string ) ;
begin
if Assigned( FOnChangedProperty) then
FOnChangedProperty( Self, PropName) ;
end ;
procedure TocvCustomImageOperationProperty. Changing;
begin
if ( FUpdateCount = 0 ) and Assigned( FOnChanging) then
FOnChanging( Self) ;
end ;
procedure TocvCustomImageOperationProperty. ChangingProperty( const PropName: string ) ;
begin
if Assigned( FOnChangingProperty) then
FOnChangingProperty( Self, PropName) ;
end ;
procedure TocvCustomImageOperationProperty. EndUpdate;
begin
Dec( FUpdateCount) ;
if FUpdateCount = 0 then
SetUpdateState( False ) ;
end ;
procedure TocvCustomImageOperationProperty. SetUpdateState( Updating: Boolean ) ;
begin
if Updating then
Changing
else
Changed;
end ;
function TImageOperationProperty. GetInstance: TPersistent;
var
LInstance: TPersistent;
LPersistentPropertyName: string ;
begin
if not Assigned( FInstance) then
begin
LInstance : = GetComponent( 0 ) ;
LPersistentPropertyName : = GetName;
if IsPublishedProp( LInstance, LPersistentPropertyName) then
begin
FInstance : = TPersistent( GetObjectProp( LInstance, LPersistentPropertyName) ) ;
end ;
end ;
Result : = FInstance;
end ;
procedure TImageOperationProperty. GetProperties( Proc: TGetPropProc) ;
begin
inherited ;
end ;
procedure TImageOperationProperty. Initialize;
var
LInstance: TPersistent;
LPersistentPropertyName: string ;
begin
inherited Initialize;
LInstance : = Instance;
LPersistentPropertyName : = GetName;
if LInstance is TComponent then
begin
if ( TComponent( LInstance) . Name = '' ) and ( TComponent( LInstance) . Name < > LPersistentPropertyName) then
begin
TComponent( LInstance) . Name : = LPersistentPropertyName;
end ;
end
else if LInstance is TocvCustomImageOperation then
begin
if ( TocvCustomImageOperation( LInstance) . Name = '' ) and ( TocvCustomImageOperation( LInstance) . Name < > LPersistentPropertyName)
then
begin
TocvCustomImageOperation( LInstance) . Name : = LPersistentPropertyName;
end ;
end
// else
// if LInstance is TocvImageOperationCollectionItem then
// begin
// if (TocvImageOperationCollectionItem(LInstance).DisplayName = '') and (TocvImageOperationCollectionItem(LInstance).DisplayName <> LPersistentPropertyName)
// then
// begin
// TocvImageOperationCollectionItem(LInstance).DisplayName := LPersistentPropertyName;
// end;
// end;
end ;
{TImageOperationCollectionItemProperty}
function TImageOperationCollectionItemProperty. GetAttributes: TPropertyAttributes;
2014-05-07 13:14:32 +02:00
begin
Result : = inherited GetAttributes;
Result : = Result - [ paReadOnly] + [ paValueList, paSortList, paRevertable, paVolatileSubProperties] ;
end ;
2014-05-11 02:42:34 +02:00
function TImageOperationCollectionItemProperty. GetValue: string ;
2014-05-07 13:14:32 +02:00
begin
Result : = GetRegisteredImageOperations. GetNameByClass( TocvImageOperation( GetOrdValue) . ClassType) ;
end ;
2014-05-11 02:42:34 +02:00
procedure TImageOperationCollectionItemProperty. GetValues( Proc: TGetStrProc) ;
var
I: Integer ;
rIO: TRegisteredImageOperations;
2014-05-07 13:14:32 +02:00
begin
2014-05-11 02:42:34 +02:00
rIO : = GetRegisteredImageOperations;
for I : = 0 to rIO. Count - 1 do
Proc( rIO[ I] ) ;
2014-05-07 13:14:32 +02:00
end ;
2014-05-11 02:42:34 +02:00
procedure TImageOperationCollectionItemProperty. SetValue( const Value: string ) ;
2014-05-07 13:14:32 +02:00
Var
APropertiesClass: TocvImageOperationClass;
I: Integer ;
AIntf: IocvEditorPropertiesContainer;
begin
APropertiesClass : = GetRegisteredImageOperations. FindByName( Value) ;
if APropertiesClass = nil then
APropertiesClass : = TocvImageOperationClass( GetRegisteredImageOperations. Objects[ 0 ] ) ;
2014-02-24 20:18:30 +01:00
2014-05-07 13:14:32 +02:00
for I : = 0 to PropCount - 1 do
if Supports( GetComponent( I) , IocvEditorPropertiesContainer, AIntf) then
AIntf. SetPropertiesClass( APropertiesClass) ;
Modified;
end ;
initialization
2014-02-24 20:18:30 +01:00
2014-05-06 21:13:57 +02:00
RegisterPropertyEditor( TypeInfo( TocvCustomImageOperation) , TocvImageOperation, 'Operation' , TImageOperationProperty) ;
2014-05-11 02:42:34 +02:00
RegisterPropertyEditor( TypeInfo( TocvCustomImageOperation) , TocvImageOperationCollectionItem, 'Operation' , TImageOperationCollectionItemProperty) ;
//RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperationCollectionItem, 'Operation',TImageOperationProperty);
2014-05-07 13:14:32 +02:00
RegisterPropertyEditor( TypeInfo( TocvCustomImageOperation) , TocvContoursOperation, 'Preprocessing' , TImagePreprocessingProperty) ;
2014-05-11 02:42:34 +02:00
UnlistPublishedProperty( TocvCustomImageOperation, 'Name' ) ;
2014-05-06 21:13:57 +02:00
UnlistPublishedProperty( TocvImageOperation, 'OperationClassName' ) ;
UnlistPublishedProperty( TocvImageOperationCollectionItem, 'OperationClassName' ) ;
2014-05-07 13:14:32 +02:00
UnlistPublishedProperty( TocvContoursOperation, 'OperationClassName' ) ;
2014-02-24 20:18:30 +01:00
end .