SRL Archive - SRL Archives

Well here they are. GetAreaCols gets all the colors in an box (l and w are modifiers)). Find Best Color finds the best color to use in those boxes. Have fun.

An Average, takes 300 ms.

procedure GetAreaColors(var Colors: array of integer; L, W: integer; MH, MS: extended);
var
 xCount, yCount, xMouse, yMouse, cColor, rBitmap, bHeight, bWidth, aCount, wCount, zCount: integer;
 hCount, sCount, lCount, cH, cS, cL: extended;
 rBox: TBox;
begin
  SetArrayLength(Colors, 1);
  GetMousePos(xMouse,yMouse);
  cColor:= GetColor(xMouse, yMouse);
  ColorToHSL(cColor, cH, cS, cL);
  rBox.x1:= xMouse - W;
  rBox.y1:= yMouse - L;
  rBox.x2:= xMouse + W;
  rBox.y2:= yMouse + L;
  CopyClientToBitmap(rBitmap, rBox.x1, rBox.y1, rBox.x2, rBox.y2);
  GetBitmapSize(rBitmap, bWidth, bHeight);
  DisplayDebugImgWindow(bWidth, bHeight);
  SafeCopyCanvas(GetBitmapCanvas(rBitmap), GetDebugCanvas, 0, 0, bWidth, bHeight, 0, 0, bWidth, bHeight);
  for xCount:= 1 to bWidth do
    for yCount:= 1 to bHeight do
      begin
       ColorToHSL(FastGetPixel(rBitmap, xCount, yCount), hCount, sCount, lCount);
       if MaxE(hCount, cH) - MinE(hCount, cH) <= MH then
         if MaxE(sCount, cS) - MinE(sCount, cS) <= MS then
           if MaxE(lCount, cL) - MinE(lCount, cL) <= 30.0 then
             begin
               SetArrayLength(Colors, Length(Colors) + 1);
               aCount:= Length(Colors) - 1;
               Colors[aCount]:= FastGetPixel(rBitmap, xCount, yCount);
             end;
       end;
  BubbleSort(Colors);
  if InIntArrayEx(Colors, zCount, 0) then Colors[zCount]:= Colors[(zCount + 1)];
  ClearSameIntegers(Colors);
  for wCount:= 0 to Length(Colors) - 1 do
    Writeln(IntToStr(Colors[wCount]));
end;

function FindBestCol(var Colors: array of integer; L, W: integer; MH, MS: extended): integer;
var
  aCount, mCoun, xMouse, yMouse : integer;
  rCount: array of integer;
  rBox: TBox;
begin
  GetAreaColors(Colors, l, w, mh, ms);
  SetArrayLength(rCount, Length(Colors));
  GetMousePos(xMouse, yMouse);
  rBox.x1:= xMouse - W;
  rBox.y1:= yMouse - L;
  rBox.x2:= xMouse + W;
  rBox.y2:= yMouse + L;
  for aCount:= 0 to Length(Colors) - 1do
    rCount[aCount]:= CountColor(Colors[aCount], rBox.x1, rBox.y1, rBox.x2, rBox.y2);
  mCoun:= AMin(rCount);
  result:= Colors[mCoun];
  Writeln('Best Color = '+IntToStr(result)+';');
end;

First post ftw.

Slow down a bit please, im pretty sure you didnt exactly mean

GetAreaCols gets all the colors in an box

Because that could be done with 1 array, 2 for loops and GetColor ;)

So, a bit more explanation please :)

EDIT: Btw, whats this autocolor diarrhea of yours about?

Ever considered: function GetBitmapAreaColors(xs, ys, xe, ye: Integer): T2DIntArray; ? It should reduce the time a bit\lot ^^.

it finds all colors w/ tolerance of a certain object (ex. Gets the colors an iron ore), so get bitmap colors would work.

I think I made something almost exactly like this a while ago, but did it a different way :).

Nice work :p.

Very nice I might start using this.