On Mon, 25 Sep 2017, James Richters wrote:


See what I wrote yesterday :)
Sorry I had a duplicate message, I was having difficulty with my email and 
accidentally sent a mail with an alias, I thought it was rejected but it was 
just delayed.

Here is what I have now, and it's working great, thanks for the help.

Function Find_Color(ColorArray : Array of VGARGBRec; R ,G ,B : Word) : Byte;
Var
  Dist,Closest:Double;
  i,BestChoice:Byte;
Begin
  Closest:=200000;
  For i:= Low(ColorArray) to High(ColorArray) do
     Begin
        Dist := ((R-ColorArray[i].R)*(R-ColorArray[i].R))
              + ((G-ColorArray[i].G)*(G-ColorArray[i].G))
              + ((B-ColorArray[i].B)*(B-ColorArray[i].B));
        If Dist <= Closest Then
           Begin
              Closest:=Dist;
              BestChoice:=i;
           End;
     End;
  Find_Color:=BestChoice;
end;

Call with:
Find_Color(Arrayname, Red, Green, Blue);


The loop can still be optimized, but that is another topic.

Please elaborate, I would be very interested in how this could be optimized.

1. Use a pointer to the element in the array.
2. Use SQR instead of x*x
2. Use With to calculate your distance

    With ColorArray[i] do
      Dist :=Sqr(aR-R)+Sqr(aG-G)+Sqr(aB-B);

I would think that something like the following is the most optimal:

 Function Find_Color(ColorArray : Array of VGARGBRec; aR ,aG ,aB : Word) : Byte;

 Var
   Dist,Closest:Double;
   i,BestChoice:Byte;
   P : ^VGARGBRec;

 Begin
   BestChoice:=255;
   Closest:=200000;
   P:=@ColoyArray[Low(ColorArray)];
   For i:= Low(ColorArray) to High(ColorArray) do
     begin
     With P^ do
       Dist:=Sqr(aR-R)+Sqr(aG-G)+Sqr(aB-B);
     If Dist<=Closest Then
       Begin
       Closest:=Dist;
       BestChoice:=i;
       End;
     Inc(P);
     end;
   Find_Color:=BestChoice;
 end;

I didn't test the code, but you catch my drift, I suppose...

Michael.
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal

Reply via email to