SRL Archive - Development

We are in the need of all of these 'tools'. They can be written using extensions! So if anyone wants to make such a tool, please do so! Don't hesitate to ask for any help, I'll gladly help you :).

Btw, there should be some good DTM editors around already (Nielsie?) Maybe we can port this to be run in PascalScript?

What exactly should/could be in the bitmap editor? Bitmap to and from string and crop are the things I can think of?

From: nielsie95
What exactly should/could be in the bitmap editor? Bitmap to and from string and crop are the things I can think of?

Well, optionally stuff like contrast, brightness, etc can be added. It's in the default Simba library anyway.

Well it kinda neems some kind of selection thingy like SCAR and some way to zoom out, for huge bitmaps :D

Grab the bitmap from the selected client option?

Some more docs on extentions should probably be written up… I haven't a clue how they even work.

From: Nava2
Some more docs on extentions should probably be written up… I haven't a clue how they even work.

How what works? Porting a DTM editor to be an extension is probably the least of your concern, fix me a DTM editor and I'll show you how to port that shit!

Thanks Ray, but there really should be some better doc on the subject :<

From: Nava2
Thanks Ray, but there really should be some better doc on the subject :<

File a bug / request then. It doesn't really belong here. :)

I've started to work on a DDTM editor (and I'm thinking about adding the bmp editor functionality as the editors will probably have overlapping functionalities). There are just a few problems though, for instance

Canvas.Rectangle(0, 0, b.Width - 1, b.Height - 1);

doesn't compile =\

From: nielsie95
I've started to work on a DDTM editor (and I'm thinking about adding the bmp editor functionality as the editors will probably have overlapping functionalities). There are just a few problems though, for instance

Canvas.Rectangle(0, 0, b.Width - 1, b.Height - 1);

doesn't compile =\

Oh, yes, I still need to add those to the core :duh:.

program DDTMEditor;

const
  ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)

var
  frm: TForm;
  mm: TMainMenu;
  sm: array [0..30] of TMenuItem;
  sb: TScrollBox;
  img: TImage;
  pnl: TPanel;
  imgZoom: TImage;
  rbMouseClick: array[0..2] of TRadioButton;
  lb: TListBox;
  btnAdd, btnDel: TButton;

  ResizeTimer: TTimer;
  DotTimer: TTimer;

  bmpBuffer, bmp: TMufasaBitmap;
  sp: TPoint;
  Zoom: Single;
  p: TDTMPointDefArray;
  curP: Integer;

  MarkCol: Integer;

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

function DTMPointDef(x, y, Area, Shape, Color, Tolerance: Integer): TDTMPointDef;
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 >= bmp.Width) or (y >= bmp.Height));
end;

procedure DrawDot(p: TDTMPointDef; Color: Integer; OnBuffer: Boolean);
var
  x, y, z: Integer;
begin
  if OnBuffer then
    z := Max(p.AreaSize shr 1, 1)
  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;
  end;

  for x := -z to z do
    for y := -z to z do
      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
  a := DotTimer.Enabled;
  DotTimer.Enabled := False;

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

    DrawDots(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(p[0].x * z) + sp.x, Round(p[0].y * z) + sp.y);
      img.Canvas.LineTo(Round(p[i].x * z) + sp.x, Round(p[i].y * 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;

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

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

  curP := Index;
  if (lb.ItemIndex <> Index) then
    lb.ItemIndex := Index;
  DotTimer.Enabled := a;
end;

procedure ResetBuffer;
begin
  if (bmpBuffer <> nil) then
    bmpBuffer.Free;

  bmpBuffer := bmp.Copy(0, 0, bmp.Width - 1, bmp.Height - 1);
end;

procedure UpdateBitmap(EnsurePaint, BufferPoints: Boolean);
var
  b: TMufasaBitmap;
begin
  if (Zoom = 1.0) or (Zoom <= 0.0) then
    b := bmpBuffer
  else
  begin
    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;

  if (sp.x > 0) and (sp.x + b.Width > sb.ClientWidth - 1) then
    EnsurePaint := True;
  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);
    DrawBitmap(b.Index, img.Canvas, sp.x, sp.y);
    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.SetSize(w, h);
  CopyClientToBitmap(bmp.Index, 0, 0, w - 1, h - 1);

  ResetBuffer;
  UpdateBitmap(True, False);
end;

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

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

procedure timerDot(Sender: TObject);
begin
  //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 mnuNew(Sender: TObject);
begin
  SetLength(p, 0);
  curP := -1;

  lb.Clear;
  sm[14].Click;
  sm[19].Click;

  ResetBuffer;
  UpdateBitmap(True, False);
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 mnuZoom(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[11].Count - 1 do
    sm[11].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;
  Zoom := TMenuItem(Sender).Tag / 100.0;
  UpdateBitmap(True, False);
end;

procedure mnuSetMarkCol(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[18].Count - 1 do
    sm[18].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;
  MarkCol := TMenuItem(Sender).Tag;
  UpdateBitmap(True, False);
end;

procedure mnuRefresh(Sender: TObject);
begin
  ResetBuffer;
  UpdateBitmap(True, False);
end;

procedure mnuPrintDTM(Sender: TObject);
begin
end;

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

procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);
var
  i: Integer;
begin
  if (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;

  setActivePoint(AddPoint(x, y, 1, 1, 0, 0));
  DrawPoints(False);
end;

procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  b, dx, dy: 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);

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

    if (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) < bmp.Width) and ((y + dy) >= 0) and ((y + dy) < bmp.Height) then
          with imgZoom.Canvas do
          begin
            Pen.Color := bmp.FastGetPixel(x + dx, y + dy);
            Brush.Style := bsSolid;
            Brush.Color := Pen.Color;
            Rectangle(Round(px), Round(py), Round(px + w), Round(py + h));
          end;

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

procedure frmKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_CONTROL) and (img.Cursor = crHandPoint) then
    img.Cursor := crDefault;
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 := 'Print';
      end;
    mm.Items.Add(sm[i]);
  end;

  for i := 3 to 30 do
  begin
    sm[i] := TMenuItem.Create(frm);
    with mm.Items do
      case i of
        3:  begin Items[0].Add(sm[i]); sm[i].Caption := 'New';                   sm[i].OnClick := @mnuNew;        end;
        4:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Open DTM';                                               end;
        5:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Save DTM';                                               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;
        8:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Open Image';            sm[i].OnClick := @mnuOpenImg;    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 := '-';                                                      end;
        11: begin Items[1].Add(sm[i]); sm[i].Caption := 'Zoom';                                                   end;
            12:  begin sm[11].Add(sm[i]); sm[i].Caption := '25%'; sm[i].Tag := 25;   sm[i].OnClick := @mnuZoom;   end;
            13:  begin sm[11].Add(sm[i]); sm[i].Caption := '50%'; sm[i].Tag := 50;   sm[i].OnClick := @mnuZoom;   end;
            14:  begin sm[11].Add(sm[i]); sm[i].Caption := '100%'; sm[i].Tag := 100; sm[i].OnClick := @mnuZoom;   end;
            15:  begin sm[11].Add(sm[i]); sm[i].Caption := '150%'; sm[i].Tag := 150; sm[i].OnClick := @mnuZoom;   end;
            16:  begin sm[11].Add(sm[i]); sm[i].Caption := '200%'; sm[i].Tag := 200; sm[i].OnClick := @mnuZoom;   end;
            17:  begin sm[11].Add(sm[i]); sm[i].Caption := '300%'; sm[i].Tag := 300; sm[i].OnClick := @mnuZoom;   end;
        18: begin Items[1].Add(sm[i]); sm[i].Caption := 'Marking Colour';                                         end;
            19:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Red';    sm[i].Tag := clRed;    sm[i].OnClick := @mnuSetMarkCol; end;
            20:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Blue';   sm[i].Tag := clBlue;   sm[i].OnClick := @mnuSetMarkCol; end;
            21:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Yellow'; sm[i].Tag := clYellow; sm[i].OnClick := @mnuSetMarkCol; end;
            22:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Green';  sm[i].Tag := clGreen;  sm[i].OnClick := @mnuSetMarkCol; end;
            23:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Black';  sm[i].Tag := clBlack;  sm[i].OnClick := @mnuSetMarkCol; end;
            24:  begin sm[18].Add(sm[i]); sm[i].Caption := 'White';  sm[i].Tag := clWhite;  sm[i].OnClick := @mnuSetMarkCol; end;

        25: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                      end;
        26: begin Items[1].Add(sm[i]); sm[i].Caption := 'Show Matching Pixels';                                   end;
        27: begin Items[1].Add(sm[i]); sm[i].Caption := 'Show Matching DTM''s';                                   end;
        28: begin Items[1].Add(sm[i]); sm[i].Caption := 'Refresh Image';         sm[i].OnClick := @mnuRefresh;    end;
        29: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print DTM';             sm[i].OnClick := @mnuPrintDTM;   end;
        30: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print DDTM';                                             end;
      end;
  end;
end;

procedure CreateForm;
var
  i: Integer;
begin
  with frm do
  begin
    Width := 600;
    Height := 400;
    Caption := 'Simba DDTM Editor - Nielsie95';
    OnResize := @frmResize;
  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;

      with TMufasaBitmap.Create do
      begin
        SetSize(3000, 3000);
        DrawBitmap(Index, Canvas, 0, 0);
        Free;
      end;
    end;
  end;
  frm.OnKeyDown := @frmKeyDown;

  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 : begin Caption := 'Creates Point'; Checked := True; end;
          1 : Caption := 'Moves Point';
          2 : Caption := 'Picks Colour';
        end;
        Height := 17;
        Width := 50;
      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;
      OnClick := @lbClick;
    end;

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

    btnDel := TButton.Create(frm);
    with btnDel do
    begin
      Parent := pnl;
      Left := 120;
      Top := 280;
      Caption := 'Delete Point';
      Width := 100;
    end;
  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
    if (bmpBuffer <> nil) then
      bmpBuffer.Free;
    bmp.Free;
    frm.Free;
  end;
end;

procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('ShowForm', v);
end;

begin
  ThreadSafe_ShowForm;
end.

This is what I have currently :)
How can I convert a TDTM/pDTM to a string?

From: nielsie95

program DDTMEditor;

const
  ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)

var
  frm: TForm;
  mm: TMainMenu;
  sm: array [0..30] of TMenuItem;
  sb: TScrollBox;
  img: TImage;
  pnl: TPanel;
  imgZoom: TImage;
  rbMouseClick: array[0..2] of TRadioButton;
  lb: TListBox;
  btnAdd, btnDel: TButton;

  ResizeTimer: TTimer;
  DotTimer: TTimer;

  bmpBuffer, bmp: TMufasaBitmap;
  sp: TPoint;
  Zoom: Single;
  p: TDTMPointDefArray;
  curP: Integer;

  MarkCol: Integer;

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

function DTMPointDef(x, y, Area, Shape, Color, Tolerance: Integer): TDTMPointDef;
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 >= bmp.Width) or (y >= bmp.Height));
end;

procedure DrawDot(p: TDTMPointDef; Color: Integer; OnBuffer: Boolean);
var
  x, y, z: Integer;
begin
  if OnBuffer then
    z := Max(p.AreaSize shr 1, 1)
  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;
  end;

  for x := -z to z do
    for y := -z to z do
      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
  a := DotTimer.Enabled;
  DotTimer.Enabled := False;

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

    DrawDots(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(p[0].x * z) + sp.x, Round(p[0].y * z) + sp.y);
      img.Canvas.LineTo(Round(p[i].x * z) + sp.x, Round(p[i].y * 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;

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

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

  curP := Index;
  if (lb.ItemIndex <> Index) then
    lb.ItemIndex := Index;
  DotTimer.Enabled := a;
end;

procedure ResetBuffer;
begin
  if (bmpBuffer <> nil) then
    bmpBuffer.Free;

  bmpBuffer := bmp.Copy(0, 0, bmp.Width - 1, bmp.Height - 1);
end;

procedure UpdateBitmap(EnsurePaint, BufferPoints: Boolean);
var
  b: TMufasaBitmap;
begin
  if (Zoom = 1.0) or (Zoom <= 0.0) then
    b := bmpBuffer
  else
  begin
    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;

  if (sp.x > 0) and (sp.x + b.Width > sb.ClientWidth - 1) then
    EnsurePaint := True;
  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);
    DrawBitmap(b.Index, img.Canvas, sp.x, sp.y);
    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.SetSize(w, h);
  CopyClientToBitmap(bmp.Index, 0, 0, w - 1, h - 1);

  ResetBuffer;
  UpdateBitmap(True, False);
end;

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

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

procedure timerDot(Sender: TObject);
begin
  //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 mnuNew(Sender: TObject);
begin
  SetLength(p, 0);
  curP := -1;

  lb.Clear;
  sm[14].Click;
  sm[19].Click;

  ResetBuffer;
  UpdateBitmap(True, False);
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 mnuZoom(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[11].Count - 1 do
    sm[11].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;
  Zoom := TMenuItem(Sender).Tag / 100.0;
  UpdateBitmap(True, False);
end;

procedure mnuSetMarkCol(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to sm[18].Count - 1 do
    sm[18].Items[i].Checked := False;
  TMenuItem(Sender).Checked := True;
  MarkCol := TMenuItem(Sender).Tag;
  UpdateBitmap(True, False);
end;

procedure mnuRefresh(Sender: TObject);
begin
  ResetBuffer;
  UpdateBitmap(True, False);
end;

procedure mnuPrintDTM(Sender: TObject);
begin
end;

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

procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; x, y: integer);
var
  i: Integer;
begin
  if (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;

  setActivePoint(AddPoint(x, y, 1, 1, 0, 0));
  DrawPoints(False);
end;

procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  b, dx, dy: 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);

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

    if (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) < bmp.Width) and ((y + dy) >= 0) and ((y + dy) < bmp.Height) then
          with imgZoom.Canvas do
          begin
            Pen.Color := bmp.FastGetPixel(x + dx, y + dy);
            Brush.Style := bsSolid;
            Brush.Color := Pen.Color;
            Rectangle(Round(px), Round(py), Round(px + w), Round(py + h));
          end;

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

procedure frmKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_CONTROL) and (img.Cursor = crHandPoint) then
    img.Cursor := crDefault;
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 := 'Print';
      end;
    mm.Items.Add(sm[i]);
  end;

  for i := 3 to 30 do
  begin
    sm[i] := TMenuItem.Create(frm);
    with mm.Items do
      case i of
        3:  begin Items[0].Add(sm[i]); sm[i].Caption := 'New';                   sm[i].OnClick := @mnuNew;        end;
        4:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Open DTM';                                               end;
        5:  begin Items[0].Add(sm[i]); sm[i].Caption := 'Save DTM';                                               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;
        8:  begin Items[1].Add(sm[i]); sm[i].Caption := 'Open Image';            sm[i].OnClick := @mnuOpenImg;    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 := '-';                                                      end;
        11: begin Items[1].Add(sm[i]); sm[i].Caption := 'Zoom';                                                   end;
            12:  begin sm[11].Add(sm[i]); sm[i].Caption := '25%'; sm[i].Tag := 25;   sm[i].OnClick := @mnuZoom;   end;
            13:  begin sm[11].Add(sm[i]); sm[i].Caption := '50%'; sm[i].Tag := 50;   sm[i].OnClick := @mnuZoom;   end;
            14:  begin sm[11].Add(sm[i]); sm[i].Caption := '100%'; sm[i].Tag := 100; sm[i].OnClick := @mnuZoom;   end;
            15:  begin sm[11].Add(sm[i]); sm[i].Caption := '150%'; sm[i].Tag := 150; sm[i].OnClick := @mnuZoom;   end;
            16:  begin sm[11].Add(sm[i]); sm[i].Caption := '200%'; sm[i].Tag := 200; sm[i].OnClick := @mnuZoom;   end;
            17:  begin sm[11].Add(sm[i]); sm[i].Caption := '300%'; sm[i].Tag := 300; sm[i].OnClick := @mnuZoom;   end;
        18: begin Items[1].Add(sm[i]); sm[i].Caption := 'Marking Colour';                                         end;
            19:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Red';    sm[i].Tag := clRed;    sm[i].OnClick := @mnuSetMarkCol; end;
            20:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Blue';   sm[i].Tag := clBlue;   sm[i].OnClick := @mnuSetMarkCol; end;
            21:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Yellow'; sm[i].Tag := clYellow; sm[i].OnClick := @mnuSetMarkCol; end;
            22:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Green';  sm[i].Tag := clGreen;  sm[i].OnClick := @mnuSetMarkCol; end;
            23:  begin sm[18].Add(sm[i]); sm[i].Caption := 'Black';  sm[i].Tag := clBlack;  sm[i].OnClick := @mnuSetMarkCol; end;
            24:  begin sm[18].Add(sm[i]); sm[i].Caption := 'White';  sm[i].Tag := clWhite;  sm[i].OnClick := @mnuSetMarkCol; end;

        25: begin Items[1].Add(sm[i]); sm[i].Caption := '-';                                                      end;
        26: begin Items[1].Add(sm[i]); sm[i].Caption := 'Show Matching Pixels';                                   end;
        27: begin Items[1].Add(sm[i]); sm[i].Caption := 'Show Matching DTM''s';                                   end;
        28: begin Items[1].Add(sm[i]); sm[i].Caption := 'Refresh Image';         sm[i].OnClick := @mnuRefresh;    end;
        29: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print DTM';             sm[i].OnClick := @mnuPrintDTM;   end;
        30: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print DDTM';                                             end;
      end;
  end;
end;

procedure CreateForm;
var
  i: Integer;
begin
  with frm do
  begin
    Width := 600;
    Height := 400;
    Caption := 'Simba DDTM Editor - Nielsie95';
    OnResize := @frmResize;
  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;

      with TMufasaBitmap.Create do
      begin
        SetSize(3000, 3000);
        DrawBitmap(Index, Canvas, 0, 0);
        Free;
      end;
    end;
  end;
  frm.OnKeyDown := @frmKeyDown;

  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 : begin Caption := 'Creates Point'; Checked := True; end;
          1 : Caption := 'Moves Point';
          2 : Caption := 'Picks Colour';
        end;
        Height := 17;
        Width := 50;
      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;
      OnClick := @lbClick;
    end;

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

    btnDel := TButton.Create(frm);
    with btnDel do
    begin
      Parent := pnl;
      Left := 120;
      Top := 280;
      Caption := 'Delete Point';
      Width := 100;
    end;
  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
    if (bmpBuffer <> nil) then
      bmpBuffer.Free;
    bmp.Free;
    frm.Free;
  end;
end;

procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('ShowForm', v);
end;

begin
  ThreadSafe_ShowForm;
end.

This is what I have currently :)
How can I convert a TDTM/pDTM to a string?

Ah no such thing is created yet, I will do this when I've got some time :).

The editor looks sweet! When image -> open image, the second filter is non-ASCII characters.. I guess that is some kind of PS/Laz bug?

E: DrawBitmap is rather slow.. Therefore added the TImage.Picture property (and the TMufasaBitmap.ToTBitmap function).

        bmp := ToTBitmap;
        PICTURE.Bitmap := bmp;
        bmp.free;

The above code is significantly faster than

        DrawBitmap(Index, Canvas, 0, 0);   

Not sure how to replace the DrawBitmap at coords other than 0,0 with this though :(.

How do you compile this? :<

Yeah, I noticed the weird filter thing, but I copied it from the Open Picture dialog (in Lazarus) so it should be correct. Picture property is indeed useful, thanks :)

Nava, you can just run in in Simba?

From: Nava2
How do you compile this? :<

Ah, you'd need to compile this using the GIT-Simba.. However I doubt it will work in Linux

I was trying to compile it in WINE, but for some reason, when I try to compile it returns:

Hakuna Matata

Compiling failed.

No actual error..

From: Nava2
I was trying to compile it in WINE, but for some reason, when I try to compile it returns:

Hakuna Matata

Compiling failed.

No actual error..

Use QEMU or VirtualBox.

I get the same thing in win7

As Ray said, you must use the git version (compile Simba yourself) as it probably doesn't recognize the Canvas.Rectangle.

Looks nice. :)

program DTMEditor;

const
  ZoomPixels = 3; //Should be an odd number (1, 3, 5, 7, ..)

var
  frm: TForm;
  mm: TMainMenu;
  sm: array [0..32] 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: TDTMPointDefArray;
  curP: Integer;

  MarkCol: Integer;
  PaintDTM, BufferChanged: Boolean;

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 toPDTM: pDTM;
var
  i, l: Integer;
begin
  l := Length(p);
  SetLength(Result.p, l);
  SetLength(Result.ash, l);
  SetLength(Result.asz, l);
  SetLength(Result.bp, l);
  SetLength(Result.c, l);
  SetLength(Result.t, l);
  Result.l := l;

  for i := 0 to l - 1 do
    with Result.p[i] do
    begin
      x := p[i].x;
      y := p[i].y;
    end;

  for i := 0 to l - 1 do
    with p[i], Result do
    begin
      ash[i] := AreaShape;
      asz[i] := AreaSize;
      bp[i] := False;
      c[i] := Color;
      t[i] := Tolerance;
    end;
end;

function DTMPointDef(x, y, Area, Shape, Color, Tolerance: Integer): TDTMPointDef;
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: TDTMPointDef; 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
  if (bmpBuffer <> nil) then
    bmpBuffer.Free;

  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
      DrawBitmap(b.Index, img.Canvas, sp.x, sp.y);

    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.SetSize(w, h);
  CopyClientToBitmap(bmp.Index, 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: TDTMPointDef;
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;

  if (bmpOverlay <> nil) then
  begin
    bmpOverlay.Free;
    bmpOverlay := nil;
  end;
  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.Index);

  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;

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

  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);
  UpdateBitmap(True, False);
end;

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

  if (bmpOverlay <> nil) then
  begin
    bmpOverlay.Free;
    bmpOverlay := nil;
  end
  else
    ResetBuffer;
  UpdateBitmap(True, False);
end;

procedure mnuDTMfromString(Sender: TObject);
begin
end;

procedure mnuPrintDTM(Sender: TObject);
var
  dtm: Integer;
begin
  dtm := AddpDTM(toPDTM);
  FreeDTM(dtm);
end;

procedure mnuPrintPDTM(Sender: TObject);
begin
  with toPDTM do
  begin
    WriteLn('');
    WriteLn('  with MyPDTM do');
    WriteLn('  begin');
    WriteLn('    l := '+IntToStr(l)+';');
    WriteLn('    p := '+Replace(ToStr(p), '(', 'Point(', [rfReplaceAll])+';');
    WriteLn('    ash := '+ToStr(ash)+';');
    WriteLn('    asz := '+ToStr(asz)+';');
    WriteLn('    bp := '+Replace(Replace(ToStr(bp), '1', 'True', [rfReplaceAll]), '0', 'False', [rfReplaceAll])+';');
    WriteLn('    c := '+ToStr(c)+';');
    WriteLn('    t := '+ToStr(t)+';');
    WriteLn('  end;');
    WriteLn('  TheDTM := AddpDTM(MyPDTM);');
    WriteLn('');
  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: TDTMPointDef;
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 32 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;
        32: begin Items[2].Add(sm[i]); sm[i].Caption := 'Print pDTM';         sm[i].OnClick := @mnuPrintPDTM;                                         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
    if (bmpOverlay <> nil) then
      bmpOverlay.Free;
    if (bmpBuffer <> nil) then
      bmpBuffer.Free;
    bmp.Free;
    frm.Free;
  end;
end;

procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  ThreadSafeCall('ShowForm', v);
end;

begin
  ThreadSafe_ShowForm;
end.

Basics are working now. Is there a readln alternative?

ToDo:
Load from/Save to file
DTM from/to String
Find DTM's
Mark Colours

This shouldn't be hard to change to a tabbed environment, but I'm not sure if that's worth it. I might add a few bitmap tools like cropping, brightness, contrast, etc.. Also, a feature I like myself is that you can click on points :)

EDIT: I can't create an extension out of it. It doesn't recognize TMufasaBitmap..

I think this question belongs here:

How about incorporating an ASCII converter or something to the sort in simba. (like a built in BMP img to ASCII txt tool).

Would that be in any way something to consider?

Added loading/saving to file. Also fixed loading from string. Has anyone else encountered some bugs?

I was just using the DTM editor yesterday, and it wasn't loading or saving DTMs. There were also random crashes, and I couldn't load DTM from string.

But the DTMs I did generate worked fine.

I don't know about the random crashes, but the rest should work now (if you have the new version) :) Do note that the DTM files are not compatible with SCAR's editor.