Delphi Brasil
Seja bem-vindo (a) ao Delphi Brasil,aqui você encontrará dicas,tutoriais e etc.
Por favor,registre-se para obter o maior proveito possivel do fórum.

Participe do fórum, é rápido e fácil

Delphi Brasil
Seja bem-vindo (a) ao Delphi Brasil,aqui você encontrará dicas,tutoriais e etc.
Por favor,registre-se para obter o maior proveito possivel do fórum.
Delphi Brasil
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.
Procurar
 
 

Resultados por:
 


Rechercher Pesquisa avançada

Entrar

Esqueci-me da senha

Últimos assuntos
» Problemas para atualizar carteira bamcaria no delphi 5
Fecho convexo numa Timage EmptySeg Jul 27, 2015 11:42 am por Fredyffp

» Fontes Sistema Store Protheus 7.0 - Versão completa Delphi XE7
Fecho convexo numa Timage EmptySáb Jul 18, 2015 10:18 am por storeprotheus

» Fontes Sistema Store Protheus 7.0 - Versão completa Delphi XE7
Fecho convexo numa Timage EmptySáb Jul 18, 2015 10:17 am por storeprotheus

» Como gravar um campo Blob no FireBird + Delphi de um campo tipo imagem no MS-ACCESS ?
Fecho convexo numa Timage EmptyQui maio 14, 2015 3:41 pm por ant.carlos/sp

»  Exception EBDEngineError
Fecho convexo numa Timage EmptySex Fev 27, 2015 6:52 am por luan_cpd

» Exception EBDEngineError
Fecho convexo numa Timage EmptySex Fev 27, 2015 6:49 am por luan_cpd

» Componente Delphi Brasil
Fecho convexo numa Timage EmptySex Jan 23, 2015 11:51 am por pedrosilva

»  Erro no Delphi “A linha não pode ser localizada para atualiz
Fecho convexo numa Timage EmptySex Out 24, 2014 11:47 am por Edson

» Fontes Automação Comercial 8.5 - Retaguarda c/ PDV, PAF 1.10, TEF, ECF, Sintegra, SpedFiscal, Google Maps e muito mas...
Fecho convexo numa Timage EmptyTer Out 14, 2014 9:55 am por john marcos

Parceiros

Fecho convexo numa Timage

Ir para baixo

Fecho convexo numa Timage Empty Fecho convexo numa Timage

Mensagem por frutasamir Seg Mar 18, 2013 10:10 am

Olá pessoal,

tenho aqui um obstáculo que tenho de passar, estou a trabalhar em comparação de imagens .Jpeg* 24Bpp (600x600)

O objetivo é conseguir que o utilizador escolha a zona da imagem que quer comparar, usando neste caso o Fecho convexo um algoritmo de união de pontos.

Ia então pedir ajuda neste ambito:

1º Desenhar pontos uma Static Image(Timage);
2º Desenhar uma linha que une todos estes pontos;
3º Comparar a região desenhada com uma segunda imagem;


para saber o que pretendo, essa imagem desenha o fecho convexo numa paintbox, eu gostaria de o fazer numa Timage


Neste momento estou deparado com este código:

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, math;

type
TForm1 = class(TForm)
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Type
TPointArray = array of TPoint;

TPointFloat = record
X: Real;
Y: Real;
end;

procedure QuickSortAngle(var A: TPointArray; Angles: array of Real; iLo, iHi: Integer);
var
Lo, Hi: Integer;
Mid: Real;
TempPoint: TPoint;
TempAngle: Real;
begin
Lo := iLo;
Hi := iHi;
Mid := Angles[(Lo + Hi) div 2];
repeat
while Angles[Lo] < Mid do Inc(Lo);
while Angles[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
// swap points
TempPoint := A[Lo];
A[Lo] := A[Hi];
A[Hi] := TempPoint;
// swap angles
TempAngle := Angles[Lo];
Angles[Lo] := Angles[Hi];
Angles[Hi] := TempAngle;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
// perform quicksorts on subsections
if Hi > iLo then QuickSortAngle(A, Angles, iLo, Hi);
if Lo < iHi then QuickSortAngle(A, Angles, Lo, iHi);
end;



function FindConvexHull(var APoints: TPointArray): Boolean;
var
LAngles: array of Real;
Lindex, LMinY, LMaxX, LPivotIndex: Integer;
LPivot: TPoint;
LBehind, LInfront: TPoint;
LRightTurn: Boolean;
LVecPoint: TPointFloat;
begin
Result := True;

if Length(APoints) = 3 then Exit; // already a convex hull
if Length(APoints) < 3 then
begin // not enough points
Result := False;
Exit;
end;
LMinY := 1000;
LMaxX := 1000;
LPivotIndex := 0;
for Lindex := 0 to High(APoints) do
begin
if APoints[Lindex].Y = LMinY then
begin
if APoints[Lindex].X > LMaxX then
begin
LMaxX := APoints[Lindex].X;
LPivotIndex := Lindex;
end;
end
else if APoints[Lindex].Y < LMinY then
begin
LMinY := APoints[Lindex].Y;
LMaxX := APoints[Lindex].X;
LPivotIndex := Lindex;
end;
end;
LPivot := APoints[LPivotIndex];
APoints[LPivotIndex] := APoints[High(APoints)];
SetLength(APoints, High(APoints));
SetLength(LAngles, Length(APoints));
for Lindex := 0 to High(APoints) do
begin
LVecPoint.X := LPivot.X - APoints[Lindex].X; // point vector
LVecPoint.Y := LPivot.Y - APoints[Lindex].Y;
// reduce to a unit-vector - length 1
LAngles[Lindex] := LVecPoint.X / Hypot(LVecPoint.X, LVecPoint.Y);
end;
QuickSortAngle(APoints, LAngles, 0, High(APoints));
Lindex := 1;
repeat
// assign points behind and infront of current point
if Lindex = 0 then LRightTurn := True
else
begin
LBehind := APoints[Lindex - 1];
if Lindex = High(APoints) then LInfront := LPivot
else
LInfront := APoints[Lindex + 1];

// work out if we are making a right or left turn using vector product
if ((LBehind.X - APoints[Lindex].X) * (LInfront.Y - APoints[Lindex].Y)) -
((LInfront.X - APoints[Lindex].X) * (LBehind.Y - APoints[Lindex].Y)) < 0 then
LRightTurn := True
else
LRightTurn := False;
end;

if LRightTurn then
begin // point is currently considered part of the hull
Inc(Lindex); // go to next point
end
else
begin // point is not part of the hull
// remove point from convex hull
if Lindex = High(APoints) then
begin
SetLength(APoints, High(APoints));
end
else
begin
Move(APoints[Lindex + 1], APoints[Lindex],
(High(APoints) - Lindex) * SizeOf(TPoint) + 1);
SetLength(APoints, High(APoints));
end;

Dec(Lindex); // backtrack to previous point
end;
until Lindex = High(APoints);

// add pivot back into points array
SetLength(APoints, Length(APoints) + 1);
APoints[High(APoints)] := LPivot;
end;
End.

Muito obrigado, cumprimentos Frutsamir.

frutasamir
Membro
Membro

Mensagens : 1
Data de inscrição : 18/03/2013

Ir para o topo Ir para baixo

Ir para o topo


 
Permissões neste sub-fórum
Não podes responder a tópicos