Erro ao utilizar componente gráfico herdado de outro componente (TORImage)

18/11/2019

0

Estou tentando criar um componente gráfico herdado de outro componente para tratamento de imagens, mas quando vou utilizar para abrir a imagem, dá um erro de exceção. Quando roda a procedure "ProcessImage" dá um erro o abrir: " Picture.Bitmap.LoadFromFile(FFilename);". É a primeira vez que eu tento criar um componente, agradeço qualquer ajuda!

Esse é código:

unit ClearCaptcha;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, ExtCtrls, DateUtils, OrImage;

type
TClearCaptcha = class(TORImage)
private
FImage : TOrImage;
FFileName : String;
FGrayScale, FInvert, FEmboss, FMonochrome : Boolean;
FSplitlight : Byte;
FBrightness, FContrast, FSaturation, FDarkness, FLightness,
FColorNoise, FMonoNoise, FPosterize, FSolorize, FMosaic,
FSplitBlur, FTrace, FGaussianBlur, FTile : Integer;
FAntiAlias : Byte;
procedure SetFileName(const Value: String);
procedure SetMonochrome(const Value: Boolean);
property GrayScale: Boolean read FGrayscale;
property Invert: Boolean read FInvert;
property Emboss: Boolean read FEmboss;
property Splitlight: Byte read FSplitLight;
property Brightness: Integer read FBrightness;
property Contrast: Integer read FContrast ;
property Saturation: Integer read FSaturation;
property Darkness: Integer read FDarkness;
property Lightness: Integer read FLightness;
property ColorNoise: Integer read FColorNoise;
property MonoNoise: Integer read FMonoNoise;
property Posterize: Integer read FPosterize;
property Solorize: Integer read FSolorize;
property Mosaic: Integer read FMosaic;
property SplitBlur: Integer read FSplitBlur;
property Trace: Integer read FTrace;
property GaussianBlur: Integer read FGaussianBlur;
property Tile: Integer read FTile;
property AntiAlias: byte read FAntiAlias;
protected
{ Protected declarations }
public
Procedure ProcessImage;
Procedure SetDefaults;

//constructor Create(AOwner : TComponent); override;
// destructor Destroy; override;
published
property FileName: String read FFileName Write SetFileName;
property Monochrome: Boolean read FMonochrome Write SetMonochrome;
{ Published declarations }
end;

type TArea = RECORD
Xi : Word;
Yi : Word;
Xf : Word;
Yf : Word;
end;

var
Area : TArea;
Img : TImage;
FName : String;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MGodoy', [TClearCaptcha]);
end;

{ TClearCaptcha }


procedure AreaRange(const ABitmap : Graphics.TBitmap);
var py, i, j : Byte;
vezes : Byte;
begin
py := 0;
Area.Xi := 2;
Area.Yi := ABitmap.Height;
Area.Xf := ABitmap.Width;
Area.Yf := ABitmap.Height;
vezes := 0;
for i := 0 to ABitmap.Width do // Define Início da Altura Yi
begin
for j := 0 to ABitmap.Height do
begin
if ABitmap.Canvas.Pixels[i, j] = clBlack then
begin
Inc(py);
if (py > 6) and (Area.Yi > j - Pred(py)) then
begin
if Area.Xi = 2 then Area.Xi := i-4;
Area.Yi := j - py;
Inc(vezes);
Break;
end
end else
begin
// Area.Yi := 0;
py := 0;
end;
end; // for j
if vezes = 20 then Break;
end;
With Area do
begin
Yi := Yi - 4;
Xf := Xi + 96;
Yf := Yi + 26;
end;
end;

procedure SnipArea(AImg : TORImage);
begin
Img.Canvas.CopyMode := cmSrcCopy ;
Img.Picture.Bitmap.Width := Round(Abs(Area.Xf-Area.Xi));
Img.Picture.Bitmap.Height := Round(Abs(Area.Yf-Area.Yi));
Img.Canvas.CopyRect(Rect(0,0,Round(Abs(Area.Xf-Area.Xi)),Round(Abs(Area.Yf-Area.Yi))), AImg.Canvas,Rect(Area.Xi, Area.Yi, Area.Xf, Area.Yf));
end;

procedure CombineBitmap(var AImg : TORImage);
var bmSig: Graphics.TBitMap;
begin
try
bmSig := Graphics.TBitmap.Create;
// Set its size to accomodate both on top of each other
bmSig.Assign(Img.Picture.Graphic); // This line changed to Graphic
bmSig.Height:= bmSig.Height+45;
Img.Picture.Assign(nil);
Img.Picture.Bitmap.Canvas.CopyMode:= cmMergeCopy ;
Img.Picture.Bitmap.Width := 150;
Img.Picture.Bitmap.Height := 60;
Img.Picture.Bitmap.Canvas.Draw(0, BmSig.height, AImg.Picture.bitmap);
Img.Picture.Bitmap.Canvas.CopyMode:= cmSrcAnd; //changed here
Img.Picture.Bitmap.Canvas.Draw(15, 12, bmSig);
Img.Picture.Bitmap.PixelFormat := pf1bit; // OCR
finally
bmSig.Free;
end; // try..finally
end;

procedure TClearCaptcha.ProcessImage;
begin
FName := FFilename;
With FImage Do
Begin
Picture.Bitmap.LoadFromFile(FFilename);
PicBrightness := FBrightness;
PicContrast := FContrast;
PicGrayScale := FGrayscale;
PicLightness := FLightness;
PicDarkness := FDarkness;
PicSaturation := FSaturation;
PicSplitlight := FSplitLight;
PicInvert := FInvert;
PicColorNoise := FColorNoise;
PicMonoNoise := FMonoNoise;
PicPosterize := FPosterize;
PicSolorize := FSolorize;
PicEmboss := FEmboss;
PicMosaic := FMosaic;
PicSplitBlur := FSplitBlur;
PicGaussianBlur := FGaussianBlur;
PicAntiAlias := FAntiAlias;
PicTrace := FTrace;
PicTile := FTile;
UpdateEffects;
Picture.Bitmap.Monochrome := FMonochrome;
end;
AreaRange(FImage.Picture.Bitmap);
Try
Img := TImage.Create(self);
SnipArea(FImage);
CombineBitmap(FImage);
FName := Copy(FName, 1, Pos('.', FName)-1) + '_Tratada' + Copy(FName, Pos('.', FName), 4);
Img.Picture.Bitmap.SaveToFile(FName);
Finally
Img.Free;
end;
end;

procedure TClearCaptcha.SetDefaults;
begin
FBrightness := -234;
FContrast := 1015;
FDarkness := 166;
FLightness := -2506;
FSaturation := 0;
FAntiAlias := 1;
FSplitLight := 2;
FGrayscale := true;
FInvert := true;
FMonochrome := true;
FColornoise := 0;
FMononoise := 0;
FPosterize := 0;
FSolorize := 0;
FMosaic := 0;
FSplitBlur := 0;
FGaussianBlur := 0;
FEmboss := false;
FAntiAlias := 1;
FTrace := 0;
FTile := 0;
end;

procedure TClearCaptcha.SetFilename(const Value: String);
begin
FFilename := Value;
end;

procedure TClearCaptcha.SetMonochrome(const Value: Boolean);
begin
FMonochrome := Value;
end;

END.
Marcos Godoy

Marcos Godoy

Responder

Post mais votado

20/11/2019

Olá Marcos !! Tranquilo ??

Bem, para poder lhe ajudar com mais precisão será preciso vc postar o trecho do seu código onde vc tenta usar (instanciar) seu componente... mas se você diz que está recebendo uma exception na linha:

Picture.Bitmap.LoadFromFile(FFilename);


podemos fazer algumas considerações:

1 - Assegure-se que a variável FFilename que é carregada pela procedure setter SetFilename foi devidamente atribuida com um arquivo de imagem válido.
2 - Lendo o código percebi que esta linha tenta atribuir um valor para a propriedade Picture do objeto FImage, veja abaixo:

...
With FImage Do
Begin
Picture.Bitmap.LoadFromFile(FFilename);
PicBrightness := FBrightness;
PicContrast := FContrast;
...


Ocorre que FImage é um objeto da classe TOrImage (componente delphi de terceiros), então resolvi pesquisar esse componente na internet e achei o seguinte site:

http://www.borec.ru/oric/orimage.html

que parece ser a página web de apresentação deste componente... lendo o conteúdo desta página descobri algo interessante que pode ser a razão do seu problema aí... veja:


...
This are TOrImage new or modified propertys and methods:

public

property IsMouseEntering: Boolean; readonly; Set to True if mouse above the component

property Picture: TPicture; readonly; Picture bitmap (TBitmap) after transform (Set automatically from PictureOriginal)

procedure UpdateEffects; Update Picture transform (use if your change property Picture indirectly)
...


Separei um trecho das informações que constam na página e veja o que diz sobre a propriedade Picture !! Ela é readonly e é setada automaticamente de PictureOriginal.

É muito provável que vc esteja recebendo uma exception no seu código por estar tentando atribuir um valor a uma propriedade readonly. Ao invés de tentar atribuir o arquivo de imagem diretamente a propriedade Picture, tente fazer isso a propriedade PictureOriginal.

Leia o conteúdo da página para maiores detalhes...

Qualquer dúvida posta aí... se tiver ao meu alcance ajudo com satisfação.

Espero ter ajudado,
Abraço e bons códigos.

Jorge Pinto

Jorge Pinto
Responder

Mais Posts

21/11/2019

Marcos Godoy

Olá Jorge, tudo bem!?

Agradeço pela ajuda, vai ser muito útil para arrumar o código, acho que até esse final de semana, com a ajuda que vc me passou, eu consigo terminar.

Obrigado!
Responder

04/12/2019

Marcos Godoy

Olá Marcos !! Tranquilo ??

Bem, para poder lhe ajudar com mais precisão será preciso vc postar o trecho do seu código onde vc tenta usar (instanciar) seu componente... mas se você diz que está recebendo uma exception na linha:

Picture.Bitmap.LoadFromFile(FFilename);


podemos fazer algumas considerações:

1 - Assegure-se que a variável FFilename que é carregada pela procedure setter SetFilename foi devidamente atribuida com um arquivo de imagem válido.
2 - Lendo o código percebi que esta linha tenta atribuir um valor para a propriedade Picture do objeto FImage, veja abaixo:

...
With FImage Do
Begin
Picture.Bitmap.LoadFromFile(FFilename);
PicBrightness := FBrightness;
PicContrast := FContrast;
...


Ocorre que FImage é um objeto da classe TOrImage (componente delphi de terceiros), então resolvi pesquisar esse componente na internet e achei o seguinte site:

http://www.borec.ru/oric/orimage.html

que parece ser a página web de apresentação deste componente... lendo o conteúdo desta página descobri algo interessante que pode ser a razão do seu problema aí... veja:


...
This are TOrImage new or modified propertys and methods:

public

property IsMouseEntering: Boolean; readonly; Set to True if mouse above the component

property Picture: TPicture; readonly; Picture bitmap (TBitmap) after transform (Set automatically from PictureOriginal)

procedure UpdateEffects; Update Picture transform (use if your change property Picture indirectly)
...


Separei um trecho das informações que constam na página e veja o que diz sobre a propriedade Picture !! Ela é readonly e é setada automaticamente de PictureOriginal.

É muito provável que vc esteja recebendo uma exception no seu código por estar tentando atribuir um valor a uma propriedade readonly. Ao invés de tentar atribuir o arquivo de imagem diretamente a propriedade Picture, tente fazer isso a propriedade PictureOriginal.

Leia o conteúdo da página para maiores detalhes...

Qualquer dúvida posta aí... se tiver ao meu alcance ajudo com satisfação.

Espero ter ajudado,
Abraço e bons códigos.


Olá Jorge,

Eu modifiquei o código para FImage.PictureOriginal.Bitmap.LoadFromFile(FName);
Adicionei a biblioteca Messages para verificar se estava com o caminho e arquivo correto, realmente está, é um arquivo Bitmap, mas continua dando o mesmo erro de exceção nesta linha. O que poderia ser, será que eu declarei FName em private e o procedure ProcessImage como public tenha alguma coisa a ver ??

Segue como ficou modificado:

procedure TClearCaptcha.ProcessImage;
begin
FName := FFilename;
With FImage Do
Begin
PictureOriginal.Bitmap.LoadFromFile(FName);
PicBrightness := FBrightness;
PicContrast := FContrast;
PicGrayScale := FGrayscale;
PicLightness := FLightness;
PicDarkness := FDarkness;
PicSaturation := FSaturation;
PicSplitlight := FSplitLight;
PicInvert := FInvert;
PicColorNoise := FColorNoise;
PicMonoNoise := FMonoNoise;
PicPosterize := FPosterize;
PicSolorize := FSolorize;
PicEmboss := FEmboss;
PicMosaic := FMosaic;
PicSplitBlur := FSplitBlur;
PicGaussianBlur := FGaussianBlur;
PicAntiAlias := FAntiAlias;
PicTrace := FTrace;
PicTile := FTile;
UpdateEffects;
Picture.Bitmap.Monochrome := FMonochrome;
end;
AreaRange(FImage.Picture.Bitmap);
Try
Img := TImage.Create(self);
SnipArea(FImage);
CombineBitmap(FImage);
FName := Copy(FName, 1, Pos('.', FName)-1) + '_Tratada' + Copy(FName, Pos('.', FName), 4);
Img.Picture.Bitmap.SaveToFile(FName);
Finally
Img.Free;
end;
end;
Responder

10/12/2019

Jorge Pinto

Olá Marcos !! Tudo com vc ??

Primeiramente me desculpe a demora para responder... estive alguns dias off em função de coisas do trabalho e escola...

Se ainda não tiver resolvido o seu problema vamos tentar dar sequencia. Poste por favor duas coisas:

1 - O código onde vc está utilizando seu componente TClearCaptcha

2 - A mensagem de erro que vc está recebendo

Aguardo seu retorno.

Abraço.
Responder

11/12/2019

Marcos Godoy

Olá Marcos !! Tudo com vc ??

Primeiramente me desculpe a demora para responder... estive alguns dias off em função de coisas do trabalho e escola...

Se ainda não tiver resolvido o seu problema vamos tentar dar sequencia. Poste por favor duas coisas:

1 - O código onde vc está utilizando seu componente TClearCaptcha

2 - A mensagem de erro que vc está recebendo

Aguardo seu retorno.

Abraço.[/quote

Olá Jorge, tudo bem e vc ?!!

Eu consegui fazer o componente funcionar declarando as procedures como public, no entanto, ele faz a limpeza da imagem mas mantém o ruído (sujeira na imagem) que no programa original não fica e não atualiza no form a imagem carregada e salva.
Não sei se posso colocar um link do código no Google Drive zipado aqui para você ver o programa original, o componente e o programa para testar.
Para testar eu coloquei o componente TClearCaptcha no Form, e um TButton abaixo, ao clicar no TButton, ele faz esse roteiro:

procedure TForm1.Button1Click(Sender: TObject);
begin
ClearCaptcha1.SetFileName('C:\\SISTEMAS\\LimpezaImagem-FernandoMaia\\Captcha03.bmp');
ClearCaptcha1.SetDefaults;
ClearCaptcha1.Visible := true;
ClearCaptcha1.SetMonochrome(true);
ClearCaptcha1.ProcessImage;
ClearCaptcha1.Refresh;
end;

Está carregando a imagem normalmente, mas alguma coisa no código está errado quando ele limpa o captcha e eu ainda não descobri o que é.

Agradeço pela ajuda !
Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar