SRL Archive - Extensions

Why, 'ello there!

Some of you have been asking for the ACA source. Most likely to adjust it for the new CTS (or perhaps to learn from it?). I think it's better to create a new version as an extension for Simba. A lot of the work can be used from the DTM editor extension (mainly the client/image handling), which is a nice advantage.

I've done the basics already, which means that almost all the work behind the scenes is done already. It's mainly the form and displaying of information that needs to finishing. CTS3 needs to be done, too. Currently, I have adjusted the DTM editor form so it looks more like ACA. The right sidebar is pretty much done and loading/saving works too. I've moved the zoom window to the bottom, but that's pretty much all that I've done to the bottom part.

To be done:

• Add colour dialog
• Delete duplicates
• Clear list
• Show information about colours
• Let mark colour use user input
• Function generators

I don't think it's necessary keep the function generators? Or perhaps the TAutoColor ones?

program ACA_Extension;
//ACA v3 for Simba By Nielsie95
//http://villavu.com/forum/showthread.php?t=70704

{$ifndef PS_EXTENSION}
var
  Client: TClient;
  Simba_MainMenu: TMainMenu;
{$endif}

{$i mml.simba}
const
  Version = '0.01';
  ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)

  sBestColour = 'Best colour - %s';
  sBestTol    = 'Tolerance - %d';
  sMod1_CTS2  = 'Hue mod: %f';
  sMod2_CTS2  = 'Sat mod: %f';

type
  TColourRec = record
    Colour: TColor;
    r, g, b: Integer;
    h, s, l: Extended;
    x, y, z: Extended;
    ll, aa, bb: Extended;
  end;
  TColorRecArray = array of TColourRec;

var
  Simba_Menu: TMenuItem;
  DefaultCTS3Mod: Extended;

  frm: TForm;
  mm: TMainMenu;
  sm: array [0..40] of TMenuItem;
  ResizeTimer: TTimer;

  sb: TScrollBox;
  img, imgZoom: TImage;
  lb: TListBox;
  btnAdd, btnDel, btnMark,
  btnMarkBest, btnRefresh, btnLoad: TButton;
  rgCTS: TRadioGroup;
  lblColour, lblTolerance, lblMod1, lblMod2: TLabel;

  bmpOverlay, bmpBuffer, bmp: TMufasaBitmap;
  sp: TPoint;
  Zoom: Single;
  MarkCol, ColFormat: Integer;
  IgnoreDups: Boolean;
  BufferChanged: Boolean;

  c: TColorRecArray;
  minC, maxC: TColourRec;
  BestColour, BestTolerance: Integer;
  BestMod1, BestMod2: Extended;

procedure FreeAndNil(var Bmp: TMufasaBitmap);
begin
  if (Bmp <> nil) then
  begin
    Bmp.Free;
    Bmp := nil;
  end;
end;

function RoundTo(x: Extended; n: Integer): Extended;
var
  p: Extended;
begin
  p := Pow(10, n);
  Result := Ceil(x * p) / p;
end;

function InvertColour(Colour: Integer; ForeGround: Boolean): Integer;
var
  h, s, l: Extended;
  r, g, b: Integer;
begin
  ColorToHSL(Colour, h, s, l);
  ColorToRGB(Colour, r, g, b);

  //http://www.nbdtech.com/Blog/archive/2008/04/27/Calculating-the-Perceived-Brightness-of-a-Color.aspx
  b := Round(Sqrt(r*r*0.241 + g*g*0.691 + b*b*0.068));
  s := Abs(l - 50);
  if ((s <= 35) and (b >= 130)) or ((s > 35) and (l > 65))then
    Result := clBlack
  else
    Result := clYellow;

  if (not ForeGround) then
    Result := clYellow - Result;
end;

function FixImgPoint(var x, y: Integer): Boolean;
begin
  x := x - sp.x;
  y := y - sp.y;
  if (Zoom <> 1.0) and (Zoom > 0.0) then
  begin
    x := Round(x / Zoom);
    y := Round(y / Zoom);
  end;
  Result := not ((x < 0) or (y < 0) or (x >= bmpBuffer.Width) or (y >= bmpBuffer.Height));
end;

function ColourRec(AColour: Integer): TColourRec;
begin
  with Result do
  begin
    Colour := AColour;
    ColorToRGB(AColour, r, g, b);
    ColorToHSL(AColour, h, s, l);
    ColorToXYZ(AColour, x, y, z);
    ColorToCIELab(AColour, ll, aa, bb);
  end;
end;

function ColourToString(Colour: TColourRec): string;
begin
  with Colour do
    case ColFormat of
      1: Result := Format('(%3d,%3d,%3d)', [r, g, b]);
      2: Result := Format('(%.0f,%.0f,%.0f)', [h, s, l]);
      3: Result := Format('(%.0f,%.0f,%.0f)', [x, y, z]);
      4: Result := Format('(%.0f,%.0f,%.0f)', [ll, aa, bb]);
      else Result := IntToStr(Colour);
    end;
end;

function IndexOfColour(Colour: Integer): Integer;
var
  i: Integer;
begin
  for i := High(c) downto 0 do
    if (c[i].Colour = Colour) then
    begin
      Result := i;
      Exit;
    end;
  Result := -1;
end;

procedure CheckColourBounds(Colour: TColourRec);
begin
  with Colour do
  begin
    if (r < minC.r) then minC.r := r;
    if (r > maxC.r) then maxC.r := r;
    if (g < minC.g) then minC.g := g;
    if (g > maxC.g) then maxC.g := g;
    if (b < minC.b) then minC.b := b;
    if (b > maxC.b) then maxC.b := b;

    if (h < minC.h) then minC.h := h;
    if (h > maxC.h) then maxC.h := h;
    if (s < minC.s) then minC.s := s;
    if (s > maxC.s) then maxC.s := s;
    if (l < minC.l) then minC.l := l;
    if (l > maxC.l) then maxC.l := l;

    if (x < minC.x) then minC.x := x;
    if (x > maxC.x) then maxC.x := x;
    if (y < minC.y) then minC.y := y;
    if (y > maxC.y) then maxC.y := y;
    if (z < minC.z) then minC.z := z;
    if (z > maxC.z) then maxC.z := z;

    if (ll < minC.ll) then minC.ll := ll;
    if (ll > maxC.ll) then maxC.ll := ll;
    if (aa < minC.aa) then minC.aa := aa;
    if (aa > maxC.aa) then maxC.aa := aa;
    if (bb < minC.bb) then minC.bb := bb;
    if (bb > maxC.bb) then maxC.bb := bb;
  end;
end;

procedure CalculateBounds(From: Integer);
var
  i: Integer;
begin
  if (Length(c) < 1) then
    Exit;
  if (From <= 0) then
  begin
    minC := c[0];
    maxC := c[0];
  end;
  if (From <> 0) then
    for i := High(c) downto 1 do
      CheckColourBounds(c[i]);
end;

procedure BestColour_CTS0;
var
  r, g, b: Integer;
begin
  r := Ceil((maxC.r - minC.r) / 2.0);
  g := Ceil((maxC.g - minC.g) / 2.0);
  b := Ceil((maxC.b - minC.b) / 2.0);

  BestColour := RGBToColor(MinC.r + r, MinC.g + g, MinC.b + b);
  BestTolerance := Max(Max(r, g), b);

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

procedure BestColour_CTS1;
var
  r, g, b: Integer;
begin
  r := Ceil((maxC.r - minC.r) / 2.0);
  g := Ceil((maxC.g - minC.g) / 2.0);
  b := Ceil((maxC.b - minC.b) / 2.0);

  BestColour := RGBToColor(MinC.r + r, MinC.g + g, MinC.b + b);
  BestTolerance := Ceil(Sqrt(r*r + g*g + b*b));

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

const
  MaxHue = 100;
  MedHue = 50;
function BestColour_CTS2_Hue(out MinU, MaxU: Extended): Extended;
var
  {MinU, MaxU, }MinD, MaxD: Extended;
  i: Integer;
begin
  Result := -1;
  if (Length(c) < 1) then
    Exit;

  MinU := MaxHue; MinD := MaxHue;
  MaxU := -1;     MaxD := -1;

  for i := High(c) downto 0 do
    if (c[i].h < MedHue) then
    begin
      if (c[i].h < MinU) then
        MinU := c[i].h;
      if (c[i].h > MaxU) then
        MaxU := c[i].h;
    end
    else
    begin
      if (c[i].h < MinD) then
        MinD := c[i].h;
      if (c[i].h > MaxD) then
        MaxD := c[i].h;
    end;

  if ((MaxU >= 0) <> (MaxD >= 0)) then
    if (MaxU >= 0) then
      Result := (MinU + MaxU) / 2
    else
    begin
      Result := (MinD + MaxD) / 2;
      MinU := MinD;
      MaxU := MaxD;
    end
  else
  begin
    if ((MaxHue - MaxD) + MinU) < (MaxD - MaxU) then
      MinU := MinD
    else
      MaxU := MaxD;

    Result := (MinU + MaxU) / 2;
    if (MinU > MaxU) then
      Result := Result - MedHue;
  end;

  Result := Result + MaxHue;
  while (Result >= MaxHue) do
    Result := Result - MaxHue;
end;

procedure BestColour_CTS2;
var
  h, s, l,
  minH, maxH: Extended;
begin
  h := BestColour_CTS2_Hue(minH, maxH);
  //h := (minC.h + maxC.h) / 2;
  s := (minC.s + maxC.s) / 2;
  l := (minC.l + maxC.l) / 2;

  BestColour := HSLToColor(h, s, l);
  ColorToHSL(BestColour, h, s, l);

  BestTolerance := Ceil(MaxE(maxC.l - l, l - minC.l));
  if (BestTolerance > 0) then
  begin
    h := MaxE(MinE(Abs(minH - h), minH + MaxHue - h), MinE(Abs(maxH - h), maxH + MaxHue - h)) / BestTolerance;
    //h := MaxE(maxC.h - h, h - minC.h) / BestTolerance;
    s := MaxE(maxC.s - s, s - minC.s) / BestTolerance;
    BestMod1 := RoundTo(h, 2);
    BestMod2 := RoundTo(s, 2);
  end
  else
  begin
    BestMod1 := 0;
    BestMod2 := 0;
  end;

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
  lblMod1.Caption := Format(sMod1_CTS2, [BestMod1]);
  lblMod2.Caption := Format(sMod2_CTS2, [BestMod2]);
end;

procedure BestColour_CTS3;
var
  L, A, B: Extended;
begin
  L := (maxC.ll + minC.ll) / 2.0;
  A := (maxC.aa + minC.aa) / 2.0;
  B := (maxC.bb + minC.bb) / 2.0;

  BestColour := CIELabToColor(L, A, B);
  ColorToCIELab(BestColour, L, A, B);

  L := MaxE(maxC.ll - L, L - minC.ll);
  A := MaxE(maxC.aa - A, A - minC.aa);
  B := MaxE(maxC.bb - B, B - minC.bb);
  BestTolerance := Ceil(Sqrt(L*L + A*A + B*B) / DefaultCTS3Mod);

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

procedure CalculateBestColour(RecalculateFrom: Integer);
begin
  CalculateBounds(RecalculateFrom);
  case rgCTS.ItemIndex of
    0: BestColour_CTS0;
    1: BestColour_CTS1;
    2: BestColour_CTS2;
    3: BestColour_CTS3;
  end;
end;

function AddColour(Colour: Integer): Integer;
begin
  Result := Length(c);
  SetLength(c, Result + 1);
  lb.Items.Add(IntToStr(Colour));

  c[Result] := ColourRec(Colour);
  CalculateBestColour(Result);
end;

procedure setActiveColour(Index: Integer);
var
  e: TNotifyEvent;
begin
  if (lb.ItemIndex <> Index) then
  begin
    e := lb.OnClick;
    lb.ItemIndex := Index;
    lb.OnClick := e;
  end;

  {if (Index > -1) then
    with c[Index] do
    begin
      edX.Text := IntToStr(x);
      edY.Text := IntToStr(y);
      edASize.Text := IntToStr(AreaSize);
      cbAShape.ItemIndex := AreaShape;
      edColour.Text := IntToStr(Colour);
      edTolerance.Text := IntToStr(Tolerance);
    end;}
end;

procedure ResetBuffer;
begin
  FreeAndNil(bmpBuffer);
  bmpBuffer := bmp.Copy(0, 0, bmp.Width - 1, bmp.Height - 1);
  BufferChanged := False;
end;

procedure UpdateBitmap(EnsurePaint: Boolean);
var
  b: TMufasaBitmap;
  tmpBitmap: TBitmap;
begin
  if (Zoom = 1.0) or (Zoom <= 0.0) then
    if (bmpOverlay <> nil) then
      b := bmpOverlay
    else
      b := bmpBuffer
  else
  begin
    if (bmpOverlay <> nil) then
      b := bmpOverlay.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1)
    else
      b := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
    b.StretchResize(Max(Round(b.Width * Zoom), 1), Max(Round(b.Height * Zoom), 1));
  end;

  img.Width := b.Width;
  img.Height := b.Height;
  img.Picture.Bitmap.Width := Max(b.Width, sb.ClientWidth);
  img.Picture.Bitmap.Height := Max(b.Height, sb.ClientHeight);

  if (sp.x > 0) and (sp.x + b.Width > sb.ClientWidth - 1) then
    EnsurePaint := True
  else if (sp.y > 0) and (sp.y + b.Height > sb.ClientHeight - 1) then
    EnsurePaint := True;
  sp := Point(0, 0);

  if (b.Width < sb.ClientWidth - 1) or (b.Height < sb.ClientHeight - 1) then
  begin
    if (b.Width < sb.ClientWidth - 1) then
    begin
      img.Width := sb.ClientWidth - 1;
      sp.x := (img.Width - b.Width) div 2;
    end;
    if (b.Height < sb.ClientHeight - 1) then
    begin
      img.Height := sb.ClientHeight - 1;
      sp.y := (img.Height - b.Height) div 2;
    end;

    with img.Canvas do
    begin
      Pen.Color := clNavy;
      Brush.Style := bsSolid;
      Brush.Color := clWhite;
      Rectangle(0, 0, img.Width - 1, img.Height - 1);
      Brush.Style := bsDiagCross;
      Brush.Color := clNavy;
      Rectangle(0, 0, img.Width - 1, img.Height - 1);
    end;
    EnsurePaint := True;
  end;

  if EnsurePaint then
  begin
    if (sp.x = 0) and (sp.y = 0) then
    begin
      tmpBitmap := b.ToTBitmap;
      img.Picture.Bitmap.Assign(tmpBitmap);
      tmpBitmap.Free;
    end
    else
      b.DrawToCanvas(sp.x, sp.y, img.Canvas);
  end;

  if (Zoom > 0.0) and (Zoom <> 1.0) then
    b.Free;
end;

procedure LoadClientBitmap;
var
  w, h: Integer;
begin
  GetClientDimensions(w, h);
  bmp.CopyClientToBitmap(client.IOManager,true,0,0,0,0,w-1,h-1);
  ResetBuffer;
  UpdateBitmap(True);
end;

procedure frmResize(Sender: TObject);
begin
  ResizeTimer.Enabled := False;
  ResizeTimer.Enabled := True;
end;

procedure frmKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_CONTROL) and (img.Cursor = crHandPoint) then
    img.Cursor := crDefault
  else if (Key = VK_DELETE) then
    btnDel.OnClick(nil);
end;

procedure timerResize(Sender: TObject);
begin
  //TTimer(Sender).Enabled := False;
  ResizeTimer.Enabled := False;
  UpdateBitmap(False);
end;

procedure edFilterText(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (not (
    (Key = VK_DELETE) or
    (Key = VK_BACK) or
    ((Key >= VK_0) and (Key <= VK_9)) or
    ((Key >= VK_Left) and (Key <= VK_DOWN)) or
    ((Key >= VK_NUMPAD0) and (Key <= VK_NUMPAD9))
  )) or (Shift <> []) then
    Key := 0;
end;

procedure mnuNew(Sender: TObject);
begin
  SetLength(c, 0);
  lb.Clear;

  sm[15].Click; //Zoom
  sm[20].Click; //Marking Colour
  sm[31].Click; //Colour Format

  rgCTS.ItemIndex := 1;
  lblColour.Caption := Format(sBestColour, ['~']);
  lblTolerance.Caption := Format(sBestTol, [0]);

  FreeAndNil(bmpOverlay);
  ResetBuffer;
  UpdateBitmap(True);
  frm.ActiveControl := lb;
end;

procedure mnuOpen(Sender: TObject);
var
  i: Integer;
  Cols: TIntegerArray;
begin
  with TOpenDialog.Create(frm) do
  begin
    Filter := 'AutoColorAid (*.aca)|*.aca|All files (*.*)|*.*|';
    Options := Options + [ofFileMustExist];

    if Execute then
      try
        with TStringList.Create do
        try
          LoadFromFile(FileName);

          SetLength(Cols, Count);
          for i := Count - 1 downto 0 do
            Cols[i] := StrToInt(Strings[i]);
        finally
          Free;
        end;

        mnuNew(nil);
        if (Length(Cols) > 0) then
        begin
          for i := 0 to High(Cols) do
            AddColour(Cols[i]);
          setActiveColour(0);
        end;
      except
        if (MessageDlg('Corrupt File', 'Invalid ACA file! Press OK to try loading another file.', mtError, [mbOk, mbCancel] {$ifdef PS_EXTENSION}, 0{$endif}) = 1) then
          mnuOpen(Sender);
      end;

    Free;
  end;
end;

procedure mnuSave(Sender: TObject);
begin
  with TSaveDialog.Create(frm) do
  begin
    Filter := 'AutoColorAid (*.aca)|*.aca|All files (*.*)|*.*|';
    Options := Options + [ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofOverwritePrompt];

    if Execute then
      if (Pos('.aca', FileName) < Length(FileName) - 4) then
        lb.Items.SaveToFile(FileName+'.aca')
      else
        lb.Items.SaveToFile(FileName);
    Free;
  end;
end;

procedure mnuExit(Sender: TObject);
begin
  frm.Close;
end;

procedure mnuOpenImg(Sender: TObject);
begin
  with TOpenDialog.Create(frm) do
  begin
    Filter := 'Graphic (*.bmp;*.xpm;*.png;*.pbm;*.pgm;*.ppm;*.ico;*.icns;*.cur;*.jpg;*.jpeg;*.jpe;*.jfif)|*.bmp;*.xpm;*.png;*.pbm;*.pgm;*.ppm;*.ico;*.icns;*.cur;*.jpg;*.jpeg;*.jpe;*.jfif|Bitmaps (*.bmp)|*.bmp|Pixmap (*.xpm)|*.xpm|Portable Network Graphic (*.png)|*.png|Portable PixMap (*.pbm;*.pgm;*.ppm)|*.pbm;*.pgm;*.ppm|Icon (*.ico)|*.ico|OSX Icon Resource (*.icns)|*.icns|Cursor (*.cur)|*.cur|Joint Picture Expert Group (*.jpg;*.jpeg;*.jpe;*.jfif)|*.jpg;*.jpeg;*.jpe;*.jfif|All files (*.*)|*.*|';
    Options := Options + [ofFileMustExist];
    if Execute then
    begin
      bmp.LoadFromFile(FileName);
      ResetBuffer;
      UpdateBitmap(True);
    end;
    Free;
  end;
end;

procedure mnuClientImg(Sender: TObject);
begin
  LoadClientBitmap;
end;

procedure mnuClientDesktop(Sender: TObject);
begin
  SetDesktopAsClient;
  LoadClientBitmap;
end;

procedure mnuZoom(Sender: TObject);
var
  i: Integer;
  z: Single;
begin
  for i := 0 to sm[12].Count - 1 do
    sm[12].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;

  z := TMenuItem(Sender).Tag / 100.0;
  if (Zoom <> z) then
  begin
    Zoom := z;
    UpdateBitmap(True);
  end;
end;

procedure mnuSetMarkCol(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[19].Count - 1 do
    sm[19].Items[i].Checked := False;

  TMenuItem(Sender).Checked := True;
  MarkCol := TMenuItem(Sender).Tag;
end;

procedure mnuRefresh(Sender: TObject);
begin
  if (bmpOverlay <> nil) then
    FreeAndNil(bmpOverlay)
  else
    ResetBuffer;
  UpdateBitmap(True);
end;

procedure mnuClearList(Sender: TObject);
begin
  SetLength(c, 0);
  lb.Clear;

  rgCTS.OnClick(nil);
  lblColour.Caption := Format(sBestColour, ['~']);
  lblTolerance.Caption := Format(sBestTol, [0]);
end;

procedure mnuDeleteDups(Sender: TObject);
var
  Cols: TColorRecArray;
  i: Integer;
begin
  Cols := c;
  mnuClearList(nil);

  for i := 0 to High(Cols) do
    if (IndexOfColour(Cols[i].Colour) < 0) then
      AddColour(Cols[i].Colour);
end;

procedure mnuSetColFormat(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[30].Count - 1 do
    sm[30].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;

  if (ColFormat <> TMenuItem(Sender).Tag) then
  begin
    ColFormat := TMenuItem(Sender).Tag;
    CalculateBestColour(Length(c));
    lb.Repaint;
  end;
end;

procedure mnuIgnoreDups(Sender: TObject);
begin
  IgnoreDups := not TMenuItem(Sender).Checked;
  TMenuItem(Sender).Checked := IgnoreDups;
end;

procedure mnuMatchCols(Sender: TObject);
var
  h: Integer;
  Points: TPointArray;
begin
  BufferChanged := True;
  
  h := GetImageTarget;
  
  if (bmpOverlay = nil) then
    bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
  SetTargetBitmap(bmpBuffer);

  {$ifndef PS_EXTENSION}
  SetColorToleranceSpeed(rgCTS.ItemIndex);
  SetToleranceSpeed2Modifiers(BestMod1, BestMod2);
  {$endif}

  if FindColorsTolerance(Points, BestColour, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1, BestTolerance) then
    bmpOverlay.DrawTPA(Points, MarkCol);

  SetImageTarget(h);
  UpdateBitmap(True);
end;

procedure lbDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = lb);
end;

procedure lbDrawItem(Sender: TWinControl; Index: Integer; Rect: TRect; State: Byte);
begin
  with TListBox(Sender) do
    with Canvas do
    begin
      Brush.Style := bsSolid;
      if ((State and 1) > 0) then
        Brush.Color := clHighlight
      else if ((Index mod 2) = 0) then
        Brush.Color := clWindow
      else
        Brush.Color := $FDEEF4;
      Pen.Color := Brush.Color;
      FillRect(Rect);

      Pen.Color := clBlack;
      Brush.Color := c[Index].Colour;
      Rectangle(Rect.Right - (Rect.Bottom - Rect.Top - 4) - 2, Rect.Top + 2, Rect.Right - 2, Rect.Bottom - 2);

      Brush.Style := bsClear;
      TextOut(Rect.Left + 1, Rect.Top, ColourToString(c[Index]));
    end;
end;

var
  lbStartDrag: Integer;
procedure lbDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  lbEndDrag, i: Integer;
  tmp: TColourRec;
begin
  with lb do
  begin
    lbEndDrag := ItemAtPos(Point(x, y), True);
    if (lbStartDrag > -1) and (lbEndDrag > -1) and (lbStartDrag <> lbEndDrag) then
    begin
      Items.Move(lbStartDrag, lbEndDrag);

      if (lbStartDrag > lbEndDrag) then
      begin
        tmp := c[lbStartDrag];
        for i := lbStartDrag - 1 downto lbEndDrag do
          c[i + 1] := c[i];
        c[lbEndDrag] := tmp;
      end
      else
      begin
        tmp := c[lbStartDrag];
        for i := lbStartDrag to lbEndDrag - 1 do
          c[i] := c[i + 1];
        c[lbEndDrag] := tmp;
      end;

      setActiveColour(lbEndDrag);
    end;
  end;
end;

procedure lbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  lbStartDrag := lb.ItemAtPos(Point(x, y), True);
end;

procedure lbClick(Sender: TObject);
begin
  setActiveColour(lb.ItemIndex);
end;

procedure btnDelColour(Sender: TObject);
var
  curC, i, l: Integer;
begin
  curC := lb.ItemIndex;
  if (curC > -1) then
  begin
    l := High(c);
    for i := curC to l - 1 do
      Swap(c[i], c[i + 1]);
    SetLength(c, l);
    lb.Items.Delete(curC);

    if (curC = l) then
      Dec(curC);
    setActiveColour(curC);
    CalculateBestColour(-1);
  end;
end;

procedure ctsChange(Sender: TObject);
begin
  lblMod1.Visible := rgCTS.ItemIndex = 2;
  lblMod2.Visible := rgCTS.ItemIndex = 2;

  case rgCTS.ItemIndex of
    2:
      begin
        lblMod1.Caption := Format(sMod1_CTS2, [0.0]);
        lblMod2.Caption := Format(sMod2_CTS2, [0.0]);
      end;
    3:
      begin
        //lblMod1.Caption := Format(sMod1_CTS3, [BestMod1]);
        //lblMod2.Caption := Format(sMod2_CTS3, [BestMod2]);
      end;
  end;

  CalculateBestColour(Length(c));
end;

procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);
var
  Col, Idx: Integer;
begin
  frm.ActiveControl := lb;
  if (not FixImgPoint(x, y)) then
    Exit;

  Col := bmpBuffer.FastGetPixel(x, y);
  if IgnoreDups then
    Idx := IndexOfColour(Col)
  else
    Idx := -1;
  if (Idx < 0) then
    Idx := AddColour(Col);
  setActiveColour(Idx);
end;

procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  b, dx, dy, TheColour, AvgColour: Integer;
  px, py: Single;
  w, h: Single;
  s: string;
begin
  with imgZoom.Canvas do
  begin
    Pen.Color := clNavy;
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    Rectangle(0, 0, imgZoom.Width - 1, imgZoom.Height - 1);
    Brush.Style := bsDiagCross;
    Brush.Color := clNavy;
    Rectangle(0, 0, imgZoom.Width - 1, imgZoom.Height - 1);
  end;
  w := imgZoom.Width / (ZoomPixels + 0.0);
  h := imgZoom.Height / (ZoomPixels + 0.0);
  TheColour := -1;
  AvgColour := 0;

  try
    if (not FixImgPoint(x, y)) then
    begin
      img.Cursor := crDefault;
      Exit;
    end;

    px := 0.0;
    b := Floor(ZoomPixels / 2.0);
    for dx := -b to b do
    begin
      py := 0.0;
      for dy := -b to b do
      begin
        if ((x + dx) >= 0) and ((x + dx) < bmpBuffer.Width) and ((y + dy) >= 0) and ((y + dy) < bmpBuffer.Height) then
          with imgZoom.Canvas do
          begin
            Pen.Color := bmpBuffer.FastGetPixel(x + dx, y + dy);
            Brush.Style := bsSolid;
            Brush.Color := Pen.Color;

            if {(dx <= 0) and} (dy = -b) then
              AvgColour := AvgColour + Pen.Color;
            if (dx = 0) and (dy = 0) then
              TheColour := Pen.Color;

            Rectangle(Round(px), Round(py), Round(px + w), Round(py + h));
          end
        else if {(dx <= 0) and} (dy = -b) then
          AvgColour := AvgColour + clWhite;

        py := py + h;
      end;
      px := px + w;
    end;
  finally
    with imgZoom.Canvas do
    begin
      Pen.Color := MarkCol;
      Brush.Style := bsClear;
      Rectangle((imgZoom.Width shr 1) - Round(w / 2.0), (imgZoom.Height shr 1) - Round(h / 2.0), (imgZoom.Width shr 1) + Round(w / 2.0), (imgZoom.Height shr 1) + Round(h / 2.0));

      if (b > 0) then
        AvgColour := AvgColour div (b + 1);
      s := 'Colour: ' + ColourToString(ColourRec(TheColour));

      if (ColFormat > 0) and (ColFormat <= 3) then
        Font.Size := 7
      else
        Font.Size := 8;

      Font.Color := InvertColour(AvgColour, False);
      TextOut(3, 3, s);

      Font.Color := InvertColour(AvgColour, True);
      TextOut(2, 2, s);
    end;
  end;
end;

procedure CreateMenu;
var
  i: integer;
begin
  mm := TMainMenu.Create(frm);

  for i := 0 to 2 do
  begin
    sm[i] := TMenuItem.Create(frm);
    with sm[i] do
      case i of
        0: Caption := 'File';
        1: Caption := 'Image';
        2: Caption := 'Colours';
      end;
    mm.Items.Add(sm[i]);
  end;

  for i := 3 to High(sm) do
  begin
    sm[i] := TMenuItem.Create(frm);
    with mm.Items do
      case i of
        //File
        3:  begin Items[0].Add(sm[i]); sm[i].Caption := 'New';                sm[i].OnClick := @mnuNew;           sm[i].Shortcut := 16462{ctrl + N};  end;
        4:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Open Colours';       sm[i].OnClick := @mnuOpen;          sm[i].Shortcut := 16463{ctrl + O};  end;
        5:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Save Colours';       sm[i].OnClick := @mnuSave;          sm[i].Shortcut := 16467{ctrl + S};  end;
        6:  begin Items[0].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        7:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Exit';               sm[i].OnClick := @mnuExit;                                              end;

        //Image
        8:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Open Image';         sm[i].OnClick := @mnuOpenImg;       sm[i].Shortcut := 16460{ctrl + L};  end;
        9:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Load Client Image';  sm[i].OnClick := @mnuClientImg;                                         end;
        10: begin Items[1].Add(sm[i]); sm[i].Caption := 'Load Desktop Image'; sm[i].OnClick := @mnuClientDesktop;                                     end;
        11: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        12: begin Items[1].Add(sm[i]); sm[i].Caption := 'Zoom';                                                                                       end;
            13:  begin sm[12].Add(sm[i]); sm[i].Caption := '25%'; sm[i].Tag := 25;   sm[i].OnClick := @mnuZoom;                                       end;
            14:  begin sm[12].Add(sm[i]); sm[i].Caption := '50%'; sm[i].Tag := 50;   sm[i].OnClick := @mnuZoom;                                       end;
            15:  begin sm[12].Add(sm[i]); sm[i].Caption := '100%'; sm[i].Tag := 100; sm[i].OnClick := @mnuZoom;                                       end;
            16:  begin sm[12].Add(sm[i]); sm[i].Caption := '150%'; sm[i].Tag := 150; sm[i].OnClick := @mnuZoom;                                       end;
            17:  begin sm[12].Add(sm[i]); sm[i].Caption := '200%'; sm[i].Tag := 200; sm[i].OnClick := @mnuZoom;                                       end;
            18:  begin sm[12].Add(sm[i]); sm[i].Caption := '300%'; sm[i].Tag := 300; sm[i].OnClick := @mnuZoom;                                       end;
        19: begin Items[1].Add(sm[i]); sm[i].Caption := 'Marking Colour';                                                                             end;
            20:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Red';    sm[i].Tag := clRed;    sm[i].OnClick := @mnuSetMarkCol;                          end;
            21:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Blue';   sm[i].Tag := clBlue;   sm[i].OnClick := @mnuSetMarkCol;                          end;
            22:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Yellow'; sm[i].Tag := clYellow; sm[i].OnClick := @mnuSetMarkCol;                          end;
            23:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Green';  sm[i].Tag := clGreen;  sm[i].OnClick := @mnuSetMarkCol;                          end;
            24:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Black';  sm[i].Tag := clBlack;  sm[i].OnClick := @mnuSetMarkCol;                          end;
            25:  begin sm[19].Add(sm[i]); sm[i].Caption := 'White';  sm[i].Tag := clWhite;  sm[i].OnClick := @mnuSetMarkCol;                          end;
        26: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        27: begin Items[1].Add(sm[i]); sm[i].Caption := 'Refresh Image';         sm[i].OnClick := @mnuRefresh;    sm[i].Shortcut := 116{F5};          end;

        //Colours
        28: begin Items[2].Add(sm[i]); sm[i].Caption := 'Add Colour';         {sm[i].OnClick := @mnuDTMfromString;}                                     end;
        29: begin Items[2].Add(sm[i]); sm[i].Caption := 'Clear List';         sm[i].OnClick := @mnuClearList;                                         end;
        30: begin Items[2].Add(sm[i]); sm[i].Caption := 'Display Format';                                                                             end;
            31:  begin sm[30].Add(sm[i]); sm[i].Caption := 'Color32';  sm[i].Tag := 0;  sm[i].OnClick := @mnuSetColFormat;                            end;
            32:  begin sm[30].Add(sm[i]); sm[i].Caption := '(R,G,B)';  sm[i].Tag := 1;  sm[i].OnClick := @mnuSetColFormat;                            end;
            33:  begin sm[30].Add(sm[i]); sm[i].Caption := '(H,S,L)';  sm[i].Tag := 2;  sm[i].OnClick := @mnuSetColFormat;                            end;
            34:  begin sm[30].Add(sm[i]); sm[i].Caption := '(X,Y,Z)';  sm[i].Tag := 3;  sm[i].OnClick := @mnuSetColFormat;                            end;
            40:  begin sm[30].Add(sm[i]); sm[i].Caption := '(L,A,B)';  sm[i].Tag := 4;  sm[i].OnClick := @mnuSetColFormat;                            end;
        35: begin Items[2].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        36: begin Items[2].Add(sm[i]); sm[i].Caption := 'Ignore Duplicates';  sm[i].OnClick := @mnuIgnoreDups;    sm[i].Checked := IgnoreDups;        end;
        37: begin Items[2].Add(sm[i]); sm[i].Caption := 'Delete Duplicates';  sm[i].OnClick := @mnuDeleteDups;    sm[i].Shortcut := 16452{ctrl + D};  end;
        38: begin Items[2].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        39: begin Items[2].Add(sm[i]); sm[i].Caption := 'Show Matching Colours'; sm[i].OnClick := @mnuMatchCols;  sm[i].Shortcut := 16461{ctrl + M};  end;
      end;
  end;
end;

procedure CreateForm;
var
  pnl, pnlRight, pnlBottom: TPanel;
  //pnlLabels: array[0..3] of TPanel;
  //i: Integer;
begin
  with frm do
  begin
    Width := 800;
    Height := 600;
    Caption := 'ACA v3 - Nielsie95';
    Position := poScreenCenter;

    OnResize := @frmResize;
    OnKeyDown := @frmKeyDown;
  end;

  CreateMenu;

  pnl := TPanel.Create(frm);
  with pnl do
  begin
    Parent := frm;
    Align := alClient;
    BevelOuter := bvNone;

    sb := TScrollBox.Create(frm);
    with sb do
    begin
      Parent := pnl;
      Align := alClient;
      BorderStyle := bsNone;

      img := TImage.Create(frm);
      with img do
      begin
        Parent := sb;
        Width := 3000;
        Height := 3000;
        BorderStyle := bsNone;

        OnMouseDown := @imgMouseDown;
        OnMouseMove := @imgMouseMove;
      end;
    end;
  end;

  pnlRight := TPanel.Create(frm);
  with pnlRight do
  begin
    Parent := frm;
    Align := alRight;
    Width := 150;
    BevelOuter := bvNone;

    lb := TListBox.Create(frm);
    with lb do
    begin
      Parent := pnlRight;
      Align := alRight;
      Width := pnlRight.Width;

      Style := lbOwnerDrawFixed;
      DragMode := dmAutomatic;

      OnDragOver := @lbDragOver;
      OnDragDrop := @lbDragDrop;
      OnDrawItem := @lbDrawItem;
      OnMouseDown := @lbMouseDown;
      OnClick := @lbClick;
      OnKeyDown := @frmKeyDown; //For del
    end;

    pnlBottom := TPanel.Create(frm);
    with pnlBottom do
    begin
      Parent := pnlRight;
      Align := alBottom;
      Height := 210;
      BevelOuter := bvNone;

      btnAdd := TButton.Create(frm);
      with btnAdd do
      begin
        Parent := pnlBottom;
        Caption := 'Add';

        Top := 2;
        Width := (lb.Width - 2) div 2;
        Height := 20;

        //OnClick := @btnAddPoint;
      end;

      btnDel := TButton.Create(frm);
      with btnDel do
      begin
        Parent := pnlBottom;
        Caption := 'Delete';

        Top := 2;
        Left := btnAdd.Left + btnAdd.Width + 2;
        Width := btnAdd.Width - 1;
        Height := 20;

        OnClick := @btnDelColour;
      end;

      lblColour := TLabel.Create(frm);
      with lblColour do
      begin
        Parent := pnlBottom;
        Left := 5;
        Top := btnDel.Top + btnDel.Height + 10;
        Font.Size := 8;
      end;

      lblTolerance := TLabel.Create(frm);
      with lblTolerance do
      begin
        Parent := pnlBottom;
        Left := lblColour.Left;
        Top := lblColour.Top + lblColour.Height;
        Font.Size := 8;
      end;

      lblMod1 := TLabel.Create(frm);
      with lblMod1 do
      begin
        Parent := pnlBottom;
        Left := lblTolerance.Left;
        Top := lblTolerance.Top + lblTolerance.Height;
        Font.Size := 8;
      end;

      lblMod2 := TLabel.Create(frm);
      with lblMod2 do
      begin
        Parent := pnlBottom;
        Left := lblMod1.Left;
        Top := lblMod1.Top + lblMod1.Height;
        Font.Size := 8;
      end;

      rgCTS := TRadioGroup.Create(frm);
      with rgCTS do
      begin
        Parent := pnlBottom;
        Top := lblMod2.Top + lblMod2.Height + 6;
        Left := 15;
        Width := lb.Width - 30;
        Height := 95;

        Caption := 'CTS';
        Font.Size := 8;
        OnClick := @ctsChange;

        Items.Add('0: RGB Max');
        Items.Add('1: RGB Dist');
        Items.Add('2: HSL');
        Items.Add('3: CIELab');
      end;
    end;
  end;

  pnlBottom := TPanel.Create(frm);
  with pnlBottom do
  begin
    Parent := pnl;
    Align := alBottom;
    Height := 250;
    BevelOuter := bvNone;

    imgZoom := TImage.Create(frm);
    with imgZoom do
    begin
      Parent := pnlBottom;
      Left := 10;
      Top := 10;
      Width := 100;
      Height := 100;
    end;

    btnMark := TButton.Create(frm);
    with btnMark do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := imgZoom.Top + imgZoom.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Mark Color';

      OnClick := @mnuMatchCols;
    end;

    btnMarkBest := TButton.Create(frm);
    with btnMarkBest do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnMark.Top + btnMark.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Mark Best Color';

      OnClick := @mnuMatchCols;
    end;

    btnRefresh := TButton.Create(frm);
    with btnRefresh do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnMarkBest.Top + btnMarkBest.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Refresh Image';

      OnClick := @mnuRefresh;
    end;

    btnLoad := TButton.Create(frm);
    with btnLoad do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnRefresh.Top + btnRefresh.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Load Client';

      OnClick := @mnuClientImg;
    end;


  end;

  ResizeTimer := TTimer.Create(frm);
  with ResizeTimer do
  begin
    Interval := 25;
    OnTimer := @timerResize;
    Enabled := True;
  end;

  LoadClientBitmap;
end;

procedure ShowForm;
begin
  if (DefaultCTS3Mod = 0) then
    DefaultCTS3Mod := 1;

  if (bmp = nil) then
    bmp := TMufasaBitmap.Create;

  if (frm = nil) then
  begin
    frm := TForm.Create(nil);
    CreateForm;
  end;

  if frm.Showing then
    frm.BringToFront
  else
  begin
    mnuNew(nil); //Initialize
    {$ifdef PS_EXTENSION}
    frm.Show;
    {$else}
    frm.ShowModal;
    {$endif}
  end;
end;

{
  Simba integration
}

procedure OnClick(sender : TObject);
begin;
  ShowForm;
end;

procedure Init;
begin;
  Simba_Menu := TMenuItem.Create(Simba_MainMenu);
  Simba_Menu.Caption := 'AutoColorAid';
  Simba_MainMenu.Items.Items[4].Insert(5, Simba_Menu);
  Simba_Menu.OnClick := @OnClick;
end;

procedure Free;
begin
  FreeAndNil(bmpOverlay);
  FreeAndNil(bmpBuffer);
  FreeAndNil(bmp);
  if (frm <> nil) then
  begin
    frm.Free;
    frm := nil;
  end;
end;

procedure Attach;
begin;
  Simba_Menu.Visible := True;
end;

Procedure Detach;
begin
  Simba_Menu.Visible := False;
end;

function GetName: string;
begin;
  Result := 'ACA v3 (by Nielsie95)';
end;

function GetVersion : string;
begin;
  Result := Version;
end;

{$ifndef PS_EXTENSION}
procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('ShowForm', v);
end;

procedure ThreadSafe_FreeForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('Free', v);
end;
{$ENDIF}

begin
  frm := nil;
  bmp := nil;
  IgnoreDups := True;

  {$ifdef PS_EXTENSION}
  DefaultCTS3Mod := 1;
  {$else}
  DefaultCTS3Mod := GetToleranceSpeed3Modifier;
  Client := GetTClient;

  ThreadSafe_ShowForm;
  ThreadSafe_FreeForm;
  {$endif}
end.

(Runnable as extension or as regular script).

Anyone interested in finishing it? Or perhaps some ideas you'd like to see added?

~Nielsie95

Great job! Could you add an option to paint matches with blue or red?

Edit: Oh I see you have already done that!

Same as in the DTM editor: Image > Marking Colour > Red/White/Blue/etc.

Cts3 didn't seem to work.

Perhaps an option to highlight colors that reduce tolerance if you delete them would be nice?

That is pretty nice. Whenever I used ACA this was the most I used it for.
Aside from that I used the autocolor function generators a few times.

From: weequ
Cts3 didn't seem to work.

Perhaps an option to highlight colors that reduce tolerance if you delete them would be nice?

In ACA v2 you can see the tolerance per colour with the best colour. If it has the highest tolerance, you know that that colour is (one of) the main culprit(s). I'm not sure if it's a good idea to highlight the colour, as it might confuse some people.

My intentions were for learning and cts3. So this covers them both. When I get back home I'll probably throw some stuff in for you.

Maybe a color history tab with the colors hue/tol/other info… That would be sweet.

a history of highlighted colors to be more specific.

This seems kind of weird, but it would help a bit with ATPA filtering. I doubt it's possible, but can you allow users to click on a chunk of highlighted color (After you click show best color) and have it show its dimensions?

I don't understand, for the method InvertColour, why not just do:
[php]
function InvertColour(Colour: Integer): Integer;
begin
Result := not Colour;
end;
[/php]

?

EDIT: Don't worry, I guess you aren't actually inverting the colour as the name implies :p

Not sure of the function/Production but maybe make it Sort the Color TPA into Rectangles because that'd be cool :D and maybe help some people i guess

From: Daniel
I don't understand, for the method InvertColour, why not just do:
[php]
function InvertColour(Colour: Integer): Integer;
begin
Result := not Colour;
end;
[/php]

?

EDIT: Don't worry, I guess you aren't actually inverting the colour as the name implies :p

You're right, that function is now used to determine if a black/yellow or yellow/black colour scheme should be used. It used to return a contrasting colour (as still can be seen in old versions of the DTM editor). The function is used to show the colour (as text) in the zoom window.

The clicking on filtered points might be a nice addition, but would require a lot of work and I'm not sure if that would be worth it.

So how are you going to do CTS3?

Should be similar to cts 1, but with the Lab color space.

Any updates for this? Would be super useful for cts3. XD

From: Narcle
Any updates for this? Would be super useful for cts3. XD

I crtl-f'ed for cts 3 and found this. Please Niels we'll love you! :p Free beer if you do it.

procedure BestColour_CTS3;
var
  L, A, B: Extended;
begin
  L := Ceil((maxC.ll - minC.ll) / 2.0);
  A := Ceil((maxC.aa - minC.aa) / 2.0);
  B := Ceil((maxC.bb - minC.bb) / 2.0);

  BestColour := CIELabToColor(MinC.ll + L, MinC.aa + A, MinC.bb + B);
  BestTolerance := Ceil(Sqrt(L*L + A*A + B*B));

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

Working on the other stuff atm.

Added some more functionality

program ACA_Extension;
//ACA v3 for Simba By Nielsie95
//http://villavu.com/forum/showthread.php?t=70704

{$ifndef PS_EXTENSION}
var
  Client: TClient;
  Simba_MainMenu: TMainMenu;
{$endif}

{$i mml.simba}
const
  Version = '0.01';
  ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)

  sBestColour = 'Best colour - %s';
  sBestTol    = 'Tolerance - %d';
  sMod1_CTS2  = 'Hue mod: %f';
  sMod2_CTS2  = 'Sat mod: %f';

type
  TColourRec = record
    Colour: TColor;
    r, g, b: Integer;
    h, s, l: Extended;
    x, y, z: Extended;
    ll, aa, bb: Extended;
  end;
  TColorRecArray = array of TColourRec;

var
  Simba_Menu: TMenuItem;

  frm: TForm;
  mm: TMainMenu;
  sm: array [0..40] of TMenuItem;
  ResizeTimer: TTimer;

  sb: TScrollBox;
  img, imgZoom: TImage;
  lb: TListBox;
  btnAdd, btnDel, btnMark,
  btnMarkBest, btnRefresh, btnLoad: TButton;
  rgCTS: TRadioGroup;
  lblColour, lblTolerance, lblMod1, lblMod2: TLabel;

  bmpOverlay, bmpBuffer, bmp: TMufasaBitmap;
  sp: TPoint;
  Zoom: Single;
  MarkCol, ColFormat: Integer;
  IgnoreDups: Boolean;
  BufferChanged: Boolean;

  c: TColorRecArray;
  minC, maxC: TColourRec;
  BestColour, BestTolerance: Integer;
  BestMod1, BestMod2: Extended;

procedure FreeAndNil(var Bmp: TMufasaBitmap);
begin
  if (Bmp <> nil) then
  begin
    Bmp.Free;
    Bmp := nil;
  end;
end;

function RoundTo(x: Extended; n: Integer): Extended;
var
  p: Extended;
begin
  p := Pow(10, n);
  Result := Ceil(x * p) / p;
end;

function InvertColour(Colour: Integer; ForeGround: Boolean): Integer;
var
  h, s, l: Extended;
  r, g, b: Integer;
begin
  ColorToHSL(Colour, h, s, l);
  ColorToRGB(Colour, r, g, b);

  //http://www.nbdtech.com/Blog/archive/2008/04/27/Calculating-the-Perceived-Brightness-of-a-Color.aspx
  b := Round(Sqrt(r*r*0.241 + g*g*0.691 + b*b*0.068));
  s := Abs(l - 50);
  if ((s <= 35) and (b >= 130)) or ((s > 35) and (l > 65))then
    Result := clBlack
  else
    Result := clYellow;

  if (not ForeGround) then
    Result := clYellow - Result;
end;

function FixImgPoint(var x, y: Integer): Boolean;
begin
  x := x - sp.x;
  y := y - sp.y;
  if (Zoom <> 1.0) and (Zoom > 0.0) then
  begin
    x := Round(x / Zoom);
    y := Round(y / Zoom);
  end;
  Result := not ((x < 0) or (y < 0) or (x >= bmpBuffer.Width) or (y >= bmpBuffer.Height));
end;

function ColourRec(AColour: Integer): TColourRec;
begin
  with Result do
  begin
    Colour := AColour;
    ColorToRGB(AColour, r, g, b);
    ColorToHSL(AColour, h, s, l);
    ColorToXYZ(AColour, x, y, z);
    ColorToCIELab(AColour, ll, aa, bb);
  end;
end;

function ColourToString(Colour: TColourRec): string;
begin
  with Colour do
    case ColFormat of
      1: Result := Format('(%3d,%3d,%3d)', [r, g, b]);
      2: Result := Format('(%.0f,%.0f,%.0f)', [h, s, l]);
      3: Result := Format('(%.0f,%.0f,%.0f)', [x, y, z]);
      4: Result := Format('(%.0f,%.0f,%.0f)', [ll, aa, bb]);
      else Result := IntToStr(Colour);
    end;
end;

function IndexOfColour(Colour: Integer): Integer;
var
  i: Integer;
begin
  for i := High(c) downto 0 do
    if (c[i].Colour = Colour) then
    begin
      Result := i;
      Exit;
    end;
  Result := -1;
end;

procedure CheckColourBounds(Colour: TColourRec);
begin
  with Colour do
  begin
    if (r < minC.r) then minC.r := r;
    if (r > maxC.r) then maxC.r := r;
    if (g < minC.g) then minC.g := g;
    if (g > maxC.g) then maxC.g := g;
    if (b < minC.b) then minC.b := b;
    if (b > maxC.b) then maxC.b := b;

    if (h < minC.h) then minC.h := h;
    if (h > maxC.h) then maxC.h := h;
    if (s < minC.s) then minC.s := s;
    if (s > maxC.s) then maxC.s := s;
    if (l < minC.l) then minC.l := l;
    if (l > maxC.l) then maxC.l := l;

    if (x < minC.x) then minC.x := x;
    if (x > maxC.x) then maxC.x := x;
    if (y < minC.y) then minC.y := y;
    if (y > maxC.y) then maxC.y := y;
    if (z < minC.z) then minC.z := z;
    if (z > maxC.z) then maxC.z := z;

    if (ll < minC.ll) then minC.ll := ll;
    if (ll > maxC.ll) then maxC.ll := ll;
    if (aa < minC.aa) then minC.aa := aa;
    if (aa > maxC.aa) then maxC.aa := aa;
    if (bb < minC.bb) then minC.bb := bb;
    if (bb > maxC.bb) then maxC.bb := bb;
  end;
end;

procedure CalculateBounds(From: Integer);
var
  i: Integer;
begin
  if (Length(c) < 1) then
    Exit;
  if (From <= 0) then
  begin
    minC := c[0];
    maxC := c[0];
  end;
  if (From <> 0) then
    for i := High(c) downto 1 do
      CheckColourBounds(c[i]);
end;

procedure BestColour_CTS0;
var
  r, g, b: Integer;
begin
  r := Ceil((maxC.r - minC.r) / 2.0);
  g := Ceil((maxC.g - minC.g) / 2.0);
  b := Ceil((maxC.b - minC.b) / 2.0);

  BestColour := RGBToColor(MinC.r + r, MinC.g + g, MinC.b + b);
  BestTolerance := Max(Max(r, g), b);

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

procedure BestColour_CTS1;
var
  r, g, b: Integer;
begin
  r := Ceil((maxC.r - minC.r) / 2.0);
  g := Ceil((maxC.g - minC.g) / 2.0);
  b := Ceil((maxC.b - minC.b) / 2.0);

  BestColour := RGBToColor(MinC.r + r, MinC.g + g, MinC.b + b);
  BestTolerance := Ceil(Sqrt(r*r + g*g + b*b));

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

const
  MaxHue = 100;
  MedHue = 50;
function BestColour_CTS2_Hue(out MinU, MaxU: Extended): Extended;
var
  {MinU, MaxU, }MinD, MaxD: Extended;
  i: Integer;
begin
  Result := -1;
  if (Length(c) < 1) then
    Exit;

  MinU := MaxHue; MinD := MaxHue;
  MaxU := -1;     MaxD := -1;

  for i := High(c) downto 0 do
    if (c[i].h < MedHue) then
    begin
      if (c[i].h < MinU) then
        MinU := c[i].h;
      if (c[i].h > MaxU) then
        MaxU := c[i].h;
    end
    else
    begin
      if (c[i].h < MinD) then
        MinD := c[i].h;
      if (c[i].h > MaxD) then
        MaxD := c[i].h;
    end;

  if ((MaxU >= 0) <> (MaxD >= 0)) then
    if (MaxU >= 0) then
      Result := (MinU + MaxU) / 2
    else
    begin
      Result := (MinD + MaxD) / 2;
      MinU := MinD;
      MaxU := MaxD;
    end
  else
  begin
    if ((MaxHue - MaxD) + MinU) < (MaxD - MaxU) then
      MinU := MinD
    else
      MaxU := MaxD;

    Result := (MinU + MaxU) / 2;
    if (MinU > MaxU) then
      Result := Result - MedHue;
  end;

  Result := Result + MaxHue;
  while (Result >= MaxHue) do
    Result := Result - MaxHue;
end;

procedure BestColour_CTS2;
var
  h, s, l{,
  minH, maxH}: Extended;
begin
  //h := BestColour_CTS2_Hue(minH, maxH);
  h := (minC.h + maxC.h) / 2;
  s := (minC.s + maxC.s) / 2;
  l := (minC.l + maxC.l) / 2;

  BestColour := HSLToColor(h, s, l);
  ColorToHSL(BestColour, h, s, l);

  BestTolerance := Ceil(MaxE(maxC.l - l, l - minC.l));
  if (BestTolerance > 0) then
  begin
    //h := MaxE(MinE(Abs(minH - h), minH + MaxHue - h), MinE(Abs(maxH - h), maxH + MaxHue - h)) / BestTolerance;
    h := MaxE(maxC.h - h, h - minC.h) / BestTolerance;
    s := MaxE(maxC.s - s, s - minC.s) / BestTolerance;
    BestMod1 := RoundTo(h, 2);
    BestMod2 := RoundTo(s, 2);
  end
  else
  begin
    BestMod1 := 0;
    BestMod2 := 0;
  end;

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
  lblMod1.Caption := Format(sMod1_CTS2, [BestMod1]);
  lblMod2.Caption := Format(sMod2_CTS2, [BestMod2]);
end;

procedure BestColour_CTS3;
var
  L, A, B: Extended;
begin
  L := Ceil((maxC.ll - minC.ll) / 2.0);
  A := Ceil((maxC.aa - minC.aa) / 2.0);
  B := Ceil((maxC.bb - minC.bb) / 2.0);

  BestColour := CIELabToColor(MinC.ll + L, MinC.aa + A, MinC.bb + B);
  BestTolerance := Ceil(Sqrt(L*L + A*A + B*B));

  lblColour.Caption := Format(sBestColour, [ColourToString(ColourRec(BestColour))]);
  lblTolerance.Caption := Format(sBestTol, [BestTolerance]);
end;

procedure CalculateBestColour(RecalculateFrom: Integer);
begin
  CalculateBounds(RecalculateFrom);
  case rgCTS.ItemIndex of
    0: BestColour_CTS0;
    1: BestColour_CTS1;
    2: BestColour_CTS2;
    3: BestColour_CTS3;
  end;
end;

function AddColour(Colour: Integer): Integer;
begin
  Result := Length(c);
  SetLength(c, Result + 1);
  lb.Items.Add(IntToStr(Colour));

  c[Result] := ColourRec(Colour);
  CalculateBestColour(Result);
end;

procedure setActiveColour(Index: Integer);
var
  e: TNotifyEvent;
begin
  if (lb.ItemIndex <> Index) then
  begin
    e := lb.OnClick;
    lb.ItemIndex := Index;
    lb.OnClick := e;
  end;

  {if (Index > -1) then
    with c[Index] do
    begin
      edX.Text := IntToStr(x);
      edY.Text := IntToStr(y);
      edASize.Text := IntToStr(AreaSize);
      cbAShape.ItemIndex := AreaShape;
      edColour.Text := IntToStr(Colour);
      edTolerance.Text := IntToStr(Tolerance);
    end;}
end;

procedure ResetBuffer;
begin
  FreeAndNil(bmpBuffer);
  bmpBuffer := bmp.Copy(0, 0, bmp.Width - 1, bmp.Height - 1);
  BufferChanged := False;
end;

procedure UpdateBitmap(EnsurePaint: Boolean);
var
  b: TMufasaBitmap;
  tmpBitmap: TBitmap;
begin
  if (Zoom = 1.0) or (Zoom <= 0.0) then
    if (bmpOverlay <> nil) then
      b := bmpOverlay
    else
      b := bmpBuffer
  else
  begin
    if (bmpOverlay <> nil) then
      b := bmpOverlay.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1)
    else
      b := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
    b.StretchResize(Max(Round(b.Width * Zoom), 1), Max(Round(b.Height * Zoom), 1));
  end;

  img.Width := b.Width;
  img.Height := b.Height;
  img.Picture.Bitmap.Width := Max(b.Width, sb.ClientWidth);
  img.Picture.Bitmap.Height := Max(b.Height, sb.ClientHeight);

  if (sp.x > 0) and (sp.x + b.Width > sb.ClientWidth - 1) then
    EnsurePaint := True
  else if (sp.y > 0) and (sp.y + b.Height > sb.ClientHeight - 1) then
    EnsurePaint := True;
  sp := Point(0, 0);

  if (b.Width < sb.ClientWidth - 1) or (b.Height < sb.ClientHeight - 1) then
  begin
    if (b.Width < sb.ClientWidth - 1) then
    begin
      img.Width := sb.ClientWidth - 1;
      sp.x := (img.Width - b.Width) div 2;
    end;
    if (b.Height < sb.ClientHeight - 1) then
    begin
      img.Height := sb.ClientHeight - 1;
      sp.y := (img.Height - b.Height) div 2;
    end;

    with img.Canvas do
    begin
      Pen.Color := clNavy;
      Brush.Style := bsSolid;
      Brush.Color := clWhite;
      Rectangle(0, 0, img.Width - 1, img.Height - 1);
      Brush.Style := bsDiagCross;
      Brush.Color := clNavy;
      Rectangle(0, 0, img.Width - 1, img.Height - 1);
    end;
    EnsurePaint := True;
  end;

  if EnsurePaint then
  begin
    if (sp.x = 0) and (sp.y = 0) then
    begin
      tmpBitmap := b.ToTBitmap;
      img.Picture.Bitmap.Assign(tmpBitmap);
      tmpBitmap.Free;
    end
    else
      b.DrawToCanvas(sp.x, sp.y, img.Canvas);
  end;

  if (Zoom > 0.0) and (Zoom <> 1.0) then
    b.Free;
end;

procedure LoadClientBitmap;
var
  w, h: Integer;
begin
  GetClientDimensions(w, h);
  bmp.CopyClientToBitmap(client.IOManager,true,0,0,0,0,w-1,h-1);
  ResetBuffer;
  UpdateBitmap(True);
end;

procedure frmResize(Sender: TObject);
begin
  ResizeTimer.Enabled := False;
  ResizeTimer.Enabled := True;
end;

procedure frmKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_CONTROL) and (img.Cursor = crHandPoint) then
    img.Cursor := crDefault
  else if (Key = VK_DELETE) then
    btnDel.OnClick(nil);
end;

procedure timerResize(Sender: TObject);
begin
  //TTimer(Sender).Enabled := False;
  ResizeTimer.Enabled := False;
  UpdateBitmap(False);
end;

procedure edFilterText(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (not (
    (Key = VK_DELETE) or
    (Key = VK_BACK) or
    ((Key >= VK_0) and (Key <= VK_9)) or
    ((Key >= VK_Left) and (Key <= VK_DOWN)) or
    ((Key >= VK_NUMPAD0) and (Key <= VK_NUMPAD9))
  )) or (Shift <> []) then
    Key := 0;
end;

procedure mnuNew(Sender: TObject);
begin
  SetLength(c, 0);
  lb.Clear;

  sm[15].Click; //Zoom
  sm[20].Click; //Marking Colour
  sm[31].Click; //Colour Format

  rgCTS.ItemIndex := 1;
  lblColour.Caption := Format(sBestColour, ['~']);
  lblTolerance.Caption := Format(sBestTol, [0]);

  FreeAndNil(bmpOverlay);
  ResetBuffer;
  UpdateBitmap(True);
  frm.ActiveControl := lb;
end;

procedure mnuOpen(Sender: TObject);
var
  i: Integer;
  Cols: TIntegerArray;
begin
  with TOpenDialog.Create(frm) do
  begin
    Filter := 'AutoColorAid (*.aca)|*.aca|All files (*.*)|*.*|';
    Options := Options + [ofFileMustExist];

    if Execute then
      try
        with TStringList.Create do
        try
          LoadFromFile(FileName);

          SetLength(Cols, Count);
          for i := Count - 1 downto 0 do
            Cols[i] := StrToInt(Strings[i]);
        finally
          Free;
        end;

        mnuNew(nil);
        if (Length(Cols) > 0) then
        begin
          for i := 0 to High(Cols) do
            AddColour(Cols[i]);
          setActiveColour(0);
        end;
      except
        if (MessageDlg('Corrupt File', 'Invalid ACA file! Press OK to try loading another file.', mtError, [mbOk, mbCancel] {$ifdef PS_EXTENSION}, 0{$endif}) = 1) then
          mnuOpen(Sender);
      end;

    Free;
  end;
end;

procedure mnuSave(Sender: TObject);
begin
  with TSaveDialog.Create(frm) do
  begin
    Filter := 'AutoColorAid (*.aca)|*.aca|All files (*.*)|*.*|';
    Options := Options + [ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofOverwritePrompt];

    if Execute then
      if (Pos('.aca', FileName) < Length(FileName) - 4) then
        lb.Items.SaveToFile(FileName+'.aca')
      else
        lb.Items.SaveToFile(FileName);
    Free;
  end;
end;

procedure mnuExit(Sender: TObject);
begin
  frm.Close;
end;

procedure mnuOpenImg(Sender: TObject);
begin
  with TOpenDialog.Create(frm) do
  begin
    Filter := 'Graphic (*.bmp;*.xpm;*.png;*.pbm;*.pgm;*.ppm;*.ico;*.icns;*.cur;*.jpg;*.jpeg;*.jpe;*.jfif)|*.bmp;*.xpm;*.png;*.pbm;*.pgm;*.ppm;*.ico;*.icns;*.cur;*.jpg;*.jpeg;*.jpe;*.jfif|Bitmaps (*.bmp)|*.bmp|Pixmap (*.xpm)|*.xpm|Portable Network Graphic (*.png)|*.png|Portable PixMap (*.pbm;*.pgm;*.ppm)|*.pbm;*.pgm;*.ppm|Icon (*.ico)|*.ico|OSX Icon Resource (*.icns)|*.icns|Cursor (*.cur)|*.cur|Joint Picture Expert Group (*.jpg;*.jpeg;*.jpe;*.jfif)|*.jpg;*.jpeg;*.jpe;*.jfif|All files (*.*)|*.*|';
    Options := Options + [ofFileMustExist];
    if Execute then
    begin
      bmp.LoadFromFile(FileName);
      ResetBuffer;
      UpdateBitmap(True);
    end;
    Free;
  end;
end;

procedure mnuClientImg(Sender: TObject);
begin
  LoadClientBitmap;
end;

procedure mnuClientDesktop(Sender: TObject);
begin
  SetDesktopAsClient;
  LoadClientBitmap;
end;

procedure mnuZoom(Sender: TObject);
var
  i: Integer;
  z: Single;
begin
  for i := 0 to sm[12].Count - 1 do
    sm[12].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;

  z := TMenuItem(Sender).Tag / 100.0;
  if (Zoom <> z) then
  begin
    Zoom := z;
    UpdateBitmap(True);
  end;
end;

procedure mnuSetMarkCol(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[19].Count - 1 do
    sm[19].Items[i].Checked := False;

  TMenuItem(Sender).Checked := True;
  MarkCol := TMenuItem(Sender).Tag;
end;

procedure mnuRefresh(Sender: TObject);
begin
  if (bmpOverlay <> nil) then
    FreeAndNil(bmpOverlay)
  else
    ResetBuffer;
  UpdateBitmap(True);
end;

procedure mnuClearList(Sender: TObject);
begin
  SetLength(c, 0);
  lb.Clear;

  rgCTS.OnClick(nil);
  lblColour.Caption := Format(sBestColour, ['~']);
  lblTolerance.Caption := Format(sBestTol, [0]);
end;

procedure mnuDeleteDups(Sender: TObject);
var
  Cols: TColorRecArray;
  i: Integer;
begin
  Cols := c;
  mnuClearList(nil);

  for i := 0 to High(Cols) do
    if (IndexOfColour(Cols[i].Colour) < 0) then
      AddColour(Cols[i].Colour);
end;

procedure mnuSetColFormat(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[30].Count - 1 do
    sm[30].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;

  if (ColFormat <> TMenuItem(Sender).Tag) then
  begin
    ColFormat := TMenuItem(Sender).Tag;
    CalculateBestColour(Length(c));
    lb.Repaint;
  end;
end;

procedure mnuIgnoreDups(Sender: TObject);
begin
  IgnoreDups := not TMenuItem(Sender).Checked;
  TMenuItem(Sender).Checked := IgnoreDups;
end;

procedure mnuMatchCols(Sender: TObject);
var
  h: Integer;
  Points: TPointArray;
begin
  BufferChanged := True;

  h := GetImageTarget;
  if (bmpOverlay = nil) then
    bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
  SetTargetBitmap(bmpBuffer);

  {$IFNDEF PS_EXTENSION}
  SetColorToleranceSpeed(rgCTS.ItemIndex);
  SetToleranceSpeed2Modifiers(BestMod1, BestMod2);
  {$ENDIF}

  if FindColorsTolerance(Points, BestColour, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1, BestTolerance) then
    bmpOverlay.DrawTPA(Points, MarkCol);

  SetImageTarget(h);
  UpdateBitmap(True);
end;

procedure lbDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = lb);
end;

procedure lbDrawItem(Sender: TWinControl; Index: Integer; Rect: TRect; State: Byte);
begin
  with TListBox(Sender) do
    with Canvas do
    begin
      Brush.Style := bsSolid;
      if ((State and 1) > 0) then
        Brush.Color := clHighlight
      else if ((Index mod 2) = 0) then
        Brush.Color := clWindow
      else
        Brush.Color := $FDEEF4;
      Pen.Color := Brush.Color;
      FillRect(Rect);

      Pen.Color := clBlack;
      Brush.Color := c[Index].Colour;
      Rectangle(Rect.Right - (Rect.Bottom - Rect.Top - 4) - 2, Rect.Top + 2, Rect.Right - 2, Rect.Bottom - 2);

      Brush.Style := bsClear;
      TextOut(Rect.Left + 1, Rect.Top, ColourToString(c[Index]));
    end;
end;

var
  lbStartDrag: Integer;
procedure lbDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  lbEndDrag, i: Integer;
  tmp: TColourRec;
begin
  with lb do
  begin
    lbEndDrag := ItemAtPos(Point(x, y), True);
    if (lbStartDrag > -1) and (lbEndDrag > -1) and (lbStartDrag <> lbEndDrag) then
    begin
      Items.Move(lbStartDrag, lbEndDrag);

      if (lbStartDrag > lbEndDrag) then
      begin
        tmp := c[lbStartDrag];
        for i := lbStartDrag - 1 downto lbEndDrag do
          c[i + 1] := c[i];
        c[lbEndDrag] := tmp;
      end
      else
      begin
        tmp := c[lbStartDrag];
        for i := lbStartDrag to lbEndDrag - 1 do
          c[i] := c[i + 1];
        c[lbEndDrag] := tmp;
      end;

      setActiveColour(lbEndDrag);
    end;
  end;
end;

procedure lbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  lbStartDrag := lb.ItemAtPos(Point(x, y), True);
end;

procedure lbClick(Sender: TObject);
begin
  setActiveColour(lb.ItemIndex);
end;

procedure btnDelColour(Sender: TObject);
var
  curC, i, l: Integer;
begin
  curC := lb.ItemIndex;
  if (curC > -1) then
  begin
    l := High(c);
    for i := curC to l - 1 do
      Swap(c[i], c[i + 1]);
    SetLength(c, l);
    lb.Items.Delete(curC);

    if (curC = l) then
      Dec(curC);
    setActiveColour(curC);
    CalculateBestColour(-1);
  end;
end;

procedure ctsChange(Sender: TObject);
begin
  lblMod1.Visible := rgCTS.ItemIndex = 2;
  lblMod2.Visible := rgCTS.ItemIndex = 2;

  case rgCTS.ItemIndex of
    2:
      begin
        lblMod1.Caption := Format(sMod1_CTS2, [0.0]);
        lblMod2.Caption := Format(sMod2_CTS2, [0.0]);
      end;
    3:
      begin
        //lblMod1.Caption := Format(sMod1_CTS3, [BestMod1]);
        //lblMod2.Caption := Format(sMod2_CTS3, [BestMod2]);
      end;
  end;

  CalculateBestColour(Length(c));
end;

procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);
var
  Col, Idx: Integer;
begin
  frm.ActiveControl := lb;
  if (not FixImgPoint(x, y)) then
    Exit;

  Col := bmpBuffer.FastGetPixel(x, y);
  if IgnoreDups then
    Idx := IndexOfColour(Col)
  else
    Idx := -1;
  if (Idx < 0) then
    Idx := AddColour(Col);
  setActiveColour(Idx);
end;

procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  b, dx, dy, TheColour, AvgColour: Integer;
  px, py: Single;
  w, h: Single;
begin
  with imgZoom.Canvas do
  begin
    Pen.Color := clNavy;
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    Rectangle(0, 0, imgZoom.Width - 1, imgZoom.Height - 1);
    Brush.Style := bsDiagCross;
    Brush.Color := clNavy;
    Rectangle(1, 1, imgZoom.Width - 2, imgZoom.Height - 2);
  end;
  w := imgZoom.Width / (ZoomPixels + 0.0);
  h := imgZoom.Height / (ZoomPixels + 0.0);
  TheColour := -1;
  AvgColour := 0;

  try
    if (not FixImgPoint(x, y)) then
    begin
      img.Cursor := crDefault;
      Exit;
    end;

    px := 0.0;
    b := Floor(ZoomPixels / 2.0);
    for dx := -b to b do
    begin
      py := 0.0;
      for dy := -b to b do
      begin
        if ((x + dx) >= 0) and ((x + dx) < bmpBuffer.Width) and ((y + dy) >= 0) and ((y + dy) < bmpBuffer.Height) then
          with imgZoom.Canvas do
          begin
            Pen.Color := bmpBuffer.FastGetPixel(x + dx, y + dy);
            Brush.Style := bsSolid;
            Brush.Color := Pen.Color;

            if {(dx <= 0) and} (dy = -b) then
              AvgColour := AvgColour + Pen.Color;
            if (dx = 0) and (dy = 0) then
              TheColour := Pen.Color;

            Rectangle(Round(px), Round(py), Round(px + w), Round(py + h));
          end
        else if {(dx <= 0) and} (dy = -b) then
          AvgColour := AvgColour + clWhite;

        py := py + h;
      end;
      px := px + w;
    end;
  finally
    with imgZoom.Canvas do
    begin
      Pen.Color := MarkCol;
      Brush.Style := bsClear;
      Rectangle((imgZoom.Width shr 1) - Round(w / 2.0), (imgZoom.Height shr 1) - Round(h / 2.0), (imgZoom.Width shr 1) + Round(w / 2.0), (imgZoom.Height shr 1) + Round(h / 2.0));

      if (b > 0) then
        AvgColour := AvgColour div (b + 1);

      Font.Size := 8;
      Font.Color := InvertColour(AvgColour, False);
      TextOut(3, 3, 'Colour: ' + ColourToString(ColourRec(TheColour)));

      Font.Size := 8;
      Font.Color := InvertColour(AvgColour, True);
      TextOut(2, 2, 'Colour: ' + ColourToString(ColourRec(TheColour)));

      Pen.Color := 65536;
      Brush.Style := bsClear;
      Rectangle(0, 0, imgZoom.Width, imgZoom.Height);
    end;
  end;
end;

procedure CreateMenu;
var
  i: integer;
begin
  mm := TMainMenu.Create(frm);

  for i := 0 to 2 do
  begin
    sm[i] := TMenuItem.Create(frm);
    with sm[i] do
      case i of
        0: Caption := 'File';
        1: Caption := 'Image';
        2: Caption := 'Colours';
      end;
    mm.Items.Add(sm[i]);
  end;

  for i := 3 to High(sm) do
  begin
    sm[i] := TMenuItem.Create(frm);
    with mm.Items do
      case i of
        //File
        3:  begin Items[0].Add(sm[i]); sm[i].Caption := 'New';                sm[i].OnClick := @mnuNew;           sm[i].Shortcut := 16462{ctrl + N};  end;
        4:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Open Colours';       sm[i].OnClick := @mnuOpen;          sm[i].Shortcut := 16463{ctrl + O};  end;
        5:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Save Colours';       sm[i].OnClick := @mnuSave;          sm[i].Shortcut := 16467{ctrl + S};  end;
        6:  begin Items[0].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        7:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Exit';               sm[i].OnClick := @mnuExit;                                              end;

        //Image
        8:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Open Image';         sm[i].OnClick := @mnuOpenImg;       sm[i].Shortcut := 16460{ctrl + L};  end;
        9:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Load Client Image';  sm[i].OnClick := @mnuClientImg;                                         end;
        10: begin Items[1].Add(sm[i]); sm[i].Caption := 'Load Desktop Image'; sm[i].OnClick := @mnuClientDesktop;                                     end;
        11: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        12: begin Items[1].Add(sm[i]); sm[i].Caption := 'Zoom';                                                                                       end;
            13:  begin sm[12].Add(sm[i]); sm[i].Caption := '25%'; sm[i].Tag := 25;   sm[i].OnClick := @mnuZoom;                                       end;
            14:  begin sm[12].Add(sm[i]); sm[i].Caption := '50%'; sm[i].Tag := 50;   sm[i].OnClick := @mnuZoom;                                       end;
            15:  begin sm[12].Add(sm[i]); sm[i].Caption := '100%'; sm[i].Tag := 100; sm[i].OnClick := @mnuZoom;                                       end;
            16:  begin sm[12].Add(sm[i]); sm[i].Caption := '150%'; sm[i].Tag := 150; sm[i].OnClick := @mnuZoom;                                       end;
            17:  begin sm[12].Add(sm[i]); sm[i].Caption := '200%'; sm[i].Tag := 200; sm[i].OnClick := @mnuZoom;                                       end;
            18:  begin sm[12].Add(sm[i]); sm[i].Caption := '300%'; sm[i].Tag := 300; sm[i].OnClick := @mnuZoom;                                       end;
        19: begin Items[1].Add(sm[i]); sm[i].Caption := 'Marking Colour';                                                                             end;
            20:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Red';    sm[i].Tag := clRed;    sm[i].OnClick := @mnuSetMarkCol;                          end;
            21:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Blue';   sm[i].Tag := clBlue;   sm[i].OnClick := @mnuSetMarkCol;                          end;
            22:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Yellow'; sm[i].Tag := clYellow; sm[i].OnClick := @mnuSetMarkCol;                          end;
            23:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Green';  sm[i].Tag := clGreen;  sm[i].OnClick := @mnuSetMarkCol;                          end;
            24:  begin sm[19].Add(sm[i]); sm[i].Caption := 'Black';  sm[i].Tag := clBlack;  sm[i].OnClick := @mnuSetMarkCol;                          end;
            25:  begin sm[19].Add(sm[i]); sm[i].Caption := 'White';  sm[i].Tag := clWhite;  sm[i].OnClick := @mnuSetMarkCol;                          end;
        26: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        27: begin Items[1].Add(sm[i]); sm[i].Caption := 'Refresh Image';         sm[i].OnClick := @mnuRefresh;    sm[i].Shortcut := 116{F5};          end;

        //Colours
        28: begin Items[2].Add(sm[i]); sm[i].Caption := 'Add Colour';         {sm[i].OnClick := @mnuDTMfromString;}                                     end;
        29: begin Items[2].Add(sm[i]); sm[i].Caption := 'Clear List';         sm[i].OnClick := @mnuClearList;                                         end;
        30: begin Items[2].Add(sm[i]); sm[i].Caption := 'Display Format';                                                                             end;
            31:  begin sm[30].Add(sm[i]); sm[i].Caption := 'Color32';  sm[i].Tag := 0;  sm[i].OnClick := @mnuSetColFormat;                            end;
            32:  begin sm[30].Add(sm[i]); sm[i].Caption := '(R,G,B)';  sm[i].Tag := 1;  sm[i].OnClick := @mnuSetColFormat;                            end;
            33:  begin sm[30].Add(sm[i]); sm[i].Caption := '(H,S,L)';  sm[i].Tag := 2;  sm[i].OnClick := @mnuSetColFormat;                            end;
            34:  begin sm[30].Add(sm[i]); sm[i].Caption := '(X,Y,Z)';  sm[i].Tag := 3;  sm[i].OnClick := @mnuSetColFormat;                            end;
            40:  begin sm[30].Add(sm[i]); sm[i].Caption := '(L,A,B)';  sm[i].Tag := 4;  sm[i].OnClick := @mnuSetColFormat;                            end;
        35: begin Items[2].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        36: begin Items[2].Add(sm[i]); sm[i].Caption := 'Ignore Duplicates';  sm[i].OnClick := @mnuIgnoreDups;    sm[i].Checked := IgnoreDups;        end;
        37: begin Items[2].Add(sm[i]); sm[i].Caption := 'Delete Duplicates';  sm[i].OnClick := @mnuDeleteDups;    sm[i].Shortcut := 16452{ctrl + D};  end;
        38: begin Items[2].Add(sm[i]); sm[i].Caption := '-';                                                                                          end;
        39: begin Items[2].Add(sm[i]); sm[i].Caption := 'Show Matching Colours'; sm[i].OnClick := @mnuMatchCols;  sm[i].Shortcut := 16461{ctrl + M};  end;
      end;
  end;
end;

procedure CreateForm;
var
  pnl, pnlRight, pnlBottom: TPanel;
  pnlLabels: array[0..3] of TPanel;
  i: Integer;
begin
  with frm do
  begin
    Width := 800;
    Height := 600;
    Caption := 'ACA v3 - Nielsie95';
    Position := poScreenCenter;

    OnResize := @frmResize;
    OnKeyDown := @frmKeyDown;
  end;

  CreateMenu;

  pnl := TPanel.Create(frm);
  with pnl do
  begin
    Parent := frm;
    Align := alClient;
    BevelOuter := bvNone;

    sb := TScrollBox.Create(frm);
    with sb do
    begin
      Parent := pnl;
      Align := alClient;
      BorderStyle := bsNone;

      img := TImage.Create(frm);
      with img do
      begin
        Parent := sb;
        Width := 3000;
        Height := 3000;
        BorderStyle := bsNone;

        OnMouseDown := @imgMouseDown;
        OnMouseMove := @imgMouseMove;
      end;
    end;
  end;

  pnlRight := TPanel.Create(frm);
  with pnlRight do
  begin
    Parent := frm;
    Align := alRight;
    Width := 150;
    BevelOuter := bvNone;

    lb := TListBox.Create(frm);
    with lb do
    begin
      Parent := pnlRight;
      Align := alRight;
      Width := pnlRight.Width;

      Style := lbOwnerDrawFixed;
      DragMode := dmAutomatic;

      OnDragOver := @lbDragOver;
      OnDragDrop := @lbDragDrop;
      OnDrawItem := @lbDrawItem;
      OnMouseDown := @lbMouseDown;
      OnClick := @lbClick;
      OnKeyDown := @frmKeyDown; //For del
    end;

    pnlBottom := TPanel.Create(frm);
    with pnlBottom do
    begin
      Parent := pnlRight;
      Align := alBottom;
      Height := 210;
      BevelOuter := bvNone;

      btnAdd := TButton.Create(frm);
      with btnAdd do
      begin
        Parent := pnlBottom;
        Caption := 'Add';

        Top := 2;
        Width := (lb.Width - 2) div 2;
        Height := 20;

        //OnClick := @btnAddPoint;
      end;

      btnDel := TButton.Create(frm);
      with btnDel do
      begin
        Parent := pnlBottom;
        Caption := 'Delete';

        Top := 2;
        Left := btnAdd.Left + btnAdd.Width + 2;
        Width := btnAdd.Width - 1;
        Height := 20;

        OnClick := @btnDelColour;
      end;

      lblColour := TLabel.Create(frm);
      with lblColour do
      begin
        Parent := pnlBottom;
        Left := 5;
        Top := btnDel.Top + btnDel.Height + 10;
        Font.Size := 8;
      end;

      lblTolerance := TLabel.Create(frm);
      with lblTolerance do
      begin
        Parent := pnlBottom;
        Left := lblColour.Left;
        Top := lblColour.Top + lblColour.Height;
        Font.Size := 8;
      end;

      lblMod1 := TLabel.Create(frm);
      with lblMod1 do
      begin
        Parent := pnlBottom;
        Left := lblTolerance.Left;
        Top := lblTolerance.Top + lblTolerance.Height;
        Font.Size := 8;
      end;

      lblMod2 := TLabel.Create(frm);
      with lblMod2 do
      begin
        Parent := pnlBottom;
        Left := lblMod1.Left;
        Top := lblMod1.Top + lblMod1.Height;
        Font.Size := 8;
      end;

      rgCTS := TRadioGroup.Create(frm);
      with rgCTS do
      begin
        Parent := pnlBottom;
        Top := lblMod2.Top + lblMod2.Height + 6;
        Left := 15;
        Width := lb.Width - 30;
        Height := 95;

        Caption := 'CTS';
        Font.Size := 8;
        OnClick := @ctsChange;

        Items.Add('0: RGB Max');
        Items.Add('1: RGB Dist');
        Items.Add('2: HSL');
        Items.Add('3: CIELab');
      end;
    end;
  end;

  pnlBottom := TPanel.Create(frm);
  with pnlBottom do
  begin
    Parent := pnl;
    Align := alBottom;
    Height := 250;
    BevelOuter := bvNone;

    imgZoom := TImage.Create(frm);
    with imgZoom do
    begin
      Parent := pnlBottom;
      Left := 10;
      Top := 10;
      Width := 100;
      Height := 100;
      Canvas.Pen.Color := 65536;
      Canvas.Brush.Style := bsClear;
      Canvas.Rectangle(0, 0, Width, Height);
    end;

    btnMark := TButton.Create(frm);
    with btnMark do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := imgZoom.Top + imgZoom.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Mark Color';

      OnClick := @mnuMatchCols;
    end;

    btnMarkBest := TButton.Create(frm);
    with btnMarkBest do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnMark.Top + btnMark.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Mark Best Color';

      OnClick := @mnuMatchCols;
    end;

    btnRefresh := TButton.Create(frm);
    with btnRefresh do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnMarkBest.Top + btnMarkBest.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Refresh Image';

      OnClick := @mnuRefresh;
    end;

    btnLoad := TButton.Create(frm);
    with btnLoad do
    begin
      Parent := pnlBottom;
      Left := imgZoom.Left;
      Top := btnRefresh.Top + btnRefresh.Height + 5;
      Width := imgZoom.Width;
      Caption := 'Load Client';

      OnClick := @mnuClientImg;
    end;


  end;

  ResizeTimer := TTimer.Create(frm);
  with ResizeTimer do
  begin
    Interval := 25;
    OnTimer := @timerResize;
    Enabled := True;
  end;

  LoadClientBitmap;
end;

procedure ShowForm;
begin
  if (bmp = nil) then
    bmp := TMufasaBitmap.Create;

  if (frm = nil) then
  begin
    frm := TForm.Create(nil);
    CreateForm;
  end;

  if frm.Showing then
    frm.BringToFront
  else
  begin
    mnuNew(nil); //Initialize
    {$ifdef PS_EXTENSION}
    frm.Show;
    {$else}
    frm.ShowModal;
    {$endif}
  end;
end;

{
  Simba integration
}

procedure OnClick(sender : TObject);
begin;
  ShowForm;
end;

procedure Init;
begin;
  Simba_Menu := TMenuItem.Create(Simba_MainMenu);
  Simba_Menu.Caption := 'AutoColorAid';
  Simba_MainMenu.Items.Items[4].Insert(5, Simba_Menu);
  Simba_Menu.OnClick := @OnClick;
end;

procedure Free;
begin
  FreeAndNil(bmpOverlay);
  FreeAndNil(bmpBuffer);
  FreeAndNil(bmp);
  if (frm <> nil) then
  begin
    frm.Free;
    frm := nil;
  end;
end;

procedure Attach;
begin;
  Simba_Menu.Visible := True;
end;

Procedure Detach;
begin
  Simba_Menu.Visible := False;
end;

function GetName: string;
begin;
  Result := 'ACA v3 (by Nielsie95)';
end;

function GetVersion : string;
begin;
  Result := Version;
end;

{$ifndef PS_EXTENSION}
procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('ShowForm', v);
end;

procedure ThreadSafe_FreeForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('Free', v);
end;
{$ENDIF}

begin
  frm := nil;
  bmp := nil;
  IgnoreDups := True;

  {$ifndef PS_EXTENSION}
  Client := GetTClient;
  ThreadSafe_ShowForm;
  ThreadSafe_FreeForm;
  {$endif}
end.

<3

[your message is too short]

Thank you Mormonman and Nielsie95 (obviously). I've been using it and it's working pretty nice so far.

I'm not sure if that's going to be the final algorithm, just so you're aware. It uses the euclidean distance check for tolerance, which is what I read was used for CIE Lab…but I could be wrong.

Not sure if this belongs here, but here are like tons more ways of differentiating colors:
http://www.easyrgb.com/index.php?X=MATH

From: mormonman
I'm not sure if that's going to be the final algorithm, just so you're aware. It uses the euclidean distance check for tolerance, which is what I read was used for CIE Lab…but I could be wrong.

Fair enough. Are there modifiers we should use with CTS3, like in CTS2's Hue & Saturation modifiers, or is automatic with CTS3?

From: mormonman
but I could be wrong.

You are correct :)

From: Flight
Fair enough. Are there modifiers we should use with CTS3, like in CTS2's Hue & Saturation modifiers, or is automatic with CTS3?

No modifiers.

@Daniel, I'm correct in that its euclidean distance or wrong?

From: mormonman
No modifiers.

I think there's one modifier, but in most cases it's not needed.

Nielsie, I'm not sure if someone else said this (I didn't read the thread), but I don't think you need to include function generators. Let scripters create their own. :)

Yeah there's
SetColorModifier3(mod: extended)
or something like that

From: Coh3n

Nielsie, I'm not sure if someone else said this (I didn't read the thread), but I don't think you need to include function generators. Let scripters create their own. :)

I agree.

From: Narcle
Yeah there's
SetColorModifier3(mod: extended)
or something like that

The only thing I can think of modding is L(lightness)…

From: mormonman
The only thing I can think of modding is L(lightness)…

Yeah idk, would have to look at source.

From: mormonman
No modifiers.

@Daniel, I'm correct in that its euclidean distance or wrong?

There is one modifier. It only applies directly to the tolerance. (Distance)

From: mormonman
Added some more functionality

Cool, thanks!

From: Coh3n
Nielsie, I'm not sure if someone else said this (I didn't read the thread), but I don't think you need to include function generators. Let scripters create their own. :)

That's what I thought, but people like the generators.

From: Wizzup?
There is one modifier. It only applies directly to the tolerance. (Distance)

Its default is one, so it doesn't have much use.. At least, there's not much use for it in ACA. The best tolerance is just the tolerance divided by the modifier (which is the same with modifier 1).

EDIT: It would be possible to get rid of the rounding errors using the modifier.. Not sure if it's worth it, though.

From: Coh3n
I don't think you need to include function generators. Let scripters create their own. :)

Should we be using ACA v3 instead of the older versions with it's function generators ?

Is CTS3 better than CTS2 ?

As hue, saturation and tolerance are use with CTS2, what are the 'modifiers' (because I don't know the correct term to use here) that you use with CTS3 ?

Would it be worthwhile keeping the older version with the function generators in running order - as a teaching tool perhaps ? Or let me put it this way, are the functions generated by the old version still useful / valuable today ?

This is still work in progress, so it lacks a lot of features (including the function generators). CTS3 can be better than CTS2, yes. It all depends on what you're using it for and this tool is there to help you choose the right CTS. CTS3 has a modifier for tolerance (it just does Tolerance*sqrt(Modifier)). Not sure if the root thing is a bug, though.

Recently, a CTS2 bug in Simba was fixed. ACA v2 still generates "old" values as it has the bug too. So this version is more accurate for CTS2, but the function generators should still work in ACA v2 :)

EDIT: I've updated the first post with the latest version.

Thank you for the information and 'backroom' details re: bugs / update version. :)

EDIT: @nielsie95, when would CTS3 be your best (if not your only) option ?

Neilsie95, if you don't mind, could you attach the code to a .simba file or something on the main post. (For lazies like meh)

If you do mind, then I don't mind your minding…

Could we keep the "Find client by Name" feature? It's handy.

From: euphemism
Could we keep the "Find client by Name" feature? It's handy.

I have an even better implementation in mind :)

From: mormonman
I have an even better implementation in mind :)

I can only imagine!

I think that if someone does a bit more work on this, we can include it in the next Simba release.

From: Wizzup?
I think that if someone does a bit more work on this, we can include it in the next Simba release.

ive personally gone through, fixed a few bugs, changed the layout around slightly (cleaner/smaller), and added a print values button. what are you refering to by "work". you mean make it into aca v2 with all the tabs and such?

I have no idea on how to use this in a script :/

From: ssshhhaaa
I have no idea on how to use this in a script :/

Well, it is for finding colors. There is no code to copy from it like a dtm editor. Load runescape, find the color on screen you want to find, run aca.exe, click what color you want on aca and it outputs it in rgb(?) numbers.

From: uz3
Well, it is for finding colors. There is no code to copy from it like a dtm editor. Load runescape, find the color on screen you want to find, run aca.exe, click what color you want on aca and it outputs it in rgb(?) numbers.

This is an extension. So you just load it in simba.

Pretty nice :)

From: x[Warrior]x3500
ive personally gone through, fixed a few bugs, changed the layout around slightly (cleaner/smaller), and added a print values button. what are you refering to by "work". you mean make it into aca v2 with all the tabs and such?

Well, Nielsie95 had a list on his first post, I suppose that would be a good list. Although I must say I haven't used this in quite a while, so if you feel that it is quite feature complete and stable, we can get it in Simba 0.99 even.

Wait, so this would mean that CTS 3 would now be available?

And for what situation would you use what CTS?

The list in the first post is still up-to-date. It's stable, but not even near feature complete.

@Imagine: Yes, cts 3 is available. This version of ACA is also updated for the cts 2 bug fix (Simba 0.98.2 and onwards). There is no "better" cts, this tool is meant to help you choose the right one for a particular case.

From: Wizzup?
Well, Nielsie95 had a list on his first post, I suppose that would be a good list. Although I must say I haven't used this in quite a while, so if you feel that it is quite feature complete and stable, we can get it in Simba 0.99 even.

well this is my private version of it. yes, it isnt done, but its lookin good so far.

From: x[Warrior]x3500
well this is my private version of it. yes, it isnt done, but its lookin good so far.

Other than maybe couple organizational things, I would say this is pretty good.

I wouldn't want to expand on the function generating any more than that.

From: NCDS
Other than maybe couple organizational things, I would say this is pretty good.

I wouldn't want to expand on the function generating any more than that.

yah i stopped after the autocolor function because thats the only one i think should be in there.

From: x[Warrior]x3500
yah i stopped after the autocolor function because thats the only one i think should be in there.

Definitely. I don't say the other generators produced bad code, but they are discouraging people to make their own.