Simba/Extensions/dtm_editor.sex

program DTMEditor_Extension;
//(D)DTM Editor for Simba By Nielsie95
//http://villavu.com/forum/showthread.php?t=56151

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

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

var
  Simba_Menu: TMenuItem;

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

  sb: TScrollBox;
  img, imgZoom: TImage;
  pnl: TPanel;
  rbMouseClick: array[0..2] of TRadioButton;
  lb: TListBox;
  btnAdd, btnDel, btnMark: TButton;
  edX, edY, edASize, edColour, edTolerance: TEdit;
  cbAShape: TComboBox;
  shColour: TShape;

  bmpOverlay, bmpBuffer, bmp: TMufasaBitmap;
  sp: TPoint;
  Zoom: Single;
  p: TSDTMPointDefArray;
  curP: Integer;
  MarkCol: Integer;
  PaintDTM, BufferChanged: Boolean;

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

function GetLine(p1, p2: TPoint): TPointArray;
var
  dx, dy: Extended;
  i, d: Integer;
begin
  SetLength(Result, 0);
  dx := p2.x - p1.x;
  dy := p2.y - p1.y;
  d := Max(Round(Abs(dx)), Round(Abs(dy)));
  if (d = 0) then
    Exit;

  dx := dx / d;
  dy := dy / d;

  SetLength(Result, d + 1);
  for i := 0 to d do
  begin
    Result[i].x := p1.x + Round(dx * i);
    Result[i].y := p1.y + Round(dy * i);
  end;

  ClearDoubleTPA(Result);
end;

function InvertColor(Color: Integer): Integer;
var
  h, s, l: Extended;
begin
  ColorToHSL(Color, h, s, l);

  if (((h + s + l) < 120) and ((l < 75) or (h + s + l > 145))) or (l < 35) then
    Result := (clWhite * 3 + HSLtoColor(100 - (h / 2.0), 100, 100 - l)) div 4
  else if (h + s + l > 200) or (l > 75) then
    Result := HSLtoColor(100 - (h / 2.0), 100, 100 - l) div 2
  else
    Result := HSLtoColor(100 - (h / 2.0), 100, 100 - l) + clWhite div 3;
end;

function toSDTM: TSDTM;
var
  i, l: Integer;
begin
  if (Length(p) < 1) then
    Exit;

  with Result do
  begin
    MainPoint := p[0];
    l := Length(p) - 1;
    SetLength(SubPoints, l);

    for i := 0 to l - 1 do
      SubPoints[i] := p[i + 1];
  end;
end;

function DTMPointDef(x, y, Area, Shape, Color, Tolerance: Integer): TSDTMPointDef;
begin
  Result.x := x;
  Result.y := y;
  Result.AreaSize := Area;
  Result.AreaShape := Shape;
  Result.Color := Color;
  Result.Tolerance := Tolerance;
end;

function FindClosePoint(x, y, maxDist: Integer): Integer;
var
  i, d1, d2: Integer;
begin
  Result := -1;
  if (Length(p) < 1) then
    Exit;

  maxDist := Round(maxDist / Zoom);

  d1 := maxDist + 1;
  for i := High(p) downto 0 do
  begin
    d2 := Max(iAbs(p[i].x - x), iAbs(p[i].y - y)) - Max(Round(p[i].AreaSize * Zoom / 2.0), 1);

    if (d2 < d1) then
    begin
      d1 := d2;
      Result := i;
    end;
  end;

  if (Result > -1) and (d1 > maxDist) then
    Result := -1;
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 getIntFromEdit(Edit: TEdit): Integer;
begin
  Result := StrToIntDef(Edit.Text, -1);
  if (Result = -1) then
  begin
    Result := 0;
    Edit.Color := 7435495;
  end
  else
    Edit.Color := clWhite;
end;

function getX: Integer;
begin
  Result := getIntFromEdit(edX);
end;

function getY: Integer;
begin
  Result := getIntFromEdit(edY);
end;

function getASize: Integer;
begin
  Result := getIntFromEdit(edASize);
end;

function getAShape: Integer;
begin
  Result := cbAShape.ItemIndex;
  if (Result = -1) then
  begin
    Result := 0;
    cbAShape.Color := 7435495;
  end
  else
    cbAShape.Color := clWhite;
end;

function getColour: Integer;
begin
  Result := getIntFromEdit(edColour);
end;

function getTolerance: Integer;
begin
  Result := getIntFromEdit(edTolerance);
end;

procedure DrawDot(p: TSDTMPointDef; Color: Integer; OnBuffer: Boolean);
var
  x, y, z, w, h: Integer;
begin
  if OnBuffer then
  begin
    z := Max(p.AreaSize shr 1, 1);
    w := bmpBuffer.Width;
    h := bmpBuffer.Height;
    BufferChanged := True;
  end
  else
  begin
    z := Max(Round(p.AreaSize * Zoom / 2.0), 1);
    if (Zoom <> 1.0) and (Zoom > 0.0) then
    begin
      p.x := Round(p.x * Zoom);
      p.y := Round(p.y * Zoom);
    end;

    w := Round(bmpBuffer.Width * Zoom);
    h := Round(bmpBuffer.Height * Zoom);
  end;

  for x := -z to z do
    for y := -z to z do
      if (p.x + x >= 0) and (p.x + x < w) and (p.y + y >= 0) and (p.y + y < h) then
        if OnBuffer then
          bmpBuffer.FastSetPixel(p.x + x, p.y + y, Color)
        else
          img.Canvas.Pixels[p.x + x + sp.x, p.y + y + sp.y] := Color;
end;

procedure DrawDots(OnBuffer: Boolean);
var
  i: Integer;
begin
  for i := 0 to High(p) do
    DrawDot(p[i], MarkCol, OnBuffer);
end;

procedure DrawPoints(OnBuffer: Boolean);
var
  Points: TPointArray;
  a: Boolean;
  i: Integer;
  z: Single;
begin
  if (not PaintDTM) then
    Exit;
  a := DotTimer.Enabled;
  DotTimer.Enabled := False;

  if OnBuffer then
  begin
    for i := 1 to High(p) do
      Points := CombineTPA(Points, GetLine(Point(Max(Min(p[0].x, bmpBuffer.Width - 1), 0), Max(Min(p[0].y, bmpBuffer.Height - 1), 0)), Point(Max(Min(p[i].x, bmpBuffer.Width - 1), 0), Max(Min(p[i].y, bmpBuffer.Height - 1), 0))));
    bmpBuffer.DrawTPA(Points, MarkCol);

    DrawDots(True);
    BufferChanged := True;
  end
  else
  begin
    img.Canvas.Pen.Width := Max(Round(Zoom), 1);
    img.Canvas.Pen.Color := MarkCol;

    z := Zoom;
    if (Zoom <= 0.0) then
      Zoom := 1.0;

    for i := 1 to High(p) do
    begin
      img.Canvas.MoveTo(Round(Max(Min(p[0].x, bmpBuffer.Width - 1), 0) * z) + sp.x, Round(Max(Min(p[0].y, bmpBuffer.Height - 1), 0) * z) + sp.y);
      img.Canvas.LineTo(Round(Max(Min(p[i].x, bmpBuffer.Width - 1), 0) * z) + sp.x, Round(Max(Min(p[i].y, bmpBuffer.Height - 1), 0) * z) + sp.y);
    end;
    DrawDots(False);
  end;

  DotTimer.Enabled := a;
end;

function AddPoint(x, y, Area, Shape, Color, Tolerance: Integer): Integer;
begin
  Result := Length(p);
  SetLength(p, Result + 1);
  p[Result] := DTMPointDef(x, y, Area, Shape, Color, Tolerance);
  lb.Items.Add(ToStr(p[Result]));
end;

function DoAddPoint: Integer;
begin
  Result := AddPoint(getX, getY, getASize, getAShape, getColour, getTolerance);
end;

procedure setActivePoint(Index: Integer);
var
  a: Boolean;
  c: TNotifyEvent;
begin
  a := DotTimer.Enabled;
  DotTimer.Enabled := False;

  if (curP > -1) and (curP <> Index) then
    DrawDot(p[curP], MarkCol, False);

  curP := Index;
  if (lb.ItemIndex <> Index) then
  begin
    c := lb.OnClick;
    lb.ItemIndex := Index;
    lb.OnClick := c;
  end;

  if (curP > -1) then
    with p[curP] do
    begin
      edX.Text := IntToStr(x);
      edY.Text := IntToStr(y);
      edASize.Text := IntToStr(AreaSize);
      cbAShape.ItemIndex := AreaShape;
      edColour.Text := IntToStr(Color);
      edTolerance.Text := IntToStr(Tolerance);
    end;

  DotTimer.Enabled := a;
end;

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

procedure UpdateBitmap(EnsurePaint, BufferPoints: 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 BufferPoints then
      DrawPoints(True);

    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);

    if (not BufferPoints) then
      DrawPoints(False);
  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, False);
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, False);
end;

procedure timerDot(Sender: TObject);
begin
  if (not PaintDTM) then
    Exit;

  //TTimer(Sender).Enabled := False;
  DotTimer.Enabled := False;

  if (curP > -1) then
  begin
    if (TTimer(Sender).Tag = clYellow) then
      TTimer(Sender).Tag := clBlack
    else
      TTimer(Sender).Tag := clYellow;

    DrawDot(p[curP], TTimer(Sender).Tag, False);
  end;

  //TTimer(Sender).Enabled := True;
  DotTimer.Enabled := True;
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 edChange(Sender: TObject);
var
  pt: TSDTMPointDef;
begin
  with pt do
  begin
    x := getX;
    y := getY;
    AreaSize := getASize;
    AreaShape := getAShape;
    Color := getColour;
    shColour.Brush.Color := Color;
    Tolerance := getTolerance;
  end;

  if (curP > -1) and TWinControl(Sender).Focused then
  begin
    p[curP] := pt;
    lb.Items[curP] := ToStr(pt);

    UpdateBitmap(True, False);
  end;
end;

procedure mnuNew(Sender: TObject);
begin
  SetLength(p, 0);
  curP := -1;
  PaintDTM := True;

  lb.Clear;
  rbMouseClick[0].Checked := True; //Mouse click creates point
  sm[15].Click; //Zoom
  sm[20].Click; //Marking Colour

  cbAShape.ItemIndex := 0;
  edASize.Text := '1';
  edX.Text := '0';
  edY.Text := '0';
  edColour.Text := '0';
  edTolerance.Text := '0';
  shColour.Brush.Color := clWhite;

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

procedure mnuOpen(Sender: TObject);
begin
end;

procedure mnuSave(Sender: TObject);
begin
end;

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

procedure mnuOpenImg(Sender: TObject);
begin
  DotTimer.Enabled := False;
  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, ofOverwritePrompt];
    if Execute then
    begin
      bmp.LoadFromFile(FileName);
      ResetBuffer;
      UpdateBitmap(True, False);
    end;
    Free;
  end;
  DotTimer.Enabled := True;
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, False);
  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;

  if (MarkCol <> TMenuItem(Sender).Tag) then
  begin
    MarkCol := TMenuItem(Sender).Tag;
    UpdateBitmap(True, False);
  end;
end;

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

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

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

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

procedure mnuMatchDTMs(Sender: TObject);
var
  p1, p2: TPointArray;
  dtm, i, h: Integer;
begin
  BufferChanged := True;
  PaintDTM := False;

  if (Length(p) > 0) then
  begin
    dtm := Client.MDTMs.AddSDTM(toSDTM);
    h := GetImageTarget;
    if (bmpOverlay = nil) then
      bmpOverlay := bmpBuffer.Copy(0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1);
    SetTargetBitmap(bmpBuffer);

    if FindDTMs(dtm, p1, 0, 0, bmpBuffer.Width - 1, bmpBuffer.Height - 1) then
    begin
      for i := 0 to High(p1) do
        p2 := CombineTPA(p2,
          CombineTPA(
            GetLine(Point(Max(Min(p1[i].x - 4, bmpBuffer.Width - 1), 0), Max(Min(p1[i].y - 4, bmpBuffer.Height - 1), 0)), Point(Max(Min(p1[i].x + 4, bmpBuffer.Width - 1), 0), Max(Min(p1[i].y + 4, bmpBuffer.Height - 1), 0))),
            GetLine(Point(Max(Min(p1[i].x - 4, bmpBuffer.Width - 1), 0), Max(Min(p1[i].y + 4, bmpBuffer.Height - 1), 0)), Point(Max(Min(p1[i].x + 4, bmpBuffer.Width - 1), 0), Max(Min(p1[i].y - 4, bmpBuffer.Height - 1), 0)))
          )
        );
      bmpOverlay.DrawTPA(p2, MarkCol);
    end;

    SetImageTarget(h);
    FreeDTM(dtm);
  end;
  UpdateBitmap(True, False);
end;

procedure mnuRefresh(Sender: TObject);
begin
  PaintDTM := True;

  if (bmpOverlay <> nil) then
    FreeAndNil(bmpOverlay)
  else
    ResetBuffer;
  UpdateBitmap(True, False);
end;

procedure mnuDTMfromString(Sender: TObject);
var
  s: string;
  dtm, i: Integer;
  mdtm: TMDTM;
  sdtm: TSDTM;
begin
  if InputQuery('DTM From String', 'Enter DTM string:', s) and (s <> '') then
  begin
    try
      dtm := DTMFromString(Trim(s));
    except
      if (MessageDlg('Invalid DTM', 'Invalid string! Make sure you only enter the string (without quotes), not stuff like "DTM := DTMFromString("!', mtError, [mbOk, mbCancel] {$ifdef PS_EXTENSION}, 0{$endif}) = 1) then
        mnuDTMfromString(Sender);
      Exit;
    end;

    mnuNew(nil);
    mdtm := GetDTM(dtm);
    sdtm := MDTMToSDTM(mdtm);

    SetLength(p, mdtm.Count);
    if (mdtm.Count > 0) then
    begin
      p[0] := sdtm.MainPoint;
      for i := mdtm.Count - 1 downto 1 do
        p[i] := sdtm.SubPoints[i - 1];
    end;

    mdtm.Free;
    UpdateBitmap(True, False);
  end;
end;

procedure mnuPrintDTM(Sender: TObject);
var
  mdtm: TMDTM;
begin
  if (Length(p) > 0) then
  begin
    mdtm := SDTMToMDTM(toSDTM);
    WriteLn('');
    WriteLn('DTM := DTMFromString(''' + mdtm.ToString + ''');');
    WriteLn('');
    mdtm.Free;
  end;
end;

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

var
  lbStartDrag: Integer;
procedure lbDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  lbEndDrag, i: Integer;
  tmp: TSDTMPointDef;
begin
  DotTimer.Enabled := False;

  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 := p[lbStartDrag];
        for i := lbStartDrag - 1 downto lbEndDrag do
          p[i + 1] := p[i];
        p[lbEndDrag] := tmp;
      end
      else
      begin
        tmp := p[lbStartDrag];
        for i := lbStartDrag to lbEndDrag - 1 do
          p[i] := p[i + 1];
        p[lbEndDrag] := tmp;
      end;

      setActivePoint(lbEndDrag);
      if (lbStartDrag = 0) or (lbEndDrag = 0) then
        UpdateBitmap(True, False);
    end;
  end;

  DotTimer.Enabled := True;
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
  setActivePoint(lb.ItemIndex);
end;

procedure btnAddPoint(Sender: TObject);
begin
  setActivePoint(DoAddPoint);
  DrawPoints(False);
end;

procedure btnDelPoint(Sender: TObject);
var
  i, l: Integer;
begin
  if (curP > -1) then
  begin
    l := High(p);
    for i := curP to l - 1 do
      Swap(p[i], p[i + 1]);
    SetLength(p, l);
    lb.Items.Delete(curP);
    if (curP = l) then
      Dec(curP);
    setActivePoint(curP);
    UpdateBitmap(True, False);
  end;
end;

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

  if (not (ssCtrl in Shift)) then
  begin
    i := FindClosePoint(x, y, 1);
    if (i > -1) then
    begin
      setActivePoint(i);
      Exit;
    end;
  end;

  if (not rbMouseClick[2].Checked) then //Not Mouse click picks colour
  begin
    edX.Text := IntToStr(x);
    edY.Text := IntToStr(y);

    if rbMouseClick[1].Checked and (curP > -1) then
    begin
      p[curP].x := x;
      p[curP].y := y;
      lb.Items[curP] := ToStr(p[curP]);
      UpdateBitmap(True, False);
      Exit;
    end;
  end;

  if (not rbMouseClick[1].Checked) then //Not Mouse click moves point
  begin
    i := bmpBuffer.FastGetPixel(x, y);
    edColour.Text := IntToStr(i);

    if rbMouseClick[2].Checked and (curP > -1) then
    begin
      p[curP].Color := i;
      lb.Items[curP] := ToStr(p[curP]);
      Exit;
    end;
  end;

  if rbMouseClick[0].Checked then //Mouse click creates point
  begin
    setActivePoint(DoAddPoint);
    DrawPoints(False);
  end;
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(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;

    if PaintDTM and (not (ssCtrl in Shift)) and (FindClosePoint(x, y, 1) > -1) then
      img.Cursor := crHandPoint
    else
      img.Cursor := crDefault;

    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 := InvertColor(AvgColour);
      TextOut(2, 2, 'Colour: '+IntToStr(TheColour));
    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 := 'DTM';
      end;
    mm.Items.Add(sm[i]);
  end;

  for i := 3 to 31 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 DTM';           sm[i].OnClick := @mnuOpen;          sm[i].Shortcut := 16463{ctrl + O};  end;
        5:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Save DTM';           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 := 'Show Matching Colours'; sm[i].OnClick := @mnuMatchCols;  sm[i].Shortcut := 16461{ctrl + M};  end;
        28: begin Items[1].Add(sm[i]); sm[i].Caption := 'Show Matching DTM''s';  sm[i].OnClick := @mnuMatchDTMs;  sm[i].Shortcut := 16452{ctrl + D};  end;
        29: begin Items[1].Add(sm[i]); sm[i].Caption := 'Refresh Image';         sm[i].OnClick := @mnuRefresh;    sm[i].Shortcut := 116{F5};          end;

        //DTM
        30: begin Items[2].Add(sm[i]); sm[i].Caption := 'DTM From String';    sm[i].OnClick := @mnuDTMfromString;                                     end;
        31: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print DTM';          sm[i].OnClick := @mnuPrintDTM;      sm[i].Shortcut := 16464{ctrl + P};  end;
      end;
  end;
end;

procedure CreateForm;
var
  i: Integer;
begin
  with frm do
  begin
    Width := 800;
    Height := 600;
    Caption := 'Simba DDTM Editor - Nielsie95';

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

  CreateMenu;

  sb := TScrollBox.Create(frm);
  with sb do
  begin
    Parent := frm;
    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;

  pnl := TPanel.Create(frm);
  with pnl do
  begin
    Parent := frm;
    Align := alRight;
    Width := 230;
    BevelOuter := bvLowered;

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

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 120;
      Top := 20;
      Caption := 'Mouse Click:';
    end;

    for i := 0 to 2 do
    begin
      rbMouseClick[i] := TRadioButton.Create(frm);
      with rbMouseClick[i] do
      begin
        Parent := pnl;
        Left := 130;
        Top := 40 + (21 * i);
        case i of
          0 : Caption := 'Creates Point';
          1 : Caption := 'Moves Point';
          2 : Caption := 'Picks Colour';
        end;
        Height := 17;
        Width := 50;

        OnKeyDown := @frmKeyDown; //For delete "hotkey"
      end;
    end;

    //TBevel doesn't like bsTopLine
    with TShape.Create(frm) do
    begin
      Parent := pnl;
      Width := 220;
      Left := 5;
      Top := 117;
      //Style := bsTopLine;
      Height := 1;
    end;

    lb := TListBox.Create(frm);
    with lb do
    begin
      Parent := pnl;
      Left := 10;
      Top := 125;
      Width := 210;
      Height := 150;

      DragMode := dmAutomatic;
      OnDragOver := @lbDragOver;
      OnDragDrop := @lbDragDrop;
      OnMouseDown := @lbMouseDown;
      OnClick := @lbClick;
      OnKeyDown := @frmKeyDown; //For delete "hotkey"
    end;

    btnAdd := TButton.Create(frm);
    with btnAdd do
    begin
      Parent := pnl;
      Left := 10;
      Top := 280;
      Caption := 'Add Point';
      Width := 100;

      OnClick := @btnAddPoint;
    end;

    btnDel := TButton.Create(frm);
    with btnDel do
    begin
      Parent := pnl;
      Left := 120;
      Top := 280;
      Caption := 'Delete Point';
      Width := 100;

      OnClick := @btnDelPoint;
    end;

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 10;
      Top := 320;
      Caption := 'X:';
    end;

    edX := TEdit.Create(frm);
    with edX do
    begin
      Parent := pnl;
      Left := 30;
      Top := 315;
      Width := 80;
      BiDiMode := bdRightToLeft;

      OnKeyDown := @edFilterText;
      OnChange := @edChange;
    end;

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 120;
      Top := 320;
      Caption := 'Y:';
    end;

    edY := TEdit.Create(frm);
    with edY do
    begin
      Parent := pnl;
      Left := 140;
      Top := 315;
      Width := 80;
      BiDiMode := bdRightToLeft;

      OnKeyDown := @edFilterText;
      OnChange := @edChange;
    end;

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 10;
      Top := 350;
      Caption := 'Area Size:';
    end;

    edASize := TEdit.Create(frm);
    with edASize do
    begin
      Parent := pnl;
      Left := 65;
      Top := 345;
      Width := 45;
      BiDiMode := bdRightToLeft;

      OnKeyDown := @edFilterText;
      OnChange := @edChange;
    end;

    cbAShape := TComboBox.Create(frm);
    with cbAShape do
    begin
      Parent := pnl;
      Left := 120;
      Top := 345;
      Width := 100;

      Items.Add('Rectangle');
      Items.Add('Cross');
      Items.Add('Diagonal Cross');

      Style := csDropDownList;
      OnChange := @edChange;
    end;

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 10;
      Top := 380;
      Caption := 'Colour:';
    end;

    edColour := TEdit.Create(frm);
    with edColour do
    begin
      Parent := pnl;
      Left := 55;
      Top := 375;
      Width := 100;
      BiDiMode := bdRightToLeft;

      OnKeyDown := @edFilterText;
      OnChange := @edChange;
    end;

    shColour := TShape.Create(frm);
    with shColour do
    begin
      Parent := pnl;
      Left := 165;
      Top := 375;
      Width := 55;
      Height := edColour.Height;
    end;

    with TLabel.Create(frm) do
    begin
      Parent := pnl;
      Left := 10;
      Top := 410;
      Caption := 'Tolerance:';
    end;

    edTolerance := TEdit.Create(frm);
    with edTolerance do
    begin
      Parent := pnl;
      Left := 70;
      Top := 405;
      Width := 85;
      BiDiMode := bdRightToLeft;

      OnKeyDown := @edFilterText;
      OnChange := @edChange;
    end;

    btnMark := TButton.Create(frm);
    with btnMark do
    begin
      Parent := pnl;
      Left := 165;
      Top := 405;
      Width := 55;
      Height := edColour.Height;
      Caption := 'Mark';

      OnClick := @mnuMatchCols;
    end;

    //edX, edY, edASize, edAShape, edColour, edTolerance
  end;

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

  DotTimer := TTimer.Create(frm);
  with DotTimer do
  begin
    Interval := 200;
    OnTimer := @timerDot;
    Enabled := True;
  end;

  LoadClientBitmap;
  mnuNew(nil); //Initialize
end;

function ShowForm: Integer;
begin
  frm := TForm.Create(nil);
  bmp := TMufasaBitmap.Create;

  try
    CreateForm;
    Result := frm.ShowModal;
  finally
    FreeAndNil(bmpOverlay);
    FreeAndNil(bmpBuffer);
    bmp.Free;
    frm.Free;
  end;
end;

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

{
  Simba integration
}
 
procedure OnClick(sender : TObject);
begin;
  ShowForm;
end;

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

procedure Free;
begin
end;

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

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

function GetName: string;
begin;
  Result := 'DDTM Editor (by Nielsie95)';
end;

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

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