Advertisement
mixster

mixster

May 4th, 2009
206
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 23.85 KB | None | 0 0
  1. program ScaRPG_Map_Editor;
  2. {
  3.     ScaRPG Map Editor
  4.     A tool that allows anyone to create an intricate map
  5.     Author for used procedures and functions is 'mixster' unless otherwise stated
  6.     Extremely heavy commenting required. If distributed without, kill whoever did it
  7.     Designed primarily for adaptation. If you don't like it, change it - that's why heavy commenting required
  8. }
  9. type
  10.   TSheet = record // Record of information on a sheet e.g. tilesheet; spritesheet.
  11.     b: Integer; // Bitmap holder for the sheet
  12.     h: Integer; // Height in tiles of sheet
  13.     w: Integer; // Width in tiles of sheet
  14.   end;
  15.  
  16.   TMap = record //Record of information for the entire map
  17.     layers: array of T2DPointArray; // 3D integer array with the information for drawing the tiles. The TPoint holds the actual top left corner on the tilesheet
  18.     attribs: T2DIntArray; // layer that holds attributes for a tile
  19.     width, height, depth, sprite: Integer; // Width, height and depth for dimensions; sprite is layer where sprites are drawn on top of
  20.     vis: TIntegerArray; // Holds bitmap for visible layers
  21.     mC: TPoint; // Holds the top left position so we know which bits to draw
  22.     saved: Boolean; // Holds whether or not the map is currently saved
  23.     fp: string; // Holds filepath of where it is currently saved
  24.   end;
  25.  
  26. var
  27.   maps: array of TMap; // Holds the currently open maps
  28.   cm: Integer; // Holds the index of currently visible map
  29.   fMain: TForm; // Main form for editing or creating a map
  30.   iMain: TImage; // Main visible component for displaying the map
  31.   iSheet: TImage; // Visible component for displaying the tilesheet
  32.   tcMain: TTabControl; // Main tab bit for holding the maps
  33.   sbHorz, sbVert: TScrollBar; // Main scrollbars for scrolling map movement
  34.   sbSheet: TScrollBox; // Scrollbox that the tilesheet goes into
  35.   bitDeb: string; // Holds the string that has the info about all the bitmaps currently in use
  36.   bitLoc: TStringArray; // Holds the location from where the relating bitmap was created
  37.   dr: TPoint; // Holds the number of tiles to draw in regards to .x = width .y = height
  38.   shTile: TSheet; // See TSheet. shTile for tilesheet
  39.   dT: TPoint; // Holds the top left of the tile which is to be drawn upon clicking
  40.  
  41. procedure Crash(str: string); // Simple procedure to allow the script to crash easily from a single line due to laziness
  42. begin
  43.   Writeln('Crashing: ' + str); // Print the crashing reason
  44.   TerminateScript; // Stop the script running
  45. end;
  46.  
  47. function MBitmap(w, h: Integer; str, from: string): Integer; // Creation half of the memory leak debugging
  48. begin
  49.   Result := BitmapFromString(w, h, str); // Start by actually making the bitmap since we need the reference number
  50.   while (Length(bitDeb) < Result + 1) do // While the string is too short
  51.     bitDeb := bitDeb + '2'; // Increase the length of the string by adding a 2 which signifies bitmap created by alternate means
  52.   bitDeb[Result + 1] := '1'; // Set the index to 1 to signify in use - string's start at 1 not 0, hence the + 1
  53.   SetLength(bitLoc, Length(bitDeb) + 1); // This is 1 longer than the string due to it starting on 0 and me wanting them in line
  54.   bitLoc[Result + 1] := from; // Set where the bitmap was created from
  55.   //Writeln('Created bitmap number ' + IntToStr(Result + 1) + ' in procedure ''' + from + ''''); // Results in extremely large debug box
  56. end;
  57.  
  58.  
  59. procedure MFreeBitmap(b: Integer); // Destroying half of the memory leak debugging
  60. begin
  61.   FreeBitmap(b); // Start by freeing it as the reference remains afterwards
  62.   b := b + 1 // Increment it to line it up with the arrays
  63.   if (b > Length(bitDeb)) then // If the debug string is too short
  64.     exit; // Then we don't need to change anything (created by LoadBitmap or something similar) so exit procedure
  65.   //Writeln('Destroyed bitmap number ' + IntToStr(b) + ' which was created in procedure ''' + bitLoc[b] + ''''); // Results in extremely large debug box
  66.   bitDeb[b] := '0'; // Set to 0 to signify not in use
  67.   bitLoc[b] := ''; // Set to blank
  68. end;
  69.  
  70. procedure LoadSheet(var sheet: TSheet; filename: string); // Loads a sheet from a file
  71. var
  72.   s: TPoint;
  73. begin
  74.  
  75.   sheet.b := LoadBitmap(filename); // Load the bitmap
  76.   GetBitmapSize(sheet.b, s.x, s.y); // Get actual dimensions
  77.   sheet.w := s.x div 32; // Convert to tile dimenions
  78.   sheet.h := s.y div 32; // As above
  79. end;
  80.  
  81. procedure ConvertTile(var p: TPoint; i: Integer); // Changes integer based reference to an actual position
  82. begin
  83.   p.x := (i mod shTile.w) * 32; // mod by width to get the .x then * 32 to get actual location
  84.   p.y := (i div shTile.w) * 32; // div by width to get the .y then same as above
  85. end;
  86.  
  87. function ConvertBack(p: TPoint): Integer; // Change actual location back to integer reference
  88. begin
  89.   Result := ((p.y div 32) * shTile.w) + (p.x div 32); // div both by 32 to get tile reference then .y * width and add on .x
  90. end;
  91.  
  92. procedure GenerateBlankMap(var map: TMap; w, h, d: Integer);
  93. var
  94.   z, y, x: Integer;
  95. begin
  96.   map.depth := d;
  97.   map.height := h;
  98.   map.width := w;
  99.   map.sprite := Round(h / 1.5);
  100.   map.mC := Point(0, 0);
  101.   map.fp := ScriptPath;
  102.   map.saved := false;
  103.  
  104.   SetLength(map.layers, d);
  105.   SetLength(map.vis, d);
  106.  
  107.   for z := 0 to d - 1 do
  108.   begin
  109.     map.vis[z] := MBitmap(w * 32, h * 32, '', 'GenerateBlankMap');
  110.     SetLength(map.layers[z], h);
  111.     if (z = 0) then
  112.       SetLength(map.attribs, h);
  113.     for y := 0 to h - 1 do
  114.     begin
  115.       SetLength(map.layers[z][y], w);
  116.       if (z = 0) then
  117.         SetLength(map.attribs[y], w);
  118.       for x := 0 to w - 1 do
  119.       begin
  120.         map.layers[z][y][x] := Point(0, 0);
  121.         if (z = 0) then
  122.           map.attribs[y][x] := 0;
  123.       end;
  124.     end;
  125.   end;
  126. end;
  127.  
  128. procedure PaintMap; // Paints the layers on to the form so we can see the map
  129. var
  130.   t, i: Integer;
  131. begin
  132.   t := MBitmap(480, 480, '', 'PaintMap'); // Create temp bitmap
  133.   FastDrawClear(t, clBlack); // Ensure temp bitmap is blank
  134.  
  135.   for i := 0 to maps[cm].depth - 1 do // Loop through all layers
  136.   begin
  137.     SetTransparentColor(maps[cm].vis[i], clBlack); // Set transparent colour so the layers work nicely
  138.     FastDrawTransparent(0, 0, maps[cm].vis[i], t); // Draw sprite layer on with transparency so bottom layer is visible
  139.   end;
  140.  
  141.   SafeDrawBitmap(t, iMain.Canvas, 0, 0); // Draw the map onto the visual component
  142.   MFreeBitmap(t); // Free our temp bitmap
  143. end;
  144.  
  145. procedure RedrawMap; // Draw the map entirely from scratch - can be very confusing to understand, but straight forward enough
  146. var
  147.   z, y, x, t, d: Integer;
  148.   p: TPoint;
  149.   ts, ds: TCanvas;
  150. begin
  151.   t := MBitmap(dr.x * 32, dr.y * 32, '', 'RedrawMap'); // Create temp bitmap
  152.  
  153.   ts := GetBitmapCanvas(shTile.b); // Get the tilesheet's canvas
  154.   ds := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  155.  
  156.   for z := 0 to maps[cm].depth - 1 do // Loop through all the layers
  157.   begin
  158.     FastDrawClear(maps[cm].vis[z], clBlack); // Ensure layer is clear
  159.     d := maps[cm].vis[z]; // Set d to current layer
  160.     FastDrawClear(t, clBlack); // Clear the temp bitmap
  161.     p.y := -32; // Holds where to draw on the visible map - reset it here
  162.     for y := maps[cm].mC.y to maps[cm].mC.y + dr.y do // Loop through all on screen vertical tiles
  163.     begin
  164.       p.y := p.y + 32; // Increment the position by the height of a tile (32)
  165.       if (y < 0) then // If y is off the top of the map
  166.         continue // Go back to the beginning of the loop
  167.       else if (y >= maps[cm].height) then // If y is off the bottom of the map
  168.         break; // It won't go back on, so break the loop
  169.  
  170.       p.x := -32; // Holds where to draw on the visible map - reset it here
  171.       for x := maps[cm].mC.x to maps[cm].mC.x + dr.x do // Loop through all on screen horizontal tiles
  172.       begin
  173.         p.x := p.x + 32; // Increment the position by the width of a tile
  174.         if (x < 0) then // If x is off the left of the map
  175.           continue // Go back to the beginning of the loop
  176.         else if (x >= maps[cm].width) then // If x is off the right of the map
  177.           break; // It won't go back on, so break the loop
  178.         SafeCopyCanvas(ts, ds, maps[cm].layers[z][y][x].x, maps[cm].layers[z][y][x].y, maps[cm].layers[z][y][x].x + 32, maps[cm].layers[z][y][x].y + 32, p.x, p.y, p.x + 32, p.y + 32); // Using the 3D TPoint array, copy the tile onto the temp bitmap using TPoint p for where to draw
  179.       end;
  180.     end;
  181.     SetTransparentColor(t, 16448505); // Tiles use a near white colour for transparency, so set it to allow layered maps
  182.     FastDrawTransparent(0, 0, t, d); // Draw the layer transparently onto appropriate bitmap
  183.   end;
  184.  
  185.   MFreeBitmap(t); // Free our temp bitmap
  186.  
  187.   PaintMap; // See PaintMap procedure
  188. end;
  189.  
  190. procedure RedrawArea(ts, te, dp: TPoint); // A procedure similar to RedrawMap, but with alterations so it only redraws the set area and then draws it where told
  191. var
  192.   t, d, z, y, x, w, h: Integer;
  193.   tc, tsc: TCanvas;
  194.   p: TPoint;
  195. begin
  196.   w := (te.x - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
  197.   h := (te.y - ts.y) * 32; // As above, only height
  198.   t := MBitmap(w + 32, h + 32, '', 'RedrawArea'); // Setup the bitmap used to draw the new stuff
  199.   tsc := GetBitmapCanvas(shTile.b); // Get the tilesheet's canvas
  200.   tc := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  201.  
  202.  
  203.  
  204.   for z := 0 to maps[cm].depth - 1 do // Loop through all layers
  205.   begin
  206.     d := maps[cm].vis[z];
  207.     FastDrawClear(t, clBlack); // Clear temp bitmap
  208.     p.y := -32; // Reset p.y
  209.     for y := ts.y to te.y do
  210.     begin
  211.       p.y := p.y + 32; // Increment position to draw to
  212.       p.x := -32;
  213.       if (y < 0) then // If y is not valid due to being too far up
  214.         Continue // Skip to beginning of loop
  215.       else if (y >= maps[cm].width) then // If y is not valid due to being too far down
  216.         break; // Break the loop as there's no hope of it returning
  217.  
  218.       for x := ts.x to te.x do // Loop through all columns
  219.       begin
  220.         p.x := p.x + 32; // Increment position to draw to
  221.         if (x < 0) then // If x is not valid due to being too far left
  222.           Continue // Skip to beginning of loop
  223.         else if (x >= maps[cm].width) then // If x is not valid due to being too far right
  224.           break; // Break the loop as there's no hope of it returning
  225.  
  226.         SafeCopyCanvas(tsc, tc, maps[cm].layers[z][y][x].x, maps[cm].layers[z][y][x].y, maps[cm].layers[z][y][x].x + 32, maps[cm].layers[z][y][x].y + 32, p.x, p.y, p.x + 32, p.y + 32); // Using the 3D TPoint array, copy the tile onto the temp bitmap using TPoint p for where to draw
  227.       end;
  228.     end;
  229.  
  230.     SetTransparentColor(t, 16448505); // Tiles use a near white colour for transparency, so set it to allow layered maps
  231.     FastDrawTransparent(dp.x, dp.y, t, d); // Draw the layer transparently onto appropriate bitmap
  232.   end;
  233.  
  234.   MFreeBitmap(t); // Free our temp bitmap
  235. end;
  236.  
  237. procedure HandleMovement(amount: Integer; dir: Integer); // Wrapper procedure for RedrawArea
  238. var
  239.   t, z: Integer;
  240.   tc: TCanvas;
  241.   s, e, o, d: TPoint;
  242. begin
  243.   if (amount < 0) then
  244.     amount := - amount;
  245.   t := MBitmap((dr.x + 1) * 32, (dr.y + 1) * 32, '', 'HandleMovement');
  246.   tc := GetBitmapCanvas(t);
  247.   s := maps[cm].mC;
  248.   e := Point(s.x + dr.x, s.y + dr.y);
  249.   o := Point(0, 0);
  250.   d := Point(0, 0);
  251.   case dir of
  252.     1: begin
  253.       e.y := s.y + amount;
  254.       o.y := amount * 32;
  255.     end;
  256.     2: begin
  257.       e.x := s.x + amount;
  258.       o.x := amount * 32;
  259.     end;
  260.     3: begin
  261.       s.y := e.y - amount;
  262.       o.y := - (amount * 32);
  263.       d.y := (dr.y - amount) * 32;
  264.     end;
  265.     4: begin
  266.       s.x := e.x - amount;
  267.       o.x := - (amount * 32);
  268.       d.x := (dr.x - amount) * 32;
  269.     end;
  270.   end;
  271.  
  272.   for z := 0 to maps[cm].depth - 1 do
  273.   begin
  274.     SafeDrawBitmap(maps[cm].vis[z], tc, o.x, o.y);
  275.     SafeDrawBitmap(t, GetBitmapCanvas(maps[cm].vis[z]), 0, 0);
  276.   end;
  277.  
  278.   MFreeBitmap(t);
  279.  
  280.   RedrawArea(s, e, d);
  281.   PaintMap;
  282. end;
  283.  
  284. procedure AddMap(w, h, d: Integer);
  285. var
  286.   l: Integer;
  287. begin
  288.   l := High(maps) + 1;
  289.   SetLength(maps, l + 1);
  290.   GenerateBlankMap(maps[l], w, h, d);
  291.   tcMain.Tabs.Append('untitled');
  292.   tcMain.TabIndex := tcMain.Tabs.Count - 1;
  293. end;
  294.  
  295. procedure MapImplode(var arr: TStringArray); // Breaks down the map into an array to be used for saving maps
  296. var
  297.   z, y, x, i: Integer;
  298. begin
  299.   SetLength(arr, 0); // Ensure array passed is empty
  300.   if ((maps[cm].depth <= 0) or (maps[cm].height <= 0) or (maps[cm].width <= 0)) then // If map is blank/invalid size
  301.     Crash('Imploding map of invalid dimensions (one is set to zero)'); // Crash
  302.   i := 2 + ((maps[cm].depth * (maps[cm].height + 1)) - 1); // 2 is for the first line to hold dimension size then a blank line after. Layers held in "paragraphs", so for every layer, there should be height + 1 strings to allow for blank line underneath and then you take one away as bottom "paragraph" doesn't need blank line
  303.   SetLength(arr, i); // Set the length so it's the right length for the data
  304.   arr[0] := IntToStr(maps[cm].width) + ',' + IntToStr(maps[cm].height) + ',' + IntToStr(maps[cm].depth); // Set first array index to hold dimenions info (x by y by z)
  305.   for x := 1 to i - 1 do // Loop through all arrays
  306.     arr[x] := ''; // Set to blank to ensure no corruption
  307.   i := 1; // Set i to 1 as 0 is used for dimensions, then 1 as a blank line - i is incremented once before being used for the first time
  308.   for z := 0 to maps[cm].depth do // Loop through all layers and the attributes
  309.   begin
  310.     for y := 0 to maps[cm].height - 1 do // Loop through all rows
  311.     begin
  312.       i := i + 1; // Increment i so it points to next blank array
  313.       for x := 0 to maps[cm].width - 1 do // Loop through all columns
  314.         if (z < maps[cm].depth) then // if it is a visual layer
  315.           arr[i] := arr[i] + IntToStr(ConvertBack(maps[cm].layers[z][y][x])) + ',' // Append the converted tile and a comma to the end of the array
  316.         else // if it is the attirbutes layer
  317.           arr[i] := arr[i] + IntToStr(maps[cm].attribs[y][x]) + ','; // Append the attribute and a comma to the end of the array
  318.       Delete(arr[i], Length(arr[i]), 1); // Remove the trailing comma
  319.     end;
  320.     i := i + 1; // Increment i to give the blank line between "paragraphs"
  321.   end;
  322. end;
  323.  
  324. procedure SaveMap(filename: string); // Outputs the map to a file
  325. var
  326.   f, i: Integer;
  327.   s: TStringArray;
  328. begin
  329.   f := RewriteFile(filename, False); // Open file and wipe it or create the file then assign to f
  330.   MapImplode(s); // See MapImplode
  331.   for i := 0 to High(s) do // Loop through s
  332.     WriteFileString(f, s[i] + #13 + #10); // Write to file with new line after
  333.   CloseFile(f); // Close the file
  334. end;
  335.  
  336. procedure ExportMap; // GUI method of saving a map by opening a TSaveDialog
  337. var
  338.   dialog: TSaveDialog;
  339. begin
  340.   dialog := TSaveDialog.Create(nil); // Create parentless save dialog
  341.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set filter to only allow the the extension specified
  342.   if (ScriptPath <> '') then // If script is saved
  343.     dialog.InitialDir := ScriptPath; // Set starting directory to same as where script is saved
  344.   if (not dialog.Execute) then // If no file is specified after opening the dialog and it is closed
  345.     exit; // exit procedure
  346.   SaveMap(dialog.filename); // See SaveMap - the chosen file is passed as where to save it to
  347. end;
  348.  
  349. procedure MExplode(var arr: TStringArray; str, del: string); // Standard Explode procedure written for older Scar versions
  350. var
  351.   i, h, l: Integer;
  352. begin
  353.   SetLength(arr, 0); // Ensure passed array is blank
  354.   h := -1; // Set high of array to -1
  355.   l := Length(del) - 1; // Amount to delete by based on del's length to ensure it is removed if longer than 1 char
  356.   while (true) do // Endless loop
  357.   begin
  358.     h := h + 1; // Increment h
  359.     SetLength(arr, h + 1); // Make array longer by one
  360.     i := Pos(del, str); // Find first occurence of del in str
  361.     if (i = 0) then // If it is not found
  362.       break; // Break from loop
  363.     arr[h] := Copy(str, 1, i - 1); // Copy the text until del (not including del) to the array
  364.     Delete(str, 1, i + l); // Remove copied text as well as del
  365.   end;
  366.   arr[h] := Copy(str, 1, Length(str)); // Copy remaining text into the array - del should not be on it, so no need to copy shorter than the length
  367. end;
  368.  
  369. function StrInt(s: string): Integer; // "Safe" version of IntToStr to catch dodgy map files specifically
  370. begin
  371.   try
  372.     Result := StrToInt(s); // Try standard conversion
  373.   except // If it is non-numeric
  374.     if (s = '') then // If it is blank
  375.       Result := 0 // Set to 0
  376.     else // If non-numeric and not blank
  377.       Crash('StrInt passed invalid string - "' + s + '"'); // Crash
  378.   end;
  379. end;
  380.  
  381. procedure MapExplode(str: string); // Creates the backend for the visual map from a string
  382. var
  383.   lineArr: TStringArray;
  384.   mapArr: array of TStringArray;
  385.   i, z, y, x: Integer;
  386. begin
  387.   if (Pos(#13 + #10, str) = 0) then // If no enter's are found in the string
  388.     Crash('Exploding map from an invalid input string'); // Crash
  389.  
  390.   MExplode(lineArr, str, #13 + #10); // See MExplode - breaks into seperate lines
  391.   SetLength(mapArr, High(lineArr) + 1); // Set 2D array to the same length as the number of lines
  392.   for i := 0 to High(lineArr) do // Loop through all the lines
  393.     MExplode(mapArr[i], lineArr[i], ','); //See MExplode - breaks into seperate values between the comma's
  394.  
  395.   maps[cm].width := StrInt(mapArr[0][0]); // Set the dimension of the map based on the extracted values
  396.   maps[cm].height := StrInt(mapArr[0][1]); // As above
  397.   maps[cm].depth := StrInt(mapArr[0][2]); // As above
  398.  
  399.   i := 2; // Set i to 2 - the first array relating to the map
  400.  
  401.   // This section is like the inverse of the main loop in MapImplode
  402.   SetLength(maps[cm].layers, maps[cm].depth); // Set the 3D TPoint array to length of the depth
  403.   for z := 0 to maps[cm].depth - 1 do // Loop through all layers and the attribute layer
  404.   begin
  405.     SetLength(maps[cm].layers[z], maps[cm].height); // Set a 2D TPoint array to length of the height
  406.     for y := 0 to maps[cm].height - 1 do // Loop through all rows
  407.     begin
  408.       SetLength(maps[cm].layers[z][y], maps[cm].width); // Set the TPoint array to the length of the width
  409.       for x := 0 to maps[cm].width - 1 do // Loop through all columns
  410.         ConvertTile(maps[cm].layers[z][y][x], StrInt(mapArr[i][x])); // See ConvertTile - this is done so that map painting requires less calculations
  411.       i := i + 1; // Go onto the next line of the loaded "paragraph"
  412.     end;
  413.     i := i + 1; // Would be a blank line here, so go on to the next
  414.   end;
  415.  
  416.   SetLength(maps[cm].attribs, maps[cm].height); // Set the height of the 2DIntArray
  417.   for y := 0 to maps[cm].height - 1 do // Loop through all rows
  418.   begin
  419.     SetLength(maps[cm].attribs[y], maps[cm].width); // Set the width of the TIntegerArray
  420.     for x := 0 to maps[cm].width - 1 do // Loop through all columns
  421.       maps[cm].attribs[y][x] := StrInt(mapArr[i][x]); // Convert the string into an integer attribute value
  422.     i := i + 1;
  423.   end;
  424. end;
  425.  
  426. procedure LoadMap(filename: string); // Handles the loading of a map file and doing what needs to be done
  427. var
  428.   f: Integer;
  429.   s: string;
  430. begin
  431.   if (not FileExists(filename)) then // If file does not exist
  432.     Crash('File specified to load does not exist - "' + filename + '"'); // Crash
  433.   f := OpenFile(filename, False); // Open the file specified
  434.   ReadFileString(f, s, FileSize(f)); // Read the contents of the file
  435.   CloseFile(f); // Close the file
  436.   MapExplode(s); // See MapExplode - pass the file contents to break apart
  437. end;
  438.  
  439. procedure ImportMap; // GUI method of opening a map by opening a TOpemDialog
  440. var
  441.   dialog: TOpenDialog;
  442. begin
  443.   dialog := TOpenDialog.Create(nil); // Create a parentless open dialog
  444.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set the filter to only show map files
  445.   if (ScriptPath <> '') then // If the script is saved
  446.     dialog.InitialDir := ScriptPath; // Set the starting directory to the place where the script is saved in
  447.   if (not dialog.Execute) then // If the dialog is launched and no file is selected when closed
  448.     exit; // exit procedure
  449.   LoadMap(dialog.filename); // See LoadMap - passing the selected file as the one to load
  450. end;
  451.  
  452. procedure OnMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  453. var
  454.   d: TPoint;
  455. begin
  456.   X := Trunc(X / 32.0);
  457.   Y := Trunc(Y / 32.0);
  458.   d := Point(X * 32, Y * 32);
  459.   X := maps[cm].mC.x + X;
  460.   Y := maps[cm].mC.y + Y;
  461.   maps[cm].layers[2][Y][X].x := dT.x;
  462.   maps[cm].layers[2][Y][X].y := dT.y;
  463.   RedrawArea(Point(X, Y), Point(X, Y), d);
  464.   PaintMap;
  465. end;
  466.  
  467. procedure OnMapScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  468. var
  469.   dir, amo: Integer;
  470. begin
  471.   if (Sender = sbHorz) then
  472.   begin
  473.     amo := maps[cm].mC.x - sbHorz.Position;
  474.     maps[cm].mC.x := sbHorz.Position;
  475.     if (amo < 0) then
  476.       dir := 4
  477.     else
  478.       dir := 2;
  479.   end
  480.   else if (Sender = sbVert) then
  481.   begin
  482.     amo := maps[cm].mC.y - sbVert.Position;
  483.     maps[cm].mC.y := sbVert.Position;
  484.     if (amo < 0) then
  485.       dir := 3
  486.     else
  487.       dir := 1;
  488.   end;
  489.   HandleMovement(amo, dir);
  490. end;
  491.  
  492. procedure OnTilesheetMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  493. begin
  494.   X := Trunc(X / 32.0) * 32;
  495.   Y := Trunc(Y / 32.0) * 32;
  496.   dT := Point(X, Y);
  497.   Writeln(IntToStr(x) + ',' + IntToStr(y));
  498. end;
  499.  
  500. procedure SetupForm;
  501. begin
  502.   fMain := CreateForm;
  503.   with fMain do
  504.   begin
  505.     Caption := 'ScaRPG - Map Editor';
  506.     ClientWidth := 596 + (shTile.w * 32); // 50 + 480 + 16 + 50 + tilesheet bit
  507.     ClientHeight := 596; // 50 + 480 + 16 + 50
  508.     Position := poDesktopCenter;
  509.   end;
  510.  
  511.   sbSheet := TScrollBox.Create(fMain);
  512.   with sbSheet do
  513.   begin
  514.     Parent := fMain;
  515.     Align := alRight;
  516.     Width := (shTile.w * 32) + 20;
  517.     Height := 480;
  518.     Left := fMain.ClientWidth - Width;
  519.     Top := 0;
  520.   end;
  521.  
  522.   iSheet := TImage.Create(sbSheet);
  523.   with iSheet do
  524.   begin
  525.     Parent := sbSheet;
  526.     Left := 0;
  527.     Top := 0;
  528.     Width := (shTile.w * 32);
  529.     Height := (shTile.h * 32);
  530.     SafeDrawBitmap(shTile.b, Canvas, 0, 0);
  531.     OnMouseUp := @OnTilesheetMouseUp;
  532.   end;
  533.  
  534.   tcMain := TTabControl.Create(fMain);
  535.   with tcMain do
  536.   begin
  537.     Parent := fMain;
  538.     Align := alClient;
  539.     AddMap(20, 20, 3);
  540.   end;
  541.  
  542.   iMain := TImage.Create(tcMain);
  543.   with iMain do
  544.   begin
  545.     Parent := tcMain;
  546.     Left := 50;
  547.     Top := 50;
  548.     Width := 480;
  549.     Height := 480;
  550.     Canvas.Brush.Color := clRed;
  551.     Canvas.RoundRect(0, 0, 480, 480, 0, 0);
  552.     OnMouseUp := @OnMapMouseUp;
  553.   end;
  554.  
  555.   sbHorz := TScrollBar.Create(tcMain);
  556.   with sbHorz do
  557.   begin
  558.     Parent := tcMain;
  559.     Left := 50;
  560.     Top := 530;
  561.     Width := 480;
  562.     Height := 16;
  563.     Kind := sbHorizontal;
  564.     Max := maps[cm].Width - 1;
  565.     OnScroll := @OnMapScroll;
  566.   end;
  567.  
  568.   sbVert := TScrollBar.Create(tcMain);
  569.   with sbVert do
  570.   begin
  571.     Parent := tcMain;
  572.     Left := 530;
  573.     Top := 50;
  574.     Width := 480;
  575.     Height := 16;
  576.     Kind := sbVertical;
  577.     Max := maps[cm].Height - 1;
  578.     OnScroll := @OnMapScroll;
  579.   end;
  580.  
  581.   RedrawMap;
  582.   fMain.ShowModal;
  583. end;
  584.  
  585. var
  586.   v: TVariantArray;
  587.   m, z, i: Integer;
  588. // Main loop - no comments
  589. begin
  590.   Writeln('begin');
  591.   dr := Point(15, 15);
  592.   LoadSheet(shTile, ScriptPath + 'Tiles.bmp');
  593.  
  594.   ThreadSafeCall('SetupForm', v);
  595. //  SetupForm; // Use without SafeCall for debugging unknown errors, though very prone to self destruct when done so - use at own risk
  596.   FreeForm(fMain);
  597.  
  598.   for m := 0 to High(maps) do
  599.     for z := 0 to maps[m].depth - 1 do
  600.       MFreeBitmap(maps[m].vis[z]);
  601.   FreeBitmap(shTile.b);
  602.  
  603.   // Section for debugging memory leaks - see MBitmap and MFreeBitmap
  604.   // Don't rely on it for fixing all leaks - only works when you use MBitmap and not LoadBitmap etc.
  605.   while True do
  606.   begin
  607.     i := Pos('1', bitDeb);
  608.     if (i = 0) then
  609.       Break;
  610.     Writeln('Bitmap created from ''' + bitLoc[i] + ''' not freed!');
  611.     MFreeBitmap(i - 1);
  612.   end;
  613.  
  614.   Writeln('end');
  615. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement