euphemism

Untitled

Jan 16th, 2012
144
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 13.41 KB | None | 0 0
  1. Program ObjectDTMGenerationTool;
  2. {$DEFINE SMART}
  3. {$i SRL\SRL.simba}
  4. {$i ObjectDTM\ObjDTMInclude.simba}
  5.  
  6. var
  7.   CleanMap, CurrentMap, I, X, Y: Integer;
  8.  
  9.   SubPoints: TPointArray;
  10.   Objects: MMObjArray;
  11.   ObjectDTM: ObjDTM;
  12.  
  13.   PageControl: TPageControl;
  14.   TabSheet: Array [0..3] of TTabSheet;
  15.  
  16.   PropertiesControl: TPageControl;
  17.   PropertySheet: Array [0..2] of TTabSheet;
  18.   PropertyPanel: TPanel;
  19.  
  20.   ToolForm: TForm;
  21.   MMap: TImage;
  22.   ObjectsList: TListBox;
  23.   Instructions: TListBox;
  24.   Output: TMemo;
  25.   MainFormButtons: Array [0..1] of TButton;
  26.   SubPointButtons: Array [0..3] of TButton;
  27.  
  28. procedure DeclarePlayers;
  29. begin
  30.  
  31.   HowManyPlayers := 1;
  32.   CurrentPlayer := 0;
  33.   SetLength(Players, HowManyPlayers);
  34.  
  35.   Players[0].Name := 'Dragon100776';
  36.   Players[0].Pass := '1NovDark7';
  37.   Players[0].Member := True;
  38.   Players[0].Active := True;
  39. end;
  40.  
  41. procedure DrawDotsEx(pixels: TPointArray; color: Integer);
  42. {:: Author: Sir R. Magician ::}
  43. var
  44.   i : integer;
  45. begin
  46.  
  47.   MMap.Canvas.Pen.Color := color;
  48.  
  49.   for i:= 0 to high(pixels) do
  50.   begin
  51.  
  52.     MMap.canvas.moveto(pixels[i].x,pixels[i].y);
  53.     MMap.canvas.LineTo(pixels[i].x+1,pixels[i].y);
  54.   end;
  55. end;
  56.  
  57. procedure DrawLine(TP1, TP2: TPoint; Color: TColor);
  58. {:: Author: mormonman ::}
  59. begin
  60.  
  61.   MMap.canvas.Pen.Color := Color;
  62.  
  63.   MMap.canvas.moveto(TP1.x,TP1.y);
  64.   MMap.canvas.LineTo(TP2.x,TP2.y);
  65. end;
  66.  
  67. procedure DrawCircle(Center: TPoint; Radius: Integer; Fill: Boolean; Color: TColor);
  68. {:: Author: mormonman ::}
  69. var
  70.   TPA: TPointArray;
  71. begin
  72.   TPA := TPAFromBox(IntToBox(Center.X - Radius, Center.Y - Radius, Center.X + Radius, Center.Y + Radius));
  73.   FilterPointsPie(TPA, 0, 360, -1, Radius, Center.X, Center.Y);
  74.  
  75.   if (not Fill) then
  76.     FilterPointsDist(TPA, Radius-1, Radius, Center.X, Center.Y);
  77.  
  78.   if (Length(TPA) >= 1) then
  79.     DrawDotsEx(TPA, Color);
  80. end;
  81.  
  82. procedure DrawPolygons(Polygons: T2DPointArray; color: TColor);
  83. {:: Author: mormonman ::}
  84. var
  85.   i, h, Hi: Integer;
  86. begin
  87.  
  88.   if (Length(Polygons) < 1) then
  89.     Exit;
  90.  
  91.   for h := 0 to High(Polygons) do
  92.   begin
  93.     Hi := High(Polygons[h]);
  94.     if (Hi < 2) then Exit;
  95.  
  96.     for i := 0 to Hi - 1 do
  97.       DrawLine(Polygons[h][i], Polygons[h][i+1], color);
  98.  
  99.     DrawLine(Polygons[h][Hi], Polygons[h][0], color);
  100.   end;
  101. end;
  102.  
  103. procedure GatherMiniMap;
  104. var
  105.   I: Integer;
  106.   TIA: TIntegerArray;
  107.   TPA: TPointArray;
  108. begin
  109.  
  110.   TPA := TPAFromBox(IntToBox(548, 6, 708, 166));
  111.   FilterPointsPie(TPA, 0, 360, 0, 80, MMCX, MMCY);
  112.  
  113.   TIA := GetColors(TPA);
  114.   OffsetTPA(TPA, IntToPoint(-548, -6));
  115.  
  116.   FastSetPixels(CleanMap, TPA, TIA);
  117.   FastSetPixels(CurrentMap, TPA, TIA);
  118.  
  119.   DrawBitmap(CleanMap, MMap.Canvas, 0, 0);
  120.  
  121.   for I := 0 to High(SubPoints) do
  122.     DrawCircle(SubPoints[i], 7, False, clLime);
  123. end;
  124.  
  125. procedure GatherObject;
  126. var
  127.   I: Integer;
  128.   Name: String;
  129.   Points: String;
  130.   ObjectsTPA: TPointArray;
  131. begin
  132.  
  133.   case ObjectsList.ItemIndex of
  134.  
  135.    -1: Name := 'invalid';
  136.     0: Name := 'ladders';
  137.     1: Name := 'trees';
  138.     2: Name := 'dead trees';
  139.     3: Name := 'plants';
  140.     4: Name := 'flax';
  141.     5: Name := 'boulders';
  142.     6: Name := 'henges';
  143.     7: Name := 'cacti';
  144.     8: Name := 'maple trees';
  145.     9: Name := 'rocks';
  146.   end;
  147.  
  148.   if (Name = 'invalid') then
  149.   begin
  150.  
  151.     WriteLn('You have passed an ' + name + ' index to the finding function, please select an object first.');
  152.     Exit;
  153.   end;
  154.  
  155.   ObjectsTPA := FindMiniMapObj(MMObjRecords[ObjectsList.ItemIndex]);
  156.  
  157.   SetLength(Objects, Length(ObjectsTPA));
  158.   OffsetTPA(ObjectsTPA, IntToPoint(-548, -6));
  159.  
  160.   DrawBitmap(CleanMap, MMap.Canvas, 0, 0);
  161.  
  162.   for I := 0 to (Length(ObjectsTPA) - 1) do
  163.   begin
  164.  
  165.     DrawCircle(ObjectsTPA[i], 7, False, clWhite);
  166.  
  167.     Points := Points + '(' + IntToStr(ObjectsTPA[i].x) + ', ' + IntToStr(ObjectsTPA[i].y) + '), ';
  168.     Objects[i].Center := ObjectsTPA[i];
  169.     Objects[i].ObjType := ObjectsList.ItemIndex;
  170.   end;
  171.  
  172.   for I := 0 to High(SubPoints) do
  173.     DrawCircle(SubPoints[i], 7, False, clLime);
  174.  
  175.   Output.Clear;
  176.   Output.Lines.Add(Points);
  177. end;
  178.  
  179. procedure SubPointManager;
  180. begin
  181.  
  182.   for I := 0 to High(Objects) do
  183.   begin
  184.  
  185.     if InCircle(X, Y, Objects[i].Center.x, Objects[i].Center.y, 7) then
  186.     begin
  187.  
  188.       if (not PointInTPA(Objects[i].Center, SubPoints)) then
  189.       begin
  190.  
  191.         Inc(ObjectDTM.NumOfPoints);
  192.  
  193.         SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
  194.         SetLength(SubPoints, ObjectDTM.NumOfPoints);
  195.  
  196.         ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Base := Objects[i].ObjType;
  197.         ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Point := Objects[i].Center;
  198.         ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Drift := 7;
  199.  
  200.         SubPoints[(ObjectDTM.NumOfPoints) - 1] := Objects[i].Center;
  201.  
  202.         DrawCircle(SubPoints[(ObjectDTM.NumOfPoints) - 1], 7, False, clLime);
  203.         Exit;
  204.       end else
  205.         Continue;
  206.     end;
  207.   end;
  208.  
  209.   for I := 0 to (ObjectDTM.NumOfPoints - 1) do
  210.   begin
  211.  
  212.     if (not InCircle(X, Y, SubPoints[i].x, SubPoints[i].y, 7)) then
  213.       Continue;
  214.  
  215.     DrawCircle(SubPoints[i], 7, False, clRed);
  216.  
  217.     ObjectDTM.SubPoints[i].Base := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Base;
  218.     ObjectDTM.SubPoints[i].Point := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Point;
  219.     ObjectDTM.SubPoints[i].Drift := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Drift;
  220.  
  221.  
  222.     SubPoints[i] := SubPoints[(ObjectDTM.NumOfPoints) - 1];
  223.  
  224.     ObjectDTM.NumOfPoints := (ObjectDTM.NumOfPoints) - 1;
  225.  
  226.     SetLength(SubPoints, ObjectDTM.NumOfPoints);
  227.     SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
  228.     ObjDTM_PrintToRec(ObjDTMToString(ObjectDTM));
  229.   end;
  230. end;
  231.  
  232. procedure AreaManager;
  233. begin
  234.     {
  235.   with Buttons[0] do
  236.   begin
  237.  
  238.     Caption := 'grab minimap';
  239.     OnClick := @MouseClick;
  240.   end;
  241.  
  242.   with Buttons[1] do
  243.   begin
  244.  
  245.     Caption := 'gather object';
  246.     OnClick := @MouseClick;
  247.   end;
  248.  
  249.   with Buttons[2] do
  250.   begin
  251.  
  252.     Caption := 'add area polygon';
  253.     OnClick := @MouseClick;
  254.   end;
  255.  
  256.   with Buttons[3] do
  257.   begin
  258.  
  259.     Caption := 'print object dtm';
  260.     OnClick := @MouseClick;
  261.   end;
  262.   }
  263. end;
  264.  
  265. procedure MainPointManager(Click: Boolean);
  266. begin
  267.  
  268.   DrawBitmap(CleanMap, MMap.Canvas, 0, 0);
  269.  
  270.   if Click then
  271.     ObjectDTM.MainPoint := IntToPoint(X, Y);
  272.  
  273.   for I := 0 to High(SubPoints) do
  274.   begin
  275.  
  276.     DrawCircle(SubPoints[i], 7, False, clLime);
  277.     DrawLine(ObjectDTM.MainPoint, SubPoints[i], clWhite);
  278.   end;
  279.  
  280.   for I := 0 to High(SubPoints) do
  281.     DrawLine(IntToPoint(X, Y), SubPoints[i], clYellow);
  282. end;
  283.  
  284. procedure PrintManager;
  285. begin
  286. end;
  287.  
  288. procedure MouseMove(Sender: TObject; S: TShiftState; mX, mY: Integer);
  289. begin
  290.  
  291.   X := mX;
  292.   Y := mY;
  293.  
  294.   case Sender of
  295.  
  296.     MMap:
  297.       begin
  298.  
  299.         if (PropertiesControl.ActivePageIndex = 1) then
  300.           MainPointManager(False);
  301.       end;
  302.   end;
  303. end;
  304.  
  305. procedure MouseClick(Sender: TObject);
  306. begin
  307.  
  308.   case Sender of
  309.  
  310.     MainFormButtons[0]: GatherMiniMap;
  311.     MainFormButtons[1]: PrintManager;
  312.  
  313.     SubPointButtons[0]: GatherObject;
  314.  
  315.     PropertiesControl:
  316.     begin
  317.            WriteLn('Bitch changed');
  318.       case PropertiesControl.ActivePageIndex of
  319.  
  320.         0:
  321.         begin
  322.  
  323.           Instructions.Items.Clear;
  324.           Instructions.Items.Add('Instructions: Click ' + #39 + 'grab minimap' + #39 + ' to grab the current map view.');
  325.           Instructions.Items.Add('Select an object from the list and click ' + #39 + 'gather object' + #39 + ' to display');
  326.           Instructions.Items.Add('all instances of that object on the minimap.');
  327.         end;
  328.  
  329.         1:
  330.         begin
  331.  
  332.           Instructions.Items.Clear;
  333.           Instructions.Items.Add('Instructions: Displays current main-point of the Object DTM.');
  334.           Instructions.Items.Add('Mouse over a position and click to change the main-point.');
  335.         end;
  336.       end;
  337.     end;
  338.  
  339.     MMap:
  340.     begin
  341.  
  342.       case PropertiesControl.ActivePageIndex of
  343.  
  344.         0: SubPointManager;
  345.         1: MainPointManager(True);
  346.       end;
  347.     end;
  348.   end;
  349. end;
  350.  
  351. procedure ToolForm_Init;
  352. begin
  353.  
  354.   ToolForm := TForm.Create(nil);
  355.   MMap := TImage.Create(TabSheet[0]);
  356.   ObjectsList := TListBox.Create(TabSheet[0]);
  357.   Instructions := TListBox.Create(TabSheet[0]);
  358.   Output := TMemo.Create(TabSheet[0]);
  359.   PropertyPanel := TPanel.Create(TabSheet[0]);
  360.  
  361.   PageControl := TPageControl.Create(ToolForm);
  362.   PageControl.Parent := ToolForm;
  363.   PageControl.Width := 510;
  364.   PageControl.Height := 330;
  365.   PageControl.Caption := 'TabPageControl';
  366.  
  367.   PropertiesControl := TPageControl.Create(ToolForm);
  368.   PropertiesControl.Parent := PropertyPanel;
  369.   PropertiesControl.Width := 210;
  370.   PropertiesControl.Height := 160;
  371.   PropertiesControl.Caption := 'PropertyPageControl';
  372.   PropertiesControl.OnChange := @MouseClick;
  373.  
  374.   for I := 0 to 3 do
  375.   begin
  376.  
  377.     TabSheet[I] := TTabSheet.Create(PageControl);
  378.     TabSheet[I].Parent := PageControl;
  379.     TabSheet[I].PageControl := PageControl;
  380.   end;
  381.  
  382.   TabSheet[0].Caption := 'single';
  383.   TabSheet[1].Caption := 'multi';
  384.   TabSheet[2].Caption := 'path';
  385.   TabSheet[3].Caption := 'multi-path';
  386.  
  387.   for I := 0 to 2 do
  388.   begin
  389.  
  390.     PropertySheet[I] := TTabSheet.Create(ToolForm);
  391.     PropertySheet[I].Parent := PropertyPanel;
  392.     PropertySheet[I].PageControl := PropertiesControl;
  393.   end;
  394.  
  395.   PropertySheet[0].Caption := 'sub-points';
  396.   PropertySheet[1].Caption := 'main-point';
  397.   PropertySheet[2].Caption := 'area';
  398.  
  399.   with PropertyPanel do
  400.   begin
  401.     Parent := TabSheet[0];
  402.     Left := 282;
  403.     Top := 10;
  404.     Caption := 'Object DTM Generation Tool  - by euphemism';
  405.     Width := 210;
  406.     Height := 160;
  407.   end;
  408.  
  409.   for I := 0 to 1 do
  410.   begin
  411.  
  412.     MainFormButtons[i] := TButton.Create(ToolForm);
  413.     MainFormButtons[i].Parent := ToolForm;
  414.     MainFormButtons[i].Width := 100;
  415.     MainFormButtons[i].Height := 30;
  416.     MainFormButtons[i].Top := 55 + (i * 34);
  417.     MainFormButtons[i].Left := 176;
  418.   end;
  419.  
  420.   with MainFormButtons[0] do
  421.   begin
  422.  
  423.     Caption := 'grab minimap';
  424.     OnClick := @MouseClick;
  425.   end;
  426.  
  427.   with MainFormButtons[1] do
  428.   begin
  429.  
  430.     Caption := 'print object dtm';
  431.     OnClick := @MouseClick;
  432.   end;
  433.  
  434.   with SubPointButtons[0] do
  435.   begin
  436.  
  437.     SubPointButtons[0] := TButton.Create(ToolForm);
  438.     Parent := PropertySheet[0];
  439.     Left := 102;
  440.     Top := 4;
  441.     Height := 30;
  442.     Width := 100;
  443.  
  444.     Caption := 'gather object';
  445.     OnClick := @MouseClick;
  446.   end;
  447.  
  448.   with ToolForm do
  449.   begin
  450.     Left := 430;
  451.     Top := 174;
  452.     Caption := 'Object DTM Generation Tool  - by euphemism';
  453.     ClientWidth := 510;
  454.     ClientHeight := 330;
  455.     Color := 15790320;
  456.   end;
  457.  
  458.   with MMap do
  459.   begin
  460.     Parent := TabSheet[0];
  461.     Left := 5;
  462.     Top := 10;
  463.     Width := 160;
  464.     Height := 160;
  465.     OnClick := @MouseClick;
  466.     OnMouseMove := @MouseMove;
  467.   end;
  468.  
  469.   with ObjectsList do
  470.   begin
  471.     Parent := PropertySheet[0];
  472.     Left := 0;
  473.     Top := 4;
  474.     Width := 100;
  475.     Height := 127;
  476.     ItemHeight := 13;
  477.     Items.Add('Ladders');
  478.     Items.Add('Trees');
  479.     Items.Add('Dead Trees');
  480.     Items.Add('Plants');
  481.     Items.Add('Flax');
  482.     Items.Add('Boulders');
  483.     Items.Add('Henges');
  484.     Items.Add('Cacti');
  485.     Items.Add('Maple Trees');
  486.     Items.Add('Rocks');
  487.   end;
  488.  
  489.   with Instructions do
  490.   begin
  491.     Parent := TabSheet[0];
  492.     Left := 10;
  493.     Top := 180;
  494.     Width := 480;
  495.     Height := 50;
  496.     Items.Add('Instructions: Click ' + #39 + 'grab minimap' + #39 + ' to grab the current map view.');
  497.     Items.Add('Select an object from the list and click ' + #39 + 'gather object' + #39 + ' to display');
  498.     Items.Add('all instances of that object on the minimap.');
  499.   end;
  500.  
  501.   with Output do
  502.   begin
  503.     Parent := TabSheet[0];
  504.     Color := 16777215;
  505.     Left := 10;
  506.     Top := 235;
  507.     Width := 480;
  508.     Height := 55;
  509.   end;
  510.  
  511.   CleanMap := BitmapFromString(160, 160, '');
  512.   CurrentMap := BitmapFromString(160, 160, '');
  513.  
  514.   FloodFillBitmap(CleanMap, IntToPoint(0, 0), 0, 16777215);
  515.   FloodFillBitmap(CurrentMap, IntToPoint(0, 0), 0, 16777215);
  516.  
  517.   SetBitmapName(CleanMap, 'Clean');
  518.   SetBitmapName(CurrentMap, 'Current');
  519.  
  520.   DrawBitmap(CleanMap, MMap.Canvas, 0, 0);
  521.  
  522.   SubPoints := LoadTextTPA('Click ' + #39 + 'grab minimap' + #39, 'SmallChars', I);
  523.   OffSetTPA(SubPoints, IntToPoint(28, 62));
  524.   DrawDotsEx(SubPoints, 000000001);
  525.  
  526.   SubPoints := LoadTextTPA('to get client image', 'SmallChars', I);
  527.   OffSetTPA(SubPoints, IntToPoint(31, 79));
  528.   DrawDotsEx(SubPoints, 000000001);
  529.  
  530.   SetLength(SubPoints, 0);
  531. end;
  532.  
  533. procedure ToolForm_SafeInit;
  534. var
  535.   v: TVariantArray;
  536. begin
  537.   SetLength(v, 0);
  538.   ThreadSafeCall('ToolForm_Init', v);
  539. end;
  540.  
  541. function ToolForm_ShowModal: Boolean;
  542. begin
  543.   Result := ToolForm.ShowModal = mrOk;
  544. end;
  545.  
  546. function ToolForm_SafeShowModal: Boolean;
  547. var
  548.   v: TVariantArray;
  549. begin
  550.   SetLength(v, 0);
  551.   Result := ThreadSafeCall('ToolForm_ShowModal', v);
  552. end;
  553.  
  554. begin
  555.  
  556.   SMART_Server := 10;
  557.   SMART_Members := True;
  558.   SMART_Signed := True;
  559.  
  560.   SetupSRL;
  561.   ObjDTM_Setup;
  562.  
  563.   ObjectDTM.MainPoint := IntToPoint(80, 80);
  564.   ObjectDTM.NumOfPoints := 0;
  565.   ObjectDTM.NumOfAreaPoints := 0;
  566.  
  567.   SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
  568.   SetLength(ObjectDTM.Area, ObjectDTM.NumOfAreaPoints);
  569.  
  570.   DeclarePlayers;
  571.  
  572.   if (not LoggedIn) then
  573.     LoginPlayer;
  574.  
  575.   while (not RSReady) do
  576.     Wait(500);
  577.  
  578.   ToolForm_SafeInit;
  579.  
  580.   if ToolForm_SafeShowModal then
  581.     WriteLn('Form returned modalresult ok');
  582.  
  583.   FreeBitmap(CleanMap);
  584.   FreeBitmap(CurrentMap);
  585. end.
Advertisement
Add Comment
Please, Sign In to add comment