mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-24 18:22:25 -05:00
1357 lines
32 KiB
Plaintext
1357 lines
32 KiB
Plaintext
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
|
|
mnuNew(nil);
|
|
|
|
dtm := DTMFromString(s);
|
|
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.
|