From: masquerader
you cant really expand on something youre not finished with yet :p
ex: the delete button on the form doesnt work and you are talking about adding music features
im sorry for being kind of a buzzkill, but its very common around here for talented youngsters to burn themselves out and leave projects half finished.
pace yourself, lol (you coded 800 lines of the form in like 2 days?????)
so…. rs-monkey, i propose completing the form tool so that has basic functionality (refer to the first post)
-just use the road color, no picked colors or tolerance
-be able add points and delete points
-i dont think you would make more than one path point before moving to a different area, so maybe it needs some sort of "refresh" function (keeping the previews of previous points for future reference)
once thats done, you can get to adding as many features as you want
actually, i finished the delete button yesterday. and so the basic DTM editor shows. u can change, edit, create, move points, like the regular dtm editor. I just have no saving yet. Trust me, if i was getting to over
MY head, i would of never suggested it.
Why no tolerance? Maybe the road looks the same in some spots, we need to add some colors (and btw if i was to remove the water color and custom color i have on the form now, it'd take me like 20 minutes, without harming the code)
There is a "refresh function"… here is the updated(but the one on the very top of this page shows it too):
First,
when u select "New path", it will open a new tabs, with an uptodate capture of the map.
Secondly, under "Edit", theres too menus (working rigth now too) that say "Redo Capture" and "Redo Capture All". this will refresh the capture on the current, and second will redo capture for them all.
Trust me, i'm actually thinking of the basics before i do the more complicated stuff. And even the Undo/Redo is on the front of my "check list", it aint gonna be done until after everything else is.
program PathMakerDeluxe;
{
/------------------------------------------------------------------------------\
' Path Maker Deluxe verion 0.0.1 '
' Design Dynamic DTM Walking Paths the easy way. Use Path Maker Deluxe! '
|------------------------------------------------------------------------------|
' About '
|------------------------------------------------------------------------------|
' This is a DDTM (Dynamic DTM) Creator. Dynamic DTM's are the newest path '
' walking routine. With this program, you can make paths like you never '
' would been able to do before.... And in just minutes! Dynamic Dtm's have '
' a HUGE advantage over regular Dtm's. They can be constructed during '
' RUN-TIME! I no this doesn't sound cool, but it is! Allowing us to create '
' DTM's inside the running script, we can make DTM's of intersections and '
' roads whilst changing the road color as it changes in the Rs Applet! '
' But thats not all! With FindDtmRotated, we can find the road at any angle! '
|------------------------------------------------------------------------------|
' Unofficial Moto: "Explore More" '
|------------------------------------------------------------------------------|
' This Creator was made by The_Rs_Monkey. All code belongs to him and may not '
' be used without his permission and/or posting credits. The code that executes'
' these paths created from this program are property of WT_Fawaki and the peop-'
' le who helped create the code. It is up to them if you may redistribute it. '
\------------------------------------------------------------------------------/ }
{
/------------------------------------------\
' My Check List '
|------------------------------------------|
' 1. Finish Undo/Redo '
' 2. Files Saving And Opening / New... '
' 3. Insert Path After '
' 4. Export To Test Script. '
' 5. Delete Path '
' 6. Add Help '
' 7. Add Loop to NextPath '
' 8. Main Point Box '
' 9. Add More Colors. Door, TreePixel, User'
' Set Pixel, Ladder Color, Rock Color '
\------------------------------------------/
}
var
frmPathMaker: TForm;
mnuPathMaker: TMainMenu;
mnuFile, mnuEdit, mnuPaths, mnuHelp, mnuMouseClick : TMenuItem;
{File - I don't want to use arrays}
mnuNew, mnuOpen, mnuSave, mnuSep1, mnuCreatePath, mnuSep2, mnuClose : TMenuItem;
{Edit}
mnuUndo, mnuRedo, mnuSep4, mnuRedoCapture, mnuRedoCaptureAll : TMenuItem;
{Mouse Does...}
mnuMovePoint, mnuCreatePoint : TMenuItem;
{Paths}
mnuAddPath, mnuDelPath : TMenuItem;
{Help}
mnuHowToUse, mnuSep3, mnuAbout : TMenuItem;
tbsContainer : TPageControl;
tbsPath : Array Of TTabSheet;
FoundRsYet : boolean;
{For tbsPaths Array}
var
imgMap, imgMagnified : Array Of TImage;
lblX, lblY, lblColor, lblTolerance : Array Of TLabel;
listPoints : Array Of TListBox;
btnAdd, btnDelete : Array Of TButton;
txtX, txtY : Array Of TEdit;
choiceRoad, choiceWater, choiceCustom : Array Of TRadioButton;
scrllTolerance : Array Of TScrollBar;
ThePathDtm : Array Of TDTM;
{For Script}
var
bmpCapturedMap : Array Of integer;
Capture : TCanvas;
Captured : Boolean;
AreWeCreatingMainDot : Array Of Boolean;
MouseDoesWhat : Boolean; //True = Creates Dot, Fasle = Moves Dot
ii : integer;
ProgramChanging : boolean;
OriginalColor : Array Of Array Of Integer;
const
X1 = 573;
Y1 = 5;
W = 156;
H = 150;
//Undo And Redo types... i no.. alot lol, Try to stay organized.. LOL
type TAction = (actNewPoint, actDeletedPoint, actChangePoint, actMovePoint, actDeletePath, actAddedPath);
type TColorType = (coltypeRoad, coltypeWater, coltypeCustom);
type TWhichVar = (varX, varY, varTolerance, varColor);
type TEvent = Record
//all the needed variables for any of these changes.
Kind : TAction;
WhichVar : TWhichVar;
X, Y, Tolerance : integer;
X2, Y2, Tolerance2 : integer;
Color : TColorType;
Color2 : TColorType;
CustomColor : integer;
PathIndex : integer;
OldPath : TDTM;
end;
var
History : Array Of TEvent;
//Variable to store Undo and Redo History.
function FindRsClient : boolean;
begin
Result := FindWindowBySize(766,504);
if((not FoundRsYet) and (Result)) then
begin
Writeln('Rs Handle Is := ' + inttostr(GetClientWindowHandle) + ';');
FoundRsYet := True;
end;
//so we only writeln the handle once.
end;
function CaptureMap(Index : integer) : Boolean;
begin
//Credits := Yakman, Thank you!
if FindRsClient then
begin
//Note... i had to skip bmpCapturedMap[0] due to a weird error. Thats y ull see all these + 1's after [Index] or [i] when next to bmpMapCaptured
SetArrayLength(bmpCapturedMap, GetArrayLength(tbsPath) + 1);
try //frees an older bitmap if it exists
FreeBitmap(bmpCapturedMap[Index + 1]);
except
//there was no older bitmap to free
end
bmpCapturedMap[Index + 1] := BitmapFromString(W, H, '');
Capture := GetBitmapCanvas(bmpCapturedMap[Index + 1]);
try
SafeCopyCanvas(GetClientCanvas, Capture, X1, Y1, X1 + W, Y1 + H, 0, 0, W, H);
Captured := True;
except
Writeln('Couldn''t Capture Map! Srry!!!');
end;
Result := True;
end;
end;
function SetMap(Index : integer) : Boolean;
begin
if Captured then
begin
try
Capture := GetBitmapCanvas(bmpCapturedMap[Index + 1]);
SafeCopyCanvas(Capture, ImgMap[Index].Canvas, 0, 0, W, H, 0, 0, W, H);
Result := True;
except
Writeln('Error!');
end;
end;
end;
procedure Magnify(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
i, a, b : integer;
begin
for i := 0 to GetArrayLength(ImgMap) - 1 do
begin
if Sender = ImgMap[i] then
begin
if Captured then
begin
try
Capture := GetBitmapCanvas(bmpCapturedMap[i + 1]);
SafeCopyCanvas(Capture, ImgMagnified[i].Canvas, X - 2, Y - 2, X + 3, Y + 3, 0, 0, 156, 156);
except
Writeln('Error drawing map for ImgMap[' + inttostr(i) + ']; Told ya!');
end;
a := (156 / 5) * 2 //middle pixel left and top
b := (156 / 5) * 3 //middle pixel left + width and top + height
ImgMagnified[i].Canvas.Pen.Color := 255;
ImgMagnified[i].Canvas.MoveTo(a, a);
ImgMagnified[i].Canvas.LineTo(a, b);
ImgMagnified[i].Canvas.LineTo(b, b);
ImgMagnified[i].Canvas.LineTo(b, a);
ImgMagnified[i].Canvas.LineTo(a, a);
end;
end;
end;
end;
procedure AskQuit(Sender: TObject; var CanClose: Boolean);
begin
Writeln('are u sure u want to quit');
end;
function GetColorType(Index : integer) : integer;
begin
if choiceRoad[Index].Checked then
begin
Result := 1;
end else
if choiceWater[Index].Checked then
begin
Result := 2;
end else
if choiceCustom[Index].Checked then
begin
try
Result := strtoint(choiceCustom[Index].Caption);
except
Writeln('Cannot pick custom color for some reason! Srry! Picking Road Color Instead!');
ProgramChanging := True;
choiceRoad[Index].Checked := True;
ProgramChanging := False;
Result := 1;
end;
end else
begin //If none are checked.
ProgramChanging := True;
choiceRoad[Index].Checked := True;
ProgramChanging := False;
Result := 1;
end;
end;
function CustomColor(Index : integer) : boolean;
begin
Result := ((GetColorType(Index) < 1) or (GetColorType(Index) > 2));
end;
procedure SetVariables(Index, xvalue, yvalue, tolerance, CustomColor : integer);
begin
ProgramChanging := True;
txtX[Index].Text := inttostr(xvalue);
txtY[Index].Text := inttostr(yvalue);
lblTolerance[Index].Caption := 'Tolerance: ' + inttostr(tolerance);
choiceCustom[Index].Caption := inttostr(CustomColor);
ProgramChanging := False;
end;
procedure DrawDtm(Index : integer);
var
i : integer;
begin
Capture := GetBitmapCanvas(bmpCapturedMap[Index + 1]);
SafeCopyCanvas(Capture, ImgMap[Index].Canvas, 0, 0, W, H, 0, 0, W, H);
ImgMap[Index].Canvas.Pen.Color := 255;
ImgMap[Index].Canvas.Pixels[ThePathDTM[Index].MainPoint.x, ThePathDTM[Index].MainPoint.y] := 255;
for i := 0 to GetArrayLength(ThePathDTM[Index].SubPoints) - 1 do
begin
ImgMap[Index].Canvas.MoveTo(ThePathDTM[Index].MainPoint.x, ThePathDTM[Index].MainPoint.y);
ImgMap[Index].Canvas.LineTo(ThePathDTM[Index].SubPoints[i].x, ThePathDTM[Index].SubPoints[i].y);
end;
end;
//add point to listbox that is
procedure AddPoint(Index, IndexSub : integer; MainPoint : boolean);
var
ColorStr : string;
begin
if MainPoint then
begin
listPoints[Index].Items.Clear;
ColorStr := inttostr(ThePathDTM[Index].MainPoint.Color);
case ThePathDTM[Index].MainPoint.Color of
1 : ColorStr := 'Road';
2 : ColorStr := 'Water';
end;
listPoints[Index].Items.Add('(' + inttostr(ThePathDTM[Index].MainPoint.x) +
', ' + inttostr(ThePathDTM[Index].MainPoint.y) +
' : ' + ColorStr + ')');
end else
begin
ColorStr := inttostr(ThePathDTM[Index].SubPoints[IndexSub].Color);
case ThePathDTM[Index].SubPoints[IndexSub].Color of
1 : ColorStr := 'Road';
2 : ColorStr := 'Water';
end;
listPoints[Index].Items.Add('(' + inttostr(ThePathDTM[Index].SubPoints[IndexSub].x) +
', ' + inttostr(ThePathDTM[Index].SubPoints[IndexSub].y) +
' : ' + ColorStr + ')');
end;
end;
procedure SetListBox(Index : integer; MoveToLastIndex : boolean);
var
i, a : integer;
begin
if not MoveToLastIndex then
a := listPoints[Index].ItemIndex;
//addpoint adds to list box fyi.
listPoints[Index].Items.Clear;
AddPoint(Index, 0, True);
for i := 0 to GetArrayLength(ThePathDTM[Index].SubPoints) - 1 do
AddPoint(Index, i, False);
if MoveToLastIndex then
a := listPoints[Index].Items.Count - 1;
listPoints[Index].ItemIndex := a;
end;
procedure CreateDot(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i, a : integer;
begin
for i := 0 to GetArrayLength(ImgMap) - 1 do
begin
if Sender = ImgMap[i] then
begin
Capture := GetBitmapCanvas(bmpCapturedMap[i + 1]);
if AreWeCreatingMainDot[i] then
begin
SetArrayLength(OriginalColor[i], 1);
SetVariables(i, x, y, 0, Capture.Pixels[x, y]);
ThePathDTM[i].MainPoint.x := x;
ThePathDTM[i].MainPoint.y := y;
ThePathDTM[i].MainPoint.areasize:=1;
ThePathDTM[i].MainPoint.areashape:=0;
ThePathDTM[i].MainPoint.color:= GetColorType(i); //1 = road, 2 = water, other = custom color
ThePathDTM[i].MainPoint.tolerance:=0;
OriginalColor[i][0] := Capture.Pixels[x, y];
AreWeCreatingMainDot[i] := False;
DrawDtm(i);
SetListBox(i, True);
Exit;
end;
if MouseDoesWhat then //We need to create dot
begin
SetArrayLength(ThePathDTM[i].SubPoints, GetArrayLength(ThePathDTM[i].SubPoints) + 1);
SetArrayLength(OriginalColor[i], GetArrayLength(ThePathDTM[i].SubPoints) + 2);
a := GetArrayLength(ThePathDTM[i].SubPoints) - 1
SetVariables(i, x, y, 0, Capture.Pixels[x, y]);
ThePathDTM[i].SubPoints[a].x := x;
ThePathDTM[i].SubPoints[a].y := y;
ThePathDTM[i].SubPoints[a].areasize:=1;
ThePathDTM[i].SubPoints[a].areashape:=0;
ThePathDTM[i].SubPoints[a].color:= GetColorType(i); //1 = road, 2 = water, other = custom color
ThePathDTM[i].SubPoints[a].tolerance:=0;
OriginalColor[i][a + 1] := Capture.Pixels[x, y];
DrawDtm(i);
SetListBox(i, True);
Exit;
end;
if not MouseDoesWhat then
begin
if listPoints[i].ItemIndex <= -1 then
begin
//i need to remember to put in MessageBox
Writeln('No point selected to move. From menu "Mouse Click" ->');
Writeln('"Creates Point" to create point. Currently Moving Points!');
Exit;
end;
if listPoints[i].ItemIndex = 0 then //if we moving main point
begin
ProgramChanging := True;
txtX[i].Text := inttostr(x);
txtY[i].Text := inttostr(Y);
ProgramChanging := False;
ThePathDTM[i].MainPoint.x := x;
ThePathDTM[i].MainPoint.y := y;
OriginalColor[i][0] := Capture.Pixels[x, y];
ProgramChanging := True;
choiceCustom[i].Caption := inttostr(Capture.Pixels[x, y]);
ProgramChanging := False;
if CustomColor(i) then
begin
ThePathDTM[i].MainPoint.Color := Capture.Pixels[x, y];
end;
end;
if listPoints[i].ItemIndex > 0 then //if we moving sub points
begin
ProgramChanging := True;
txtX[i].Text := inttostr(x);
txtY[i].Text := inttostr(Y);
ProgramChanging := False;
ThePathDTM[i].SubPoints[listPoints[i].ItemIndex - 1].x := x;
ThePathDTM[i].SubPoints[listPoints[i].ItemIndex - 1].y := y;
OriginalColor[i][listPoints[i].ItemIndex] := Capture.Pixels[x, y];
ProgramChanging := True;
choiceCustom[i].Caption := inttostr(Capture.Pixels[x, y]);
ProgramChanging := False;
if CustomColor(i) then
begin
ThePathDTM[i].SubPoints[listPoints[i].ItemIndex - 1].Color := Capture.Pixels[x, y];
end;
end;
DrawDtm(i);
SetListBox(i, False);
Exit;
end;
//DeleteHardWork('All'); lol
end;
end;
end;
procedure SetStuff(sender : TObject);
var
i, a : integer;
begin
for i := 0 to GetArrayLength(tbsPath) - 1 do
begin
if Sender = listPoints[i] then
begin
a := listPoints[i].ItemIndex;
if a = 0 then
begin
ProgramChanging := True;
txtX[i].Text := inttostr(ThePathDTM[i].MainPoint.x)
txtY[i].Text := inttostr(ThePathDTM[i].MainPoint.y)
if ThePathDTM[i].MainPoint.Color = 1 then
choiceRoad[i].Checked := True;
if ThePathDTM[i].MainPoint.Color = 2 then
choiceWater[i].Checked := True;
choiceCustom[i].Caption := inttostr(OriginalColor[i][0]);
if ((ThePathDTM[i].MainPoint.Color < 1) or (ThePathDTM[i].MainPoint.Color > 2)) then
begin
choiceCustom[i].Checked := True;
end;
scrllTolerance[i].Position := ThePathDTM[i].MainPoint.Tolerance;
lblTolerance[i].Caption := 'Tolerance: ' + inttostr(ThePathDTM[i].MainPoint.Tolerance);
ProgramChanging := False;
end;
if a > 0 then
begin
ProgramChanging := True;
txtX[i].Text := inttostr(ThePathDTM[i].SubPoints[a - 1].x)
txtY[i].Text := inttostr(ThePathDTM[i].SubPoints[a - 1].y)
if ThePathDTM[i].SubPoints[a - 1].Color = 1 then
choiceRoad[i].Checked := True;
if ThePathDTM[i].SubPoints[a - 1].Color = 2 then
choiceWater[i].Checked := True;
choiceCustom[i].Caption := inttostr(OriginalColor[i][a]);
if ((ThePathDTM[i].SubPoints[a - 1].Color < 1) or (ThePathDTM[i].SubPoints[a - 1].Color > 2)) then
begin
choiceCustom[i].Checked := True;
end;
scrllTolerance[i].Position := ThePathDTM[i].SubPoints[a - 1].Tolerance;
lblTolerance[i].Caption := 'Tolerance: ' + inttostr(ThePathDTM[i].SubPoints[a - 1].Tolerance);
ProgramChanging := False;
end;
end;
end;
end;
function TEditToInt(var myedit : TEdit) : integer;
begin
ProgramChanging := True;
myedit.Text := GetNumbers(myedit.Text);
if myedit.Text = '' then myedit.Text := '0';
try
Result := strtoint(myedit.text);
except
//Somehow we got an error. We shouldn't tho
end;
ProgramChanging := False;
end;
procedure HandleChange(sender : TObject);
var
i, a : integer;
begin
if ProgramChanging then Exit;
for i := 0 to GetArrayLength(tbsPath) - 1 do
begin
a := listPoints[i].ItemIndex;
if a < 0 then
begin
if Sender = scrllTolerance[i] then
begin
ThePathDtm[i].MainPoint.Tolerance := scrllTolerance[i].Position;
lblTolerance[i].Caption := 'Tolerance: ' + inttostr(scrllTolerance[i].Position);
end;
end;
if not AreWeCreatingMainDot[i] then
begin
if a = 0 then
begin
case Sender of
txtX[i]: ThePathDtm[i].MainPoint.x := TEditToInt(txtX[i]);
txtY[i]: ThePathDtm[i].MainPoint.y := TEditToInt(txtY[i]);
scrllTolerance[i]: begin
ThePathDtm[i].MainPoint.Tolerance := scrllTolerance[i].Position;
lblTolerance[i].Caption := 'Tolerance: ' + inttostr(scrllTolerance[i].Position);
end;
choiceRoad[i]: ThePathDtm[i].MainPoint.Color := 1;
choiceWater[i]: ThePathDtm[i].MainPoint.Color := 2;
choiceCustom[i]: ThePathDtm[i].MainPoint.Color := OriginalColor[i][0];
end;
if ((Sender = txtX[i]) or (Sender = txtY[i])) then
begin
Capture := GetBitmapCanvas(bmpCapturedMap[i + 1]);
OriginalColor[i][0] := Capture.Pixels[strtoint(txtX[i].text), strtoint(txtY[i].text)];
choiceCustom[i].Caption := inttostr(OriginalColor[i][0]);
if choiceCustom[i].Checked then
ThePathDtm[i].MainPoint.Color := OriginalColor[i][0];
end;
end;
if a > 0 then
begin
case Sender of
txtX[i]: ThePathDtm[i].SubPoints[a - 1].x := TEditToInt(txtX[i]);
txtY[i]: ThePathDtm[i].SubPoints[a - 1].y := TEditToInt(txtY[i]);
scrllTolerance[i]: begin
ThePathDtm[i].SubPoints[a - 1].Tolerance := scrllTolerance[i].Position;
lblTolerance[i].Caption := 'Tolerance: ' + inttostr(scrllTolerance[i].Position);
end;
choiceRoad[i]: ThePathDtm[i].SubPoints[a - 1].Color := 1;
choiceWater[i]: ThePathDtm[i].SubPoints[a - 1].Color := 2;
choiceCustom[i]: ThePathDtm[i].SubPoints[a - 1].Color := OriginalColor[i][0];
end;
if ((Sender = txtX[i]) or (Sender = txtY[i])) then
begin
Capture := GetBitmapCanvas(bmpCapturedMap[i + 1]);
OriginalColor[i][a - 1] := Capture.Pixels[strtoint(txtX[i].text), strtoint(txtY[i].text)];
choiceCustom[i].Caption := inttostr(OriginalColor[i][a - 1]);
if choiceCustom[i].Checked then
ThePathDtm[i].SubPoints[a - 1].Color := OriginalColor[i][a - 1];
end;
end;
SetListBox(i, False);
DrawDTM(i);
end;
end;
end;
procedure AddDelete(sender : TObject);
var
i, a, b, c : integer;
begin
for i := 0 to GetArrayLength(tbsPath) - 1 do
begin
if AreWeCreatingMainDot[i] then //no use deleting a point that isnt there, only add the main point.
begin
case Sender of
btnAdd[i]: begin
SetArrayLength(OriginalColor[i], 1);
OriginalColor[i][0] := Capture.Pixels[TEditToInt(txtX[i]), TEditToInt(txtY[i])];
choiceCustom[i].Caption := inttostr(OriginalColor[i][0]);
ThePathDTM[i].MainPoint.x := TEditToInt(txtX[i]);
ThePathDTM[i].MainPoint.y := TEditToInt(txtY[i]);
ThePathDTM[i].MainPoint.areasize:=1;
ThePathDTM[i].MainPoint.areashape:=0;
ThePathDTM[i].MainPoint.color:= GetColorType(i); //1 = road, 2 = water, other = custom color
ThePathDTM[i].MainPoint.tolerance:= scrllTolerance[i].Position;
AreWeCreatingMainDot[i] := False;
DrawDtm(i);
SetListBox(i, True);
Exit;
end;
end;
end else
begin
case Sender of
btnAdd[i]: begin
a := listPoints[i].Items.Count;
SetArrayLength(OriginalColor[i], GetArrayLength(OriginalColor[i]) + 1);
SetArrayLength(ThePathDTM[i].SubPoints, GetArrayLength(ThePathDTM[i].SubPoints) + 1);
OriginalColor[i][a - 1] := Capture.Pixels[TEditToInt(txtX[i]), TEditToInt(txtY[i])];
choiceCustom[i].Caption := inttostr(OriginalColor[i][0]);
ThePathDTM[i].SubPoints[a - 1].x := TEditToInt(txtX[i]);
ThePathDTM[i].SubPoints[a - 1].y := TEditToInt(txtY[i]);
ThePathDTM[i].SubPoints[a - 1].areasize:=1;
ThePathDTM[i].SubPoints[a - 1].areashape:=0;
ThePathDTM[i].SubPoints[a - 1].color:= GetColorType(i); //1 = road, 2 = water, other = custom color
ThePathDTM[i].SubPoints[a - 1].tolerance:= scrllTolerance[i].Position;
DrawDtm(i);
SetListBox(i, True);
Exit;
end;
btnDelete[i]: begin
a := listPoints[i].Items.Count;
b := listPoints[i].ItemIndex;
if (a = 0) then Exit;
if ((a = 1) and (b = 0)) then //delete main point
begin
AreWeCreatingMainDot[i] := True;
ThePathDTM[i].MainPoint.x := -1;
ThePathDTM[i].MainPoint.y := -1;
ThePathDTM[i].MainPoint.Tolerance := 0;
ThePathDTM[i].MainPoint.Color := 0;
SetArrayLength(OriginalColor[i], 0);
listPoints[i].Items.Clear;
DrawDTM(i);
Exit;
end;
if ((a > 1) and (b = 0)) then
begin
ThePathDTM[i].MainPoint := ThePathDTM[i].SubPoints[0];
for c := 1 to GetArrayLength(ThePathDTM[i].SubPoints) - 1 do
begin
ThePathDTM[i].SubPoints[c - 1] := ThePathDTM[i].SubPoints[c]
end;
SetArrayLength(ThePathDTM[i].SubPoints, GetArrayLength(ThePathDTM[i].SubPoints) - 1);
DrawDtm(i);
SetListBox(i, False);
Exit;
end;
if ((a > 1) and (b > 0)) then
begin
for c := b to GetArrayLength(ThePathDTM[i].SubPoints) - 1 do
begin
ThePathDTM[i].SubPoints[c - 1] := ThePathDTM[i].SubPoints[c]
end;
SetArrayLength(ThePathDTM[i].SubPoints, GetArrayLength(ThePathDTM[i].SubPoints) - 1);
DrawDtm(i);
SetListBox(i, True);
Exit;
end;
end;
end;
end;
end;
end;
procedure LoadTabObjs(Index : integer);
begin
SetArrayLength(imgMap, Index + 1);
imgMap[Index] := TImage.Create(tbsPath[Index]);
imgMap[Index].Parent := tbsPath[Index];
imgMap[Index].OnMouseMove := @Magnify;
imgMap[Index].OnMouseUp := @CreateDot;
imgMap[Index].SetBounds(1, 1, 156, 150);
SetArrayLength(imgMagnified, Index + 1);
imgMagnified[Index] := TImage.Create(tbsPath[Index]);
imgMagnified[Index].Parent := tbsPath[Index];
imgMagnified[Index].SetBounds(1, 153, 156, 156);
SetArrayLength(lblX, Index + 1);
lblX[Index] := TLabel.Create(tbsPath[Index]);
lblX[Index].Parent := tbsPath[Index];
lblX[Index].SetBounds(160, 160, 10, 13);
lblX[Index].Caption := 'X:';
SetArrayLength(lblY, Index + 1);
lblY[Index] := TLabel.Create(tbsPath[Index]);
lblY[Index].Parent := tbsPath[Index];
lblY[Index].SetBounds(160, 184, 10, 13);
lblY[Index].Caption := 'Y:';
SetArrayLength(lblColor, Index + 1);
lblColor[Index] := TLabel.Create(tbsPath[Index]);
lblColor[Index].Parent := tbsPath[Index];
lblColor[Index].SetBounds(160, 254, 27, 13);
lblColor[Index].Caption := 'Color:';
SetArrayLength(lblTolerance, Index + 1);
lblTolerance[Index] := TLabel.Create(tbsPath[Index]);
lblTolerance[Index].Parent := tbsPath[Index];
lblTolerance[Index].SetBounds(160, 207, 63, 13);
lblTolerance[Index].Caption := 'Tolerance: 0 ';
SetArrayLength(listPoints, Index + 1);
listPoints[Index] := TListBox.Create(tbsPath[Index]);
listPoints[Index].Parent := tbsPath[Index];
listPoints[Index].SetBounds(160, 2, 121, 122);
listPoints[Index].ItemHeight := 13;
listPoints[Index].OnClick := @SetStuff;
SetArrayLength(btnAdd, Index + 1);
btnAdd[Index] := TButton.Create(tbsPath[Index]);
btnAdd[Index].Parent := tbsPath[Index];
btnAdd[Index].SetBounds(160, 127, 61, 25);
btnAdd[Index].Caption := 'Add';
btnAdd[Index].OnClick := @AddDelete;
SetArrayLength(btnDelete, Index + 1);
btnDelete[Index] := TButton.Create(tbsPath[Index]);
btnDelete[Index].Parent := tbsPath[Index];
btnDelete[Index].SetBounds(221, 127, 61, 25);
btnDelete[Index].Caption := 'Delete';
btnDelete[Index].OnClick := @AddDelete;
SetArrayLength(txtX, Index + 1);
txtX[Index] := TEdit.Create(tbsPath[Index]);
txtX[Index].Parent := tbsPath[Index];
txtX[Index].SetBounds(176, 157, 54, 21);
txtX[Index].Text := 'txtX';
txtX[Index].OnChange := @HandleChange;
SetArrayLength(txtY, Index + 1);
txtY[Index] := TEdit.Create(tbsPath[Index]);
txtY[Index].Parent := tbsPath[Index];
txtY[Index].SetBounds(176, 181, 54, 21);
txtY[Index].Text := 'txtY';
txtY[Index].OnChange := @HandleChange;
SetArrayLength(choiceRoad, Index + 1);
choiceRoad[Index] := TRadioButton.Create(tbsPath[Index]);
choiceRoad[Index].Parent := tbsPath[Index];
choiceRoad[Index].SetBounds(193, 253, 88, 16);
choiceRoad[Index].Caption := 'Road';
choiceRoad[Index].OnClick := @HandleChange;
SetArrayLength(choiceWater, Index + 1);
choiceWater[Index] := TRadioButton.Create(tbsPath[Index]);
choiceWater[Index].Parent := tbsPath[Index];
choiceWater[Index].SetBounds(193, 269, 88, 17);
choiceWater[Index].Caption := 'Water';
choiceWater[Index].OnClick := @HandleChange;
SetArrayLength(choiceCustom, Index + 1);
choiceCustom[Index] := TRadioButton.Create(tbsPath[Index]);
choiceCustom[Index].Parent := tbsPath[Index];
choiceCustom[Index].SetBounds(193, 286, 88, 17);
choiceCustom[Index].Caption := '0';
choiceCustom[Index].OnClick := @HandleChange;
SetArrayLength(scrllTolerance, Index + 1);
scrllTolerance[Index] := TScrollBar.Create(tbsPath[Index]);
scrllTolerance[Index].Parent := tbsPath[Index];
scrllTolerance[Index].SetBounds(161, 227, 121, 16);
scrllTolerance[Index].Min := 0;
scrllTolerance[Index].Max := 200;
scrllTolerance[Index].OnChange := @HandleChange;
end;
procedure AddATab;
begin
SetArrayLength(tbsPath, GetArrayLength(tbsPath) + 1);
tbsPath[GetArrayLength(tbsPath) - 1] := TTabSheet.Create(frmPathMaker);
TabSheetCaption(tbsPath[GetArrayLength(tbsPath) - 1], 'Path [ ' + inttostr(GetArrayLength(tbsPath) - 1) + ' ]');
tbsPath[GetArrayLength(tbsPath) - 1].PageControl := tbsContainer;
LoadTabObjs(GetArrayLength(tbsPath) - 1);
if CaptureMap(GetArrayLength(tbsPath) - 1) then
SetMap(GetArrayLength(tbsPath) - 1);
SetArrayLength(AreWeCreatingMainDot, GetArrayLength(tbsPath));
AreWeCreatingMainDot[GetArrayLength(tbsPath) - 1] := True;
SetArrayLength(ThePathDTM, GetArrayLength(tbsPath));
SetArrayLength(OriginalColor, GetArrayLength(tbsPath));
end;
procedure SetNewTab(Sender : TObject);
begin
AddATab;
end;
procedure ReDoCapture(sender : TObject);
var
i : integer;
begin
for i := 0 to GetArrayLength(tbsPath) - 1 do
begin
if tbsContainer.ActivePage = tbsPath[i] then
begin
if CaptureMap(i) then
begin
SetMap(i);
if not AreWeCreatingMainDot[i] then DrawDtm(i);
end;
end;
end;
end;
procedure ReDoCaptureAll(sender : TObject);
var
i : integer;
begin
for i := 0 to GetArrayLength(tbsPath) - 1 do
begin
if CaptureMap(i) then
begin
SetMap(i);
if not AreWeCreatingMainDot[i] then DrawDtm(i);
end;
end;
end;
procedure ChangeMouseClicks(Sender : TObject);
begin
case Sender of
mnuMovePoint : MouseDoesWhat := False;
mnuCreatePoint : MouseDoesWhat := True;
end;
mnuMovePoint.Checked := not(MouseDoesWhat);
mnuCreatePoint.Checked := (MouseDoesWhat);
end;
procedure InitializeForm;
begin
if not FindRsClient then
begin
Writeln('Must have Rs open first. Terminating Script! (ignore error)');
TerminateScript;
end;
frmPathMaker := CreateForm;
frmPathMaker.Left := 259;
frmPathMaker.Top := 132;
frmPathMaker.Width := 300;
frmPathMaker.Height := 384;
frmPathMaker.Caption := 'Path Maker Deluxe';
frmPathMaker.Color := clBtnFace;
frmPathMaker.Font.Color := clWindowText;
frmPathMaker.Font.Height := -11;
frmPathMaker.Font.Name := 'MS Sans Serif';
frmPathMaker.Font.Style := [];
frmPathMaker.Visible := False;
frmPathMaker.PixelsPerInch := 96;
frmPathMaker.Onclosequery := @AskQuit;
mnuPathMaker := TMainMenu.Create(frmPathMaker);
mnuFile := TMenuItem.Create(frmPathMaker);
mnuFile.Caption := 'File';
mnuPathMaker.Items.Add(mnuFile);
mnuNew := TMenuItem.Create(frmPathMaker);
mnuNew.Caption := 'New';
mnuPathMaker.Items.Items[0].Add(mnuNew);
mnuOpen := TMenuItem.Create(frmPathMaker);
mnuOpen.Caption := 'Open';
mnuPathMaker.Items.Items[0].Add(mnuOpen);
mnuSave := TMenuItem.Create(frmPathMaker);
mnuSave.Caption := 'Save';
mnuPathMaker.Items.Items[0].Add(mnuSave);
mnuSep1 := TMenuItem.Create(frmPathMaker);
mnuSep1.Caption := '-';
mnuPathMaker.Items.Items[0].Add(mnuSep1);
mnuCreatePath := TMenuItem.Create(frmPathMaker);
mnuCreatePath.Caption := 'Create Test.scar';
mnuPathMaker.Items.Items[0].Add(mnuCreatePath);
mnuSep2 := TMenuItem.Create(frmPathMaker);
mnuSep2.Caption := '-';
mnuPathMaker.Items.Items[0].Add(mnuSep2);
mnuClose := TMenuItem.Create(frmPathMaker);
mnuClose.Caption := 'Exit';
mnuPathMaker.Items.Items[0].Add(mnuClose);
mnuEdit := TMenuItem.Create(frmPathMaker);
mnuEdit.Caption := 'Edit';
mnuPathMaker.Items.Add(mnuEdit);
mnuUndo := TMenuItem.Create(frmPathMaker);
mnuUndo.Caption := 'Undo';
mnuPathMaker.Items.Items[1].Add(mnuUndo);
mnuRedo := TMenuItem.Create(frmPathMaker);
mnuRedo.Caption := 'Redo';
mnuPathMaker.Items.Items[1].Add(mnuRedo);
mnuSep4 := TMenuItem.Create(frmPathMaker);
mnuSep4.Caption := '-';
mnuPathMaker.Items.Items[1].Add(mnuSep4);
mnuRedoCapture := TMenuItem.Create(frmPathMaker);
mnuRedoCapture.Caption := 'Do/Redo Capture This Path';
mnuRedoCapture.OnClick := @RedoCapture;
mnuPathMaker.Items.Items[1].Add(mnuRedoCapture);
mnuRedoCaptureAll := TMenuItem.Create(frmPathMaker);
mnuRedoCaptureAll.Caption := 'Do/Redo Capture All Paths';
mnuRedoCaptureAll.OnClick := @RedoCaptureAll;
mnuPathMaker.Items.Items[1].Add(mnuRedoCaptureAll);
mnuMouseClick := TMenuItem.Create(frmPathMaker);
mnuMouseClick.Caption := 'Mouse Click';
mnuPathMaker.Items.Add(mnuMouseClick);
mnuMovePoint := TMenuItem.Create(frmPathMaker);
mnuMovePoint.Caption := 'Moves Selected Point';
mnuMovePoint.OnClick := @ChangeMouseClicks;
mnuPathMaker.Items.Items[2].Add(mnuMovePoint);
mnuCreatePoint := TMenuItem.Create(frmPathMaker);
mnuCreatePoint.Caption := 'Creates New Point';
mnuCreatePoint.OnClick := @ChangeMouseClicks;
mnuCreatePoint.Checked := True;
mnuPathMaker.Items.Items[2].Add(mnuCreatePoint);
mnuPaths := TMenuItem.Create(frmPathMaker);
mnuPaths.Caption := 'Path';
mnuPathMaker.Items.Add(mnuPaths);
mnuAddPath := TMenuItem.Create(frmPathMaker);
mnuAddPath.Caption := 'Add new path (new tab)';
mnuAddPath.OnClick := @SetNewTab;
mnuPathMaker.Items.Items[3].Add(mnuAddPath);
mnuDelPath := TMenuItem.Create(frmPathMaker);
mnuDelPath.Caption := 'Delete path (current tab)';
mnuPathMaker.Items.Items[3].Add(mnuDelPath);
mnuHelp := TMenuItem.Create(frmPathMaker);
mnuHelp.Caption := 'Help';
mnuPathMaker.Items.Add(mnuHelp);
mnuHowToUse := TMenuItem.Create(frmPathMaker);
mnuHowToUse.Caption := 'How to use...';
mnuPathMaker.Items.Items[4].Add(mnuHowToUse);
mnuSep3 := TMenuItem.Create(frmPathMaker);
mnuSep3.Caption := '-';
mnuPathMaker.Items.Items[4].Add(mnuSep3);
mnuAbout := TMenuItem.Create(frmPathMaker);
mnuAbout.Caption := 'About';
mnuPathMaker.Items.Items[4].Add(mnuAbout);
tbsContainer := TPageControl.Create(frmPathMaker);
tbsContainer.Parent := frmPathMaker;
tbsContainer.Align := alClient;
CaptureMap(-1); //Its like initiallizing the bmpMapCaptured Array!
AddATab;
end;
procedure SafeInitializeForm;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitializeForm', v);
end;
procedure ShowFormModal;
begin
frmPathMaker.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
//so we don't piss of someone with important info in the debug. Just so no worrys.
for ii := 0 to 10 do
begin
Writeln('');
end;
Writeln('Moving stuff up in debug. ClearDebug + SaveWork kinda lol');
MouseDoesWhat := True;
try
SafeInitializeForm;
SafeShowFormModal;
except
Writeln('Error with form.');
finally
FreeForm(frmPathMaker);
end;
for ii := 0 to GetArrayLength(imgMap) - 1 do
begin
try
FreeBitmap(bmpCapturedMap[ii]);
except
end;
end;
end.
